EditField.st
changeset 192 fc2fc4347d5d
parent 187 1a429506fad6
child 209 7a6db7fac566
equal deleted inserted replaced
191:5ccbde40bb6b 192:fc2fc4347d5d
     8  be provided or otherwise made available to, or used by, any
     8  be provided or otherwise made available to, or used by, any
     9  other person.  No title to or ownership of the software is
     9  other person.  No title to or ownership of the software is
    10  hereby transferred.
    10  hereby transferred.
    11 "
    11 "
    12 
    12 
    13 'From Smalltalk/X, Version:2.10.5 on 9-may-1995 at 12:09:38 pm'!
       
    14 
       
    15 EditTextView subclass:#EditField
    13 EditTextView subclass:#EditField
    16 	 instanceVariableNames:'leaveAction enabled enableAction crAction tabAction converter
    14 	 instanceVariableNames:'leaveAction enabled enableAction crAction tabAction converter
    17 		leaveKeys immediateAccept acceptOnLeave acceptOnReturn
    15                 leaveKeys immediateAccept acceptOnLeave acceptOnReturn
    18 		lengthLimit entryCompletionBlock passwordCharacter cursorMovementWhenUpdating'
    16                 lengthLimit entryCompletionBlock passwordCharacter
       
    17                 cursorMovementWhenUpdating'
    19 	 classVariableNames:'DefaultForegroundColor DefaultBackgroundColor
    18 	 classVariableNames:'DefaultForegroundColor DefaultBackgroundColor
    20 		DefaultSelectionForegroundColor DefaultSelectionBackgroundColor
    19                 DefaultSelectionForegroundColor DefaultSelectionBackgroundColor
    21 		DefaultFont'
    20                 DefaultFont'
    22 	 poolDictionaries:''
    21 	 poolDictionaries:''
    23 	 category:'Views-Text'
    22 	 category:'Views-Text'
    24 !
    23 !
    25 
    24 
    26 !EditField class methodsFor:'documentation'!
    25 !EditField class methodsFor:'documentation'!
    35  inclusion of the above copyright notice.   This software may not
    34  inclusion of the above copyright notice.   This software may not
    36  be provided or otherwise made available to, or used by, any
    35  be provided or otherwise made available to, or used by, any
    37  other person.  No title to or ownership of the software is
    36  other person.  No title to or ownership of the software is
    38  hereby transferred.
    37  hereby transferred.
    39 "
    38 "
    40 !
       
    41 
       
    42 version
       
    43     ^ '$Header: /cvs/stx/stx/libwidg/EditField.st,v 1.31 1995-11-20 16:11:27 cg Exp $'
       
    44 !
    39 !
    45 
    40 
    46 documentation
    41 documentation
    47 "
    42 "
    48     an editable text-field. Realized by using an EditTextView,
    43     an editable text-field. Realized by using an EditTextView,
   472 	value1 onChangeSend:#value1Changed to:application.
   467 	value1 onChangeSend:#value1Changed to:application.
   473 	value2 onChangeSend:#value2Changed to:application.
   468 	value2 onChangeSend:#value2Changed to:application.
   474 
   469 
   475 	top openModeless.
   470 	top openModeless.
   476 "
   471 "
       
   472 !
       
   473 
       
   474 version
       
   475     ^ '$Header: /cvs/stx/stx/libwidg/EditField.st,v 1.32 1995-11-23 00:48:21 cg Exp $'
   477 ! !
   476 ! !
   478 
   477 
   479 !EditField class methodsFor:'defaults'!
   478 !EditField class methodsFor:'defaults'!
   480 
   479 
   481 defaultLeaveKeys
   480 defaultLeaveKeys
   486      value into their model (if any)"
   485      value into their model (if any)"
   487 
   486 
   488     ^ #(Return CursorUp CursorDown Next Previous Accept)
   487     ^ #(Return CursorUp CursorDown Next Previous Accept)
   489 !
   488 !
   490 
   489 
       
   490 defaultNumberOfLines
       
   491     "the number of lines in the field"
       
   492 
       
   493     ^ 1
       
   494 !
       
   495 
   491 updateStyleCache
   496 updateStyleCache
   492     DefaultForegroundColor := StyleSheet colorAt:'editFieldForegroundColor' default:Black.
   497     DefaultForegroundColor := StyleSheet colorAt:'editFieldForegroundColor' default:Black.
   493     DefaultBackgroundColor := StyleSheet colorAt:'editFieldBackgroundColor' default:White.
   498     DefaultBackgroundColor := StyleSheet colorAt:'editFieldBackgroundColor' default:White.
   494     DefaultSelectionForegroundColor := StyleSheet colorAt:'editFieldSelectionForegroundColor' default:DefaultBackgroundColor.
   499     DefaultSelectionForegroundColor := StyleSheet colorAt:'editFieldSelectionForegroundColor' default:DefaultBackgroundColor.
   495     DefaultSelectionBackgroundColor := StyleSheet colorAt:'editFieldSelectionBackgroundColor' default:DefaultForegroundColor.
   500     DefaultSelectionBackgroundColor := StyleSheet colorAt:'editFieldSelectionBackgroundColor' default:DefaultForegroundColor.
   496     DefaultFont := StyleSheet fontAt:'editFieldFont' default:nil.
   501     DefaultFont := StyleSheet fontAt:'editFieldFont' default:nil.
   497 
   502 
   498     "
   503     "
   499      self updateStyleCache
   504      self updateStyleCache
   500     "
   505     "
   501 !
   506 ! !
   502 
   507 
   503 defaultNumberOfLines
   508 !EditField methodsFor:'accessing-behavior'!
   504     "the number of lines in the field"
   509 
   505 
   510 acceptOnLeave:aBoolean
   506     ^ 1
   511     "set/clear the acceptOnLeave flag. The default is false."
   507 ! !
   512 
   508 
   513      acceptOnLeave := aBoolean
   509 !EditField methodsFor:'private'!
   514 !
   510 
   515 
   511 textChanged
   516 acceptOnReturn:aBoolean
   512     "this is sent by mySelf (somewhere in a superclass) whenever
   517     "set/clear the acceptOnReturn flag. The default is false."
   513      my contents has changed. 
   518 
   514      A good place to add immediateAccept functionality and check for the
   519      acceptOnReturn := aBoolean
   515      lengthLimit."
   520 !
   516 
   521 
   517     |string c|
   522 crAction:aBlock
   518 
   523     "define an action to be evaluated when the return key is pressed."
   519     super textChanged.
   524 
   520     string := self contents.
   525     crAction := aBlock
   521     lengthLimit notNil ifTrue:[
   526 !
   522 	string size > lengthLimit ifTrue:[
   527 
   523 	    c := cursorCol.
   528 cursorMovementWhenUpdating:aSymbol
   524 	    self contents:(string copyTo:lengthLimit).
   529     "define what should be done with the cursor, when I update
   525 	    self flash.
   530      my contents from the model. Allowed argumetns are:
   526 	    self cursorCol:c.
   531 	#keep / nil     -> stay where it was
   527 	]
   532 	#endOfLine      -> position cursor after the string
   528     ].
   533 	#beginOfLine    -> position cursor to the beginning
   529     immediateAccept ifTrue:[
   534      The default is #endOfLine"
   530 	self accept
   535 
   531     ]
   536     cursorMovementWhenUpdating := aSymbol
   532 !
   537 !
   533 
   538 
   534 getListFromModel
   539 disable
   535     "redefined to aquire the text via the aspectMsg - not the listMsg,
   540     "disable the field; hide cursor and ignore input"
   536      and to ignore updates resulting from my own change."
   541 
   537 
   542     enabled ifTrue:[
   538     "
   543 	enabled := false.
   539      ignore updates from my own change
   544 	self hideCursor
   540     "
   545     ]
   541     lockUpdates ifTrue:[
   546 !
   542 	lockUpdates := false.
   547 
   543 	^ self
   548 enable
   544     ].
   549     "enable the field; show cursor and allow input"
   545 
   550 
   546     (model notNil and:[aspectMsg notNil]) ifTrue:[
   551     enabled ifFalse:[
   547 	self editValue:(model perform:aspectMsg).
   552 "/        enableAction notNil ifTrue:[
   548     ]
   553 "/            enableAction value
   549 !
   554 "/        ].
   550 
   555 	enabled := true.
   551 argForChangeMessage
   556 	super showCursor
   552     "redefined to send use converted value (if I have one)"
   557     ]
   553 
   558 !
   554     ^ self editValue
   559 
   555 !
   560 enableAction:aBlock
   556 
   561     "define an action to be evaluated when enabled by clicking upon"
   557 startAutoScrollUp:y
   562 
   558     "no vertical scrolling in editfields"
   563     enableAction := aBlock
   559 
   564 !
   560     ^ self
   565 
   561 !
   566 entryCompletionBlock:aOneArgBlock
   562 
   567     "define an action to be evaluated when Tab (NameCompletion) is pressed.
   563 visibleAt:visLineNr
   568      The block gets the current contents as argument."
   564     "return the string at lineNr for display.
   569 
   565      If there is a password character, return a string consisting of those only."
   570     entryCompletionBlock := aOneArgBlock
   566 
   571 !
   567     |s|
   572 
   568 
   573 immediateAccept:aBoolean
   569     s := super visibleAt:visLineNr.
   574     "set/clear the immediateAccept flag. The default is false."
   570     passwordCharacter notNil ifTrue:[
   575 
   571 	^ String new:(s size) withAll:passwordCharacter
   576      immediateAccept := aBoolean
   572     ].
   577 !
   573     ^ s
   578 
   574 
   579 leaveAction:aBlock
   575     "Modified: 6.9.1995 / 12:25:06 / claus"
   580     "define an action to be evaluated when field is left by return key"
   576 !
   581 
   577 
   582     leaveAction := aBlock
   578 startAutoScrollDown:y
   583 !
   579     "no vertical scrolling in editfields"
   584 
   580 
   585 leaveKeys:aCollectionOfKeySymbols 
   581     ^ self
   586     "define the set of keys which are interpreted as leaveKeys.
   582 ! !
   587      I.e. those that make the field inactive and accept (if acceptOnLeave is true).
   583 
   588      The default is a set of #CursorUp, #CursorDown, #Next, #Prior and #Return."
   584 !EditField methodsFor:'scrolling'!
   589 
   585 
   590     leaveKeys := aCollectionOfKeySymbols
   586 makeColVisible:col inLine:line
   591 !
   587     "dont scroll for the cursor, if its behond the text and a lengthLimit
   592 
   588      is present."
   593 tabAction:aBlock
   589 
   594     "define an action to be evaluated when the tabulator key is pressed."
   590     lengthLimit notNil ifTrue:[
   595 
   591 	(col == cursorCol and:[col > lengthLimit]) ifTrue:[
   596     tabAction := aBlock
   592 	    ^ super makeColVisible:lengthLimit inLine:line
       
   593 	]
       
   594     ].
       
   595     ^ super makeColVisible:col inLine:line
       
   596 
       
   597     "Modified: 6.9.1995 / 13:57:53 / claus"
       
   598 ! !
   597 ! !
   599 
   598 
   600 !EditField methodsFor:'accessing-contents'!
   599 !EditField methodsFor:'accessing-contents'!
   601 
       
   602 list:someText
       
   603     "low level access to the underlying contents' list.
       
   604      Redefined to force text to 1 line, and notify dependents
       
   605      of any changed extent-wishes (for automatic box resizing)."
       
   606 
       
   607     |l oldWidth|
       
   608 
       
   609     l := someText.
       
   610     l size > 1 ifTrue:[
       
   611 	l := OrderedCollection with:(l at:1)
       
   612     ].
       
   613     oldWidth := self widthOfContents.
       
   614     super list:l.
       
   615     self widthOfContents ~~ oldWidth ifTrue:[
       
   616 	self changed:#preferredExtent
       
   617     ]
       
   618 !
       
   619 
   600 
   620 contents
   601 contents
   621     "return contents as a string
   602     "return contents as a string
   622      - redefined since EditFields hold only one line of text.
   603      - redefined since EditFields hold only one line of text.
   623     In your application, please use #editValue; 
   604     In your application, please use #editValue; 
   651     ].
   632     ].
   652 
   633 
   653     self cursorCol:newCol.
   634     self cursorCol:newCol.
   654 !
   635 !
   655 
   636 
   656 editValue
   637 converter
   657     "if the field edits a string, this is a name alias for #contents.
   638     "return the converter (if any)."
   658      Otherwise, if there is a converter, return the edited string
   639 
   659      converted to an appropriate object."
   640     ^ converter
   660 
       
   661     |string|
       
   662 
       
   663     string := self contents.
       
   664     converter isNil ifTrue:[^ string].
       
   665     string isNil ifTrue:[string := ''].
       
   666     ^ converter readValueFrom:string 
       
   667 !
       
   668 
       
   669 editValue:aStringOrObject
       
   670     "set the contents. If there is a converter, use it to convert
       
   671      the object into a printed representation.
       
   672      Otherwise, the argument is supposed to be a string like object,
       
   673      and used directly (i.e. this is equivalent to sending #contents:)."
       
   674 
       
   675     self editValue:aStringOrObject selected:false
       
   676 !
       
   677 
       
   678 editValue:aStringOrObject selected:aBoolean
       
   679     "set the contents. If there is a converter, use it to convert
       
   680      the object into a printed representation.
       
   681      Otherwise, the argument is supposed to be a string like object,
       
   682      and used directly (i.e. this is equivalent to sending #initialText:selected:)."
       
   683 
       
   684     |string|
       
   685 
       
   686     converter notNil ifTrue:[
       
   687 	string := converter printStringFor:aStringOrObject
       
   688     ] ifFalse:[
       
   689 	string :=  aStringOrObject.
       
   690     ].
       
   691     self contents:string.
       
   692     aBoolean ifTrue:[
       
   693 	self selectFromLine:1 col:1 toLine:1 col:string size
       
   694     ]
       
   695 !
       
   696 
       
   697 initialText:aString selected:aBoolean
       
   698     "set the initialText and select it if aBoolean is true"
       
   699 
       
   700     |len s|
       
   701 
       
   702     leftOffset := 0.
       
   703     (s := aString) notNil ifTrue:[
       
   704 	s := s asString
       
   705     ].
       
   706     self contents:s.
       
   707     aBoolean ifTrue:[
       
   708 	(len := s size) ~~ 0 ifTrue:[
       
   709 	    self selectFromLine:1 col:1 toLine:1 col:len
       
   710 	]
       
   711     ]
       
   712 !
       
   713 
       
   714 initialText:aString
       
   715     "set the initialText and select it"
       
   716 
       
   717     self initialText:aString selected:true
       
   718 !
       
   719 
       
   720 stringValue
       
   721     "alias for #contents - for compatibility with ST-80's InputField"
       
   722 
       
   723     ^ self contents
       
   724 !
   641 !
   725 
   642 
   726 converter:aConverter
   643 converter:aConverter
   727     "set the converter. If non-nil,
   644     "set the converter. If non-nil,
   728      the converter is applied to the text to convert from the string
   645      the converter is applied to the text to convert from the string
   731      (i.e. the edited object is the string itself."
   648      (i.e. the edited object is the string itself."
   732 
   649 
   733     converter := aConverter
   650     converter := aConverter
   734 !
   651 !
   735 
   652 
   736 converter
   653 editValue
   737     "return the converter (if any)."
   654     "if the field edits a string, this is a name alias for #contents.
   738 
   655      Otherwise, if there is a converter, return the edited string
   739     ^ converter
   656      converted to an appropriate object."
       
   657 
       
   658     |string|
       
   659 
       
   660     string := self contents.
       
   661     converter isNil ifTrue:[^ string].
       
   662     string isNil ifTrue:[string := ''].
       
   663     ^ converter readValueFrom:string 
       
   664 !
       
   665 
       
   666 editValue:aStringOrObject
       
   667     "set the contents. If there is a converter, use it to convert
       
   668      the object into a printed representation.
       
   669      Otherwise, the argument is supposed to be a string like object,
       
   670      and used directly (i.e. this is equivalent to sending #contents:)."
       
   671 
       
   672     self editValue:aStringOrObject selected:false
       
   673 !
       
   674 
       
   675 editValue:aStringOrObject selected:aBoolean
       
   676     "set the contents. If there is a converter, use it to convert
       
   677      the object into a printed representation.
       
   678      Otherwise, the argument is supposed to be a string like object,
       
   679      and used directly (i.e. this is equivalent to sending #initialText:selected:)."
       
   680 
       
   681     |string|
       
   682 
       
   683     converter notNil ifTrue:[
       
   684 	string := converter printStringFor:aStringOrObject
       
   685     ] ifFalse:[
       
   686 	string :=  aStringOrObject.
       
   687     ].
       
   688     self contents:string.
       
   689     aBoolean ifTrue:[
       
   690 	self selectFromLine:1 col:1 toLine:1 col:string size
       
   691     ]
       
   692 !
       
   693 
       
   694 initialText:aString
       
   695     "set the initialText and select it"
       
   696 
       
   697     self initialText:aString selected:true
       
   698 !
       
   699 
       
   700 initialText:aString selected:aBoolean
       
   701     "set the initialText and select it if aBoolean is true"
       
   702 
       
   703     |len s|
       
   704 
       
   705     leftOffset := 0.
       
   706     (s := aString) notNil ifTrue:[
       
   707 	s := s asString
       
   708     ].
       
   709     self contents:s.
       
   710     aBoolean ifTrue:[
       
   711 	(len := s size) ~~ 0 ifTrue:[
       
   712 	    self selectFromLine:1 col:1 toLine:1 col:len
       
   713 	]
       
   714     ]
       
   715 !
       
   716 
       
   717 list:someText
       
   718     "low level access to the underlying contents' list.
       
   719      Redefined to force text to 1 line, and notify dependents
       
   720      of any changed extent-wishes (for automatic box resizing)."
       
   721 
       
   722     |l oldWidth|
       
   723 
       
   724     l := someText.
       
   725     l size > 1 ifTrue:[
       
   726 	l := OrderedCollection with:(l at:1)
       
   727     ].
       
   728     oldWidth := self widthOfContents.
       
   729     super list:l.
       
   730     self widthOfContents ~~ oldWidth ifTrue:[
       
   731 	self changed:#preferredExtent
       
   732     ]
       
   733 !
       
   734 
       
   735 stringValue
       
   736     "alias for #contents - for compatibility with ST-80's InputField"
       
   737 
       
   738     ^ self contents
   740 ! !
   739 ! !
   741 
   740 
   742 !EditField methodsFor:'accessing-look'!
   741 !EditField methodsFor:'accessing-look'!
   743 
       
   744 passwordCharacter:aCharacter
       
   745     passwordCharacter := aCharacter
       
   746 
       
   747     "Modified: 6.9.1995 / 12:25:33 / claus"
       
   748 !
       
   749 
       
   750 passwordCharacter
       
   751     ^ passwordCharacter
       
   752 
       
   753     "Modified: 6.9.1995 / 12:25:39 / claus"
       
   754 !
       
   755 
   742 
   756 maxChars
   743 maxChars
   757     "return the maximum number of characters that are allowed in
   744     "return the maximum number of characters that are allowed in
   758      the field. 
   745      the field. 
   759      A limit of nil means: unlimited. This is the default."
   746      A limit of nil means: unlimited. This is the default."
   769      A limit of nil means: unlimited. This is the default.
   756      A limit of nil means: unlimited. This is the default.
   770      This method has been renamed from #lengthLimit: for ST-80
   757      This method has been renamed from #lengthLimit: for ST-80
   771      compatibility."
   758      compatibility."
   772 
   759 
   773     lengthLimit := aNumberOrNil
   760     lengthLimit := aNumberOrNil
   774 ! !
   761 !
   775 
   762 
   776 !EditField methodsFor:'accessing-behavior'!
   763 passwordCharacter
   777 
   764     ^ passwordCharacter
   778 entryCompletionBlock:aOneArgBlock
   765 
   779     "define an action to be evaluated when Tab (NameCompletion) is pressed.
   766     "Modified: 6.9.1995 / 12:25:39 / claus"
   780      The block gets the current contents as argument."
   767 !
   781 
   768 
   782     entryCompletionBlock := aOneArgBlock
   769 passwordCharacter:aCharacter
   783 !
   770     passwordCharacter := aCharacter
   784 
   771 
   785 leaveAction:aBlock
   772     "Modified: 6.9.1995 / 12:25:33 / claus"
   786     "define an action to be evaluated when field is left by return key"
   773 ! !
   787 
   774 
   788     leaveAction := aBlock
   775 !EditField methodsFor:'cursor drawing'!
   789 !
   776 
   790 
   777 drawFromVisibleLine:startVisLineNr to:endVisLineNr with:fg and:bg
   791 enable
   778     startVisLineNr to:endVisLineNr do:[:visLine |
   792     "enable the field; show cursor and allow input"
   779 	self drawVisibleLine:visLine with:fg and:bg
       
   780     ]
       
   781 
       
   782     "Modified: 6.9.1995 / 12:24:29 / claus"
       
   783 !
       
   784 
       
   785 showCursor
       
   786     "make cursor visible if currently invisible - but only if this
       
   787      EditField is enabled"
       
   788 
       
   789     enabled ifTrue:[super showCursor]
       
   790 ! !
       
   791 
       
   792 !EditField methodsFor:'cursor movement'!
       
   793 
       
   794 cursorCol:col
       
   795     "redefined to lock the cursor at the end, if I have a lngthLimit"
       
   796 
       
   797     |c sz|
       
   798 
       
   799     c := col.
       
   800     lengthLimit notNil ifTrue:[
       
   801 	sz := lengthLimit.
       
   802 	c > sz ifTrue:[
       
   803 	    c := sz+1.
       
   804 	]
       
   805     ].
       
   806     super cursorCol:c
       
   807 !
       
   808 
       
   809 cursorDown
       
   810     "catch cursor movement"
       
   811 
       
   812     (cursorVisibleLine == nLinesShown) ifFalse:[
       
   813 	super cursorDown
       
   814     ]
       
   815 !
       
   816 
       
   817 cursorLine:line col:col
       
   818     "catch cursor movement"
       
   819 
       
   820     super cursorLine:1 col:col
       
   821 ! !
       
   822 
       
   823 !EditField methodsFor:'editing'!
       
   824 
       
   825 paste:someText
       
   826     "redefined to force text to 1 line"
       
   827 
       
   828     super paste:someText.
       
   829     list size > 1 ifTrue:[
       
   830 	self deleteFromLine:2 toLine:(list size)
       
   831     ]
       
   832 ! !
       
   833 
       
   834 !EditField methodsFor:'event handling'!
       
   835 
       
   836 buttonPress:button x:x y:y
       
   837     "enable myself on mouse click"
   793 
   838 
   794     enabled ifFalse:[
   839     enabled ifFalse:[
   795 "/        enableAction notNil ifTrue:[
       
   796 "/            enableAction value
       
   797 "/        ].
       
   798 	enabled := true.
   840 	enabled := true.
   799 	super showCursor
   841 	super buttonPress:button x:x y:y.
   800     ]
   842 	enableAction notNil ifTrue:[
   801 !
   843 	    enableAction value
   802 
   844 	]
   803 immediateAccept:aBoolean
   845     ] ifTrue:[
   804     "set/clear the immediateAccept flag. The default is false."
   846 	super buttonPress:button x:x y:y
   805 
   847     ]
   806      immediateAccept := aBoolean
   848 !
   807 !
   849 
   808 
   850 canHandle:aKey
   809 leaveKeys:aCollectionOfKeySymbols 
   851     "return true, if the receiver would like to handle aKey
   810     "define the set of keys which are interpreted as leaveKeys.
   852      (usually from another view, when the receiver is part of
   811      I.e. those that make the field inactive and accept (if acceptOnLeave is true).
   853       a more complex dialog box).
   812      The default is a set of #CursorUp, #CursorDown, #Next, #Prior and #Return."
   854      We do return true here, since the editfield will handle
   813 
   855      all keys.
   814     leaveKeys := aCollectionOfKeySymbols
   856      OBSOLETE: dont use this anymore - its a leftover for the tableWidget"
   815 !
   857 
   816 
   858     ^ true
   817 crAction:aBlock
   859 !
   818     "define an action to be evaluated when the return key is pressed."
   860 
   819 
   861 focusIn
   820     crAction := aBlock
   862     "got the explicit focus"
   821 !
   863 
   822 
   864     enabled ifFalse:[
   823 tabAction:aBlock
   865 	enabled := true.
   824     "define an action to be evaluated when the tabulator key is pressed."
   866 	super focusIn.
   825 
   867 	enableAction notNil ifTrue:[
   826     tabAction := aBlock
   868 	    enableAction value
   827 !
   869 	]
   828 
   870     ] ifTrue:[
   829 acceptOnReturn:aBoolean
   871 	super focusIn
   830     "set/clear the acceptOnReturn flag. The default is false."
   872     ].
   831 
   873 !
   832      acceptOnReturn := aBoolean
   874 
   833 !
   875 keyPress:key x:x y:y
   834 
   876     "if keyHandler is defined, pass input; otherwise check for leave
   835 disable
   877      keys"
   836     "disable the field; hide cursor and ignore input"
   878 
   837 
   879     <resource: #keyboard (#DeleteLine #EndOfText)>
   838     enabled ifTrue:[
   880 
   839 	enabled := false.
   881     |leave xCol newOffset oldWidth newWidth s|
   840 	self hideCursor
   882 
   841     ]
   883     enabled ifFalse:[
   842 !
   884 	^ self
   843 
   885     ].
   844 acceptOnLeave:aBoolean
   886 
   845     "set/clear the acceptOnLeave flag. The default is false."
   887     (key == #DeleteLine) ifTrue:[
   846 
   888 	Smalltalk at:#CopyBuffer put:(self contents).
   847      acceptOnLeave := aBoolean
   889 	self contents:''. ^ self
   848 !
   890     ].
   849 
   891 
   850 enableAction:aBlock
   892     (key == #Tab) ifTrue:[
   851     "define an action to be evaluated when enabled by clicking upon"
   893 	tabAction notNil ifTrue:[tabAction value. ^ self].
   852 
   894 	entryCompletionBlock notNil ifTrue:[
   853     enableAction := aBlock
   895 	    s := self contents.
   854 !
   896 	    s isNil ifTrue:[
   855 
   897 		s := ''
   856 cursorMovementWhenUpdating:aSymbol
   898 	    ] ifFalse:[
   857     "define what should be done with the cursor, when I update
   899 		s := s asString
   858      my contents from the model. Allowed argumetns are:
   900 	    ].
   859 	#keep / nil     -> stay where it was
   901 	    entryCompletionBlock value:s. ^ self
   860 	#endOfLine      -> position cursor after the string
   902 	]
   861 	#beginOfLine    -> position cursor to the beginning
   903     ].
   862      The default is #endOfLine"
   904     (key == #Return) ifTrue:[
   863 
   905 	crAction notNil ifTrue:[crAction value. ^ self].
   864     cursorMovementWhenUpdating := aSymbol
   906     ].
       
   907     leave := leaveKeys includes:key.
       
   908     leave ifTrue:[
       
   909 	leaveAction notNil ifTrue:[
       
   910 	    leaveAction value:key
       
   911 	].
       
   912 
       
   913 	((key == #Return and:[acceptOnReturn])
       
   914 	or:[key ~~ #Return and:[acceptOnLeave]]) ifTrue:[
       
   915 	    self accept.
       
   916 	].
       
   917 
       
   918 	x >= 0 ifTrue:[
       
   919 	    "
       
   920 	     let superview know about the leave ...
       
   921 	     This is a temporary kludge for the tableWidget -
       
   922 	     it is no clean coding style. Should make the tableWidget
       
   923 	     a proper model and handle it via the changed mechanism ....
       
   924 	    "
       
   925 	    (superView notNil and:[superView canHandle:key from:self]) ifTrue:[
       
   926 		superView keyPress:key x:x y:y.
       
   927 	    ].
       
   928 	].
       
   929 	^ self
       
   930     ].
       
   931 
       
   932     "
       
   933      ignore some keys (if not a leaveKey) ...
       
   934     "
       
   935     (key == #Find) ifTrue:[^self].
       
   936     (key == #FindNext) ifTrue:[^self].
       
   937     (key == #FindPrev) ifTrue:[^self].
       
   938     (key == #GotoLine) ifTrue:[^self].
       
   939 
       
   940     "
       
   941      a normal key - let superclass's method insert it
       
   942     "
       
   943     oldWidth := self widthOfContents.
       
   944     super keyPress:key x:x y:y.
       
   945 
       
   946     "
       
   947      for end-of-text, also move to end-of-line
       
   948     "
       
   949     key == #EndOfText ifTrue:[
       
   950 	super keyPress:#EndOfLine x:x y:y.
       
   951     ].
       
   952     newWidth := self widthOfContents.
       
   953 
       
   954     "
       
   955      should (& can) we resize ?
       
   956     "
       
   957     xCol := (self xOfCol:cursorCol inVisibleLine:cursorLine) - leftOffset.
       
   958     (xCol > (width * (5/6))) ifTrue:[
       
   959 	self changed:#preferredExtent
       
   960     ] ifFalse:[
       
   961 	newWidth < (width * (1/6)) ifTrue:[
       
   962 	    self changed:#preferredExtent
       
   963 	]
       
   964     ].
       
   965 
       
   966     "
       
   967      did someone react (i.e. has my extent changed) ?
       
   968      (if not, we scroll horizontally)
       
   969     "
       
   970     xCol := (self xOfCol:cursorCol inVisibleLine:cursorLine) - leftOffset.
       
   971     (xCol > (width * (5/6))) ifTrue:[
       
   972 	newOffset := leftOffset + (width // 2).
       
   973     ] ifFalse:[
       
   974 	(xCol < (width * (1/6))) ifTrue:[
       
   975 	    newOffset := 0 max: leftOffset - (width // 2).
       
   976 	] ifFalse:[
       
   977 	    newOffset := leftOffset
       
   978 	]
       
   979     ].
       
   980     newOffset ~~ leftOffset ifTrue:[
       
   981 	self scrollHorizontalTo:newOffset.
       
   982 "/        leftOffset := newOffset.
       
   983 "/        self clear.
       
   984 "/        self redraw
       
   985     ]
   865 ! !
   986 ! !
   866 
   987 
   867 !EditField methodsFor:'initialization'!
   988 !EditField methodsFor:'initialization'!
       
   989 
       
   990 editMenu
       
   991     |labels selectors m|
       
   992 
       
   993     labels := #(
       
   994 		'copy'
       
   995 		'cut'
       
   996 		'paste'
       
   997 "
       
   998 		'replace'
       
   999 "
       
  1000 		'-'
       
  1001 		'accept'
       
  1002 	       ).
       
  1003 
       
  1004      selectors := #(
       
  1005 		 copySelection
       
  1006 		 cut
       
  1007 		 paste
       
  1008 "
       
  1009 		 replace
       
  1010 "
       
  1011 		 nil
       
  1012 		 accept
       
  1013 		).
       
  1014 
       
  1015     m := PopUpMenu 
       
  1016 	  labels:(resources array:labels)
       
  1017 	  selectors:selectors.
       
  1018 
       
  1019     self hasSelection ifFalse:[
       
  1020 	m disableAll:#(copySelection cut)
       
  1021     ].
       
  1022 
       
  1023     ^ m
       
  1024 !
   868 
  1025 
   869 initStyle
  1026 initStyle
   870     super initStyle.
  1027     super initStyle.
   871 
  1028 
   872     DefaultBackgroundColor notNil ifTrue:[
  1029     DefaultBackgroundColor notNil ifTrue:[
   894 "/    acceptOnReturn := false.
  1051 "/    acceptOnReturn := false.
   895     acceptOnLeave := acceptOnReturn := true.
  1052     acceptOnLeave := acceptOnReturn := true.
   896     cursorShown := true.
  1053     cursorShown := true.
   897     leaveKeys := self class defaultLeaveKeys.
  1054     leaveKeys := self class defaultLeaveKeys.
   898     cursorMovementWhenUpdating := #endOfLine
  1055     cursorMovementWhenUpdating := #endOfLine
   899 !
  1056 ! !
   900 
  1057 
   901 editMenu
  1058 !EditField methodsFor:'private'!
   902     |labels selectors m|
  1059 
   903 
  1060 argForChangeMessage
   904     labels := #(
  1061     "redefined to send use converted value (if I have one)"
   905 		'copy'
  1062 
   906 		'cut'
  1063     ^ self editValue
   907 		'paste'
  1064 !
   908 "
  1065 
   909 		'replace'
  1066 getListFromModel
   910 "
  1067     "redefined to aquire the text via the aspectMsg - not the listMsg,
   911 		'-'
  1068      and to ignore updates resulting from my own change."
   912 		'accept'
  1069 
   913 	       ).
  1070     "
   914 
  1071      ignore updates from my own change
   915      selectors := #(
  1072     "
   916 		 copySelection
  1073     lockUpdates ifTrue:[
   917 		 cut
  1074 	lockUpdates := false.
   918 		 paste
  1075 	^ self
   919 "
  1076     ].
   920 		 replace
  1077 
   921 "
  1078     (model notNil and:[aspectMsg notNil]) ifTrue:[
   922 		 nil
  1079 	self editValue:(model perform:aspectMsg).
   923 		 accept
  1080     ]
   924 		).
  1081 !
   925 
  1082 
   926     m := PopUpMenu 
  1083 startAutoScrollDown:y
   927 	  labels:(resources array:labels)
  1084     "no vertical scrolling in editfields"
   928 	  selectors:selectors.
  1085 
   929 
  1086     ^ self
   930     self hasSelection ifFalse:[
  1087 !
   931 	m disableAll:#(copySelection cut)
  1088 
   932     ].
  1089 startAutoScrollUp:y
   933 
  1090     "no vertical scrolling in editfields"
   934     ^ m
  1091 
       
  1092     ^ self
       
  1093 !
       
  1094 
       
  1095 textChanged
       
  1096     "this is sent by mySelf (somewhere in a superclass) whenever
       
  1097      my contents has changed. 
       
  1098      A good place to add immediateAccept functionality and check for the
       
  1099      lengthLimit."
       
  1100 
       
  1101     |string c|
       
  1102 
       
  1103     super textChanged.
       
  1104     string := self contents.
       
  1105     lengthLimit notNil ifTrue:[
       
  1106 	string size > lengthLimit ifTrue:[
       
  1107 	    c := cursorCol.
       
  1108 	    self contents:(string copyTo:lengthLimit).
       
  1109 	    self flash.
       
  1110 	    self cursorCol:c.
       
  1111 	]
       
  1112     ].
       
  1113     immediateAccept ifTrue:[
       
  1114 	self accept
       
  1115     ]
       
  1116 !
       
  1117 
       
  1118 visibleAt:visLineNr
       
  1119     "return the string at lineNr for display.
       
  1120      If there is a password character, return a string consisting of those only."
       
  1121 
       
  1122     |s|
       
  1123 
       
  1124     s := super visibleAt:visLineNr.
       
  1125     passwordCharacter notNil ifTrue:[
       
  1126 	^ String new:(s size) withAll:passwordCharacter
       
  1127     ].
       
  1128     ^ s
       
  1129 
       
  1130     "Modified: 6.9.1995 / 12:25:06 / claus"
       
  1131 ! !
       
  1132 
       
  1133 !EditField methodsFor:'queries'!
       
  1134 
       
  1135 preferredExtent
       
  1136     "return the preferred extent of this view.
       
  1137      That is the width of the string plus some extra, 
       
  1138      but not wider than half of the screen"
       
  1139 
       
  1140     |string w f|
       
  1141 
       
  1142     string := self contents.
       
  1143     (string isNil or:[string isBlank]) ifTrue:[
       
  1144 	string := '          ' "/ just any string is ok ^ super preferredExtent
       
  1145     ].
       
  1146     f := font on:device.
       
  1147     w := ((f widthOf:string) * 1.5) rounded.
       
  1148     w := w min:(device width // 2).
       
  1149     ^ w @ (f height * 1.5) rounded
       
  1150 
       
  1151     "Modified: 6.9.1995 / 19:24:06 / claus"
       
  1152 !
       
  1153 
       
  1154 specClass
       
  1155     self class == EditField ifTrue:[^ InputFieldSpec].
       
  1156     ^ nil
       
  1157 
       
  1158     "Modified: 5.9.1995 / 17:28:27 / claus"
   935 ! !
  1159 ! !
   936 
  1160 
   937 !EditField methodsFor:'realization'!
  1161 !EditField methodsFor:'realization'!
   938 
  1162 
   939 realize
  1163 realize
   940     "scroll back to beginning when realized"
  1164     "scroll back to beginning when realized"
   941     leftOffset := 0.
  1165     leftOffset := 0.
   942     super realize
  1166     super realize
   943 ! !
  1167 ! !
   944 
  1168 
   945 !EditField methodsFor:'queries'!
  1169 !EditField methodsFor:'scrolling'!
   946 
  1170 
   947 specClass
  1171 makeColVisible:col inLine:line
   948     self class == EditField ifTrue:[^ InputFieldSpec].
  1172     "dont scroll for the cursor, if its behond the text and a lengthLimit
   949     ^ nil
  1173      is present."
   950 
  1174 
   951     "Modified: 5.9.1995 / 17:28:27 / claus"
       
   952 !
       
   953 
       
   954 preferredExtent
       
   955     "return the preferred extent of this view.
       
   956      That is the width of the string plus some extra, 
       
   957      but not wider than half of the screen"
       
   958 
       
   959     |string w f|
       
   960 
       
   961     string := self contents.
       
   962     (string isNil or:[string isBlank]) ifTrue:[
       
   963 	string := '          ' "/ just any string is ok ^ super preferredExtent
       
   964     ].
       
   965     f := font on:device.
       
   966     w := ((f widthOf:string) * 1.5) rounded.
       
   967     w := w min:(device width // 2).
       
   968     ^ w @ (f height * 1.5) rounded
       
   969 
       
   970     "Modified: 6.9.1995 / 19:24:06 / claus"
       
   971 ! !
       
   972 
       
   973 !EditField methodsFor:'cursor drawing'!
       
   974 
       
   975 drawFromVisibleLine:startVisLineNr to:endVisLineNr with:fg and:bg
       
   976     startVisLineNr to:endVisLineNr do:[:visLine |
       
   977 	self drawVisibleLine:visLine with:fg and:bg
       
   978     ]
       
   979 
       
   980     "Modified: 6.9.1995 / 12:24:29 / claus"
       
   981 !
       
   982 
       
   983 showCursor
       
   984     "make cursor visible if currently invisible - but only if this
       
   985      EditField is enabled"
       
   986 
       
   987     enabled ifTrue:[super showCursor]
       
   988 ! !
       
   989 
       
   990 !EditField methodsFor:'cursor movement'!
       
   991 
       
   992 cursorCol:col
       
   993     "redefined to lock the cursor at the end, if I have a lngthLimit"
       
   994 
       
   995     |c sz|
       
   996 
       
   997     c := col.
       
   998     lengthLimit notNil ifTrue:[
  1175     lengthLimit notNil ifTrue:[
   999 	sz := lengthLimit.
  1176 	(col == cursorCol and:[col > lengthLimit]) ifTrue:[
  1000 	c > sz ifTrue:[
  1177 	    ^ super makeColVisible:lengthLimit inLine:line
  1001 	    c := sz+1.
       
  1002 	]
  1178 	]
  1003     ].
  1179     ].
  1004     super cursorCol:c
  1180     ^ super makeColVisible:col inLine:line
  1005 !
  1181 
  1006 
  1182     "Modified: 6.9.1995 / 13:57:53 / claus"
  1007 cursorLine:line col:col
  1183 ! !
  1008     "catch cursor movement"
  1184 
  1009 
       
  1010     super cursorLine:1 col:col
       
  1011 !
       
  1012 
       
  1013 cursorDown
       
  1014     "catch cursor movement"
       
  1015 
       
  1016     (cursorVisibleLine == nLinesShown) ifFalse:[
       
  1017 	super cursorDown
       
  1018     ]
       
  1019 ! !
       
  1020 
       
  1021 !EditField methodsFor:'event handling'!
       
  1022 
       
  1023 keyPress:key x:x y:y
       
  1024     "if keyHandler is defined, pass input; otherwise check for leave
       
  1025      keys"
       
  1026 
       
  1027     <resource: #keyboard (#DeleteLine #EndOfText)>
       
  1028 
       
  1029     |leave xCol newOffset oldWidth newWidth s|
       
  1030 
       
  1031     enabled ifFalse:[
       
  1032 	^ self
       
  1033     ].
       
  1034 
       
  1035     (key == #DeleteLine) ifTrue:[
       
  1036 	Smalltalk at:#CopyBuffer put:(self contents).
       
  1037 	self contents:''. ^ self
       
  1038     ].
       
  1039 
       
  1040     (key == #Tab) ifTrue:[
       
  1041 	tabAction notNil ifTrue:[tabAction value. ^ self].
       
  1042 	entryCompletionBlock notNil ifTrue:[
       
  1043 	    s := self contents.
       
  1044 	    s isNil ifTrue:[
       
  1045 		s := ''
       
  1046 	    ] ifFalse:[
       
  1047 		s := s asString
       
  1048 	    ].
       
  1049 	    entryCompletionBlock value:s. ^ self
       
  1050 	]
       
  1051     ].
       
  1052     (key == #Return) ifTrue:[
       
  1053 	crAction notNil ifTrue:[crAction value. ^ self].
       
  1054     ].
       
  1055     leave := leaveKeys includes:key.
       
  1056     leave ifTrue:[
       
  1057 	leaveAction notNil ifTrue:[
       
  1058 	    leaveAction value:key
       
  1059 	].
       
  1060 
       
  1061 	((key == #Return and:[acceptOnReturn])
       
  1062 	or:[key ~~ #Return and:[acceptOnLeave]]) ifTrue:[
       
  1063 	    self accept.
       
  1064 	].
       
  1065 
       
  1066 	x >= 0 ifTrue:[
       
  1067 	    "
       
  1068 	     let superview know about the leave ...
       
  1069 	     This is a temporary kludge for the tableWidget -
       
  1070 	     it is no clean coding style. Should make the tableWidget
       
  1071 	     a proper model and handle it via the changed mechanism ....
       
  1072 	    "
       
  1073 	    (superView notNil and:[superView canHandle:key from:self]) ifTrue:[
       
  1074 		superView keyPress:key x:x y:y.
       
  1075 	    ].
       
  1076 	].
       
  1077 	^ self
       
  1078     ].
       
  1079 
       
  1080     "
       
  1081      ignore some keys (if not a leaveKey) ...
       
  1082     "
       
  1083     (key == #Find) ifTrue:[^self].
       
  1084     (key == #FindNext) ifTrue:[^self].
       
  1085     (key == #FindPrev) ifTrue:[^self].
       
  1086     (key == #GotoLine) ifTrue:[^self].
       
  1087 
       
  1088     "
       
  1089      a normal key - let superclass's method insert it
       
  1090     "
       
  1091     oldWidth := self widthOfContents.
       
  1092     super keyPress:key x:x y:y.
       
  1093 
       
  1094     "
       
  1095      for end-of-text, also move to end-of-line
       
  1096     "
       
  1097     key == #EndOfText ifTrue:[
       
  1098 	super keyPress:#EndOfLine x:x y:y.
       
  1099     ].
       
  1100     newWidth := self widthOfContents.
       
  1101 
       
  1102     "
       
  1103      should (& can) we resize ?
       
  1104     "
       
  1105     xCol := (self xOfCol:cursorCol inVisibleLine:cursorLine) - leftOffset.
       
  1106     (xCol > (width * (5/6))) ifTrue:[
       
  1107 	self changed:#preferredExtent
       
  1108     ] ifFalse:[
       
  1109 	newWidth < (width * (1/6)) ifTrue:[
       
  1110 	    self changed:#preferredExtent
       
  1111 	]
       
  1112     ].
       
  1113 
       
  1114     "
       
  1115      did someone react (i.e. has my extent changed) ?
       
  1116      (if not, we scroll horizontally)
       
  1117     "
       
  1118     xCol := (self xOfCol:cursorCol inVisibleLine:cursorLine) - leftOffset.
       
  1119     (xCol > (width * (5/6))) ifTrue:[
       
  1120 	newOffset := leftOffset + (width // 2).
       
  1121     ] ifFalse:[
       
  1122 	(xCol < (width * (1/6))) ifTrue:[
       
  1123 	    newOffset := 0 max: leftOffset - (width // 2).
       
  1124 	] ifFalse:[
       
  1125 	    newOffset := leftOffset
       
  1126 	]
       
  1127     ].
       
  1128     newOffset ~~ leftOffset ifTrue:[
       
  1129 	self scrollHorizontalTo:newOffset.
       
  1130 "/        leftOffset := newOffset.
       
  1131 "/        self clear.
       
  1132 "/        self redraw
       
  1133     ]
       
  1134 !
       
  1135 
       
  1136 buttonPress:button x:x y:y
       
  1137     "enable myself on mouse click"
       
  1138 
       
  1139     enabled ifFalse:[
       
  1140 	enabled := true.
       
  1141 	super buttonPress:button x:x y:y.
       
  1142 	enableAction notNil ifTrue:[
       
  1143 	    enableAction value
       
  1144 	]
       
  1145     ] ifTrue:[
       
  1146 	super buttonPress:button x:x y:y
       
  1147     ]
       
  1148 !
       
  1149 
       
  1150 focusIn
       
  1151     "got the explicit focus"
       
  1152 
       
  1153     enabled ifFalse:[
       
  1154 	enabled := true.
       
  1155 	super focusIn.
       
  1156 	enableAction notNil ifTrue:[
       
  1157 	    enableAction value
       
  1158 	]
       
  1159     ] ifTrue:[
       
  1160 	super focusIn
       
  1161     ].
       
  1162 !
       
  1163 
       
  1164 canHandle:aKey
       
  1165     "return true, if the receiver would like to handle aKey
       
  1166      (usually from another view, when the receiver is part of
       
  1167       a more complex dialog box).
       
  1168      We do return true here, since the editfield will handle
       
  1169      all keys.
       
  1170      OBSOLETE: dont use this anymore - its a leftover for the tableWidget"
       
  1171 
       
  1172     ^ true
       
  1173 ! !
       
  1174 
       
  1175 !EditField methodsFor:'editing'!
       
  1176 
       
  1177 paste:someText
       
  1178     "redefined to force text to 1 line"
       
  1179 
       
  1180     super paste:someText.
       
  1181     list size > 1 ifTrue:[
       
  1182 	self deleteFromLine:2 toLine:(list size)
       
  1183     ]
       
  1184 ! !