[Cuis-dev] TextModelMorph with validation

[Mark Volkmann]

I've been trying to learn how I can impose length and character
restrictions on instances of TextModelMorph. I've found a way to do it by
using a subclass of TextModelMorph and a subclass of InnerTextMorph. These
seem like common enough needs that perhaps they should be directly
supported by those classes instead of requiring the use of new subclasses.
I'm interested in feedback on this.

Here's an example of using my new class to create a single-line input that
only allows digits and has a maximum size of 5 digits:

entry := ValidatedTextModelMorph withText: '' ::
    acceptOnAny: true;
    hideScrollBarsIndefinitely;
    maxSize: 5;
    charValidationBlock: [ :char | char isDigit ];
    morphExtent: 100 @ 0;
    wrapFlag: false.
entry openInWorld.

Here is the ValidatedTextModelMorph class. Note that it does very little,
just delegating to scroller which is an instance of the class returned by
the innerMorphClass method.

TextModelMorph subclass: #ValidatedTextModelMorph
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Demo'

charValidationBlock: aBlock
    scroller charValidationBlock: aBlock

innerMorphClass
    "This method wouldn't be needed if InnerTextMorph was
     modified to do what ValidatedInnerTextMorph does."
    ^ ValidatedInnerTextMorph

maxSize: anInteger
    scroller maxSize: anInteger

Here is the ValidatedInnerTextMorph class:

InnerTextMorph subclass: #ValidatedInnerTextMorph
    instanceVariableNames: 'charValidationBlock maxSize'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Demo'

charValidationBlock: aBlock
    charValidationBlock := aBlock

maxSize: anInteger
    maxSize := anInteger

keyStroke: aKeyboardEvent
    "This is where all the magic happens!"
    | allow |

    allow := aKeyboardEvent keyValue < 32. "includes arrow keys and
backspace"
    allow ifFalse: [ "not a control character"
        allow := maxSize = nil or:
            [ maxSize = 0 or:
            [ self editor selectionInterval size > 0 or:
            "A new character always fits if characters are selected."
            [ model actualContents size < maxSize ]]].
        allow ifTrue: [ "will fit"
            charValidationBlock ifNotNil: [
                allow := charValidationBlock value: aKeyboardEvent
keyCharacter
            ]
        ].
    ].
    allow
        ifTrue: [ super keyStroke: aKeyboardEvent ]
        ifFalse: [ Smalltalk beep ].

-- 
R. Mark Volkmann
Object Computing, Inc.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.cuis.st/mailman/archives/cuis-dev/attachments/20250404/714891e6/attachment.htm>