EditTextViewCompletionSupport.st
author Claus Gittinger <cg@exept.de>
Fri, 24 Apr 2020 12:05:44 +0200
changeset 6847 22dc78cb5436
parent 6828 7795234a7575
permissions -rw-r--r--
#FEATURE by cg class: TextView changed: #editMenu

"{ Encoding: utf8 }"

"
 COPYRIGHT (c) 2018 by eXept Software AG
              All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.  This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"
"{ Package: 'stx:libwidg' }"

"{ NameSpace: Smalltalk }"

Object subclass:#EditTextViewCompletionSupport
	instanceVariableNames:'completionView completionProcess editView autoSelect
		editViewLostFocusBlock'
	classVariableNames:'LastCompletions'
	poolDictionaries:''
	category:'Views-Text'
!

!EditTextViewCompletionSupport class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 2018 by eXept Software AG
              All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.  This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.

"
!

documentation
"
    An abstract supperclass to support completion in text views.
    Individual completion engines may create a subclass of 
    EditTextCompletionSupport and customize it.

    Basically, they have to implement #computeCompletions

    [author:]
        Claus Gittinger

    [instance variables:]

    [class variables:]

    [see also:]

"
! !

!EditTextViewCompletionSupport class methodsFor:'instance creation'!

for:anEditView
    ^ self new editView:anEditView
! !

!EditTextViewCompletionSupport class methodsFor:'queries'!

isAbstract
    ^ self == EditTextViewCompletionSupport

    "Created: / 26-09-2013 / 16:22:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!EditTextViewCompletionSupport methodsFor:'accessing'!

editView:anEditTextView
    editView := anEditTextView.
! !

!EditTextViewCompletionSupport methodsFor:'events'!

buttonPress:button x:x y:y
    self closeCompletionView.
!

editViewLostFocus
    "this is a hack for Windows:
     on windows, an activate:false event is first sent to my textView,
     then an activate is sent to the completion popup.
     this is done BEFORE the buttonPress event is delivered.
     therefore, allow for the activate of the completionMenu and its button event to be processed.
     before forcing it to be closed..."

    completionView notNil ifTrue:[
        editView graphicsDevice anyButtonPressed ifTrue:[
            editView sensor pushUserEvent:#editViewLostFocus for:self.
        ] ifFalse:[
            "/ don't do it here - give code completion view a chance to call its select action
            "/ (bug was: sometimes, the completion did not arrive)
            "/ self closeCompletionView.
            editView sensor pushUserEvent:#closeCompletionView for:self
        ]
    ].
!

handleKeyPress:key x:x y:y
    "return true, if I have eaten this keypress"

    <resource: #keyboard ( #'Control_L' #Ctrl #'Control_R' #Control 
                           #Tab #CursorDown #CursorUp #CursorLeft #CursorRight #Return
                           #Escape #BackSpace
                           #'Shift_L' #'Shift_R' #Shift) >

    |ch eatCursorLeftOrRight eatCursorUpDown sensor|

    "/ completeImmediate := UserPreferences current immediateCodeCompletion.

    sensor := editView sensor.
    
    "/ open on CTRL- or TAB-key?
    (completionView notNil and:[completionView realized]) ifFalse:[
        editView hasSelection ifFalse:[
            ch := editView characterBeforeCursor.

            (ch notNil "/ i.e. not at begin of line
              and:[ ch isLetterOrDigitOrUnderline or:[ch == Character space]]
            ) ifTrue:[
                (key == #Control_L or:[ key == #Ctrl or:[ key == #Control_R or:[ key == #Control]]]) ifTrue:[
                    UserPreferences current codeCompletionOnControlKey ifTrue:[
                        autoSelect := true.
                        self updateCompletionList
                    ]
                ].
                ((key == #Tab) and:[sensor shiftDown not]) ifTrue:[
                    UserPreferences current codeCompletionOnTabKey ifTrue:[
                        "/ only if the character after the cursor is a separator!!
                        "/ otherwise, we cannot insert tabs 
                        ((ch := editView characterAfterCursor) isNil or:[ch isSeparator]) ifTrue:[
                            autoSelect := true.
                            self updateCompletionList.
                            "/ ^ true
                        ].
                    ].
                ]
            ].
        ].
        ^ false.
    ].

    "/ the completion view is already open
    "/ determine, if the key should be forwarded to it (cursor keys)

    editView cursorCol <= 1 ifTrue:[^ false].
    
    "/ key for completion view ? (careful: do not forward too many, it would disturb user's typing)
    key isCharacter ifFalse:[
        "/ forward to menu
        (completionView notNil) ifTrue:[
            "/never
            eatCursorLeftOrRight := false.
"/                                    completeImmediate not
"/                                    or:[ sensor shiftDown 
"/                                    or:[ sensor ctrlDown ]].
            "/ only with shift or ctrl
            eatCursorUpDown := 
                    (UserPreferences current codeCompletionViewKeyboardNavigationNeedsModifier not)
                    or:[ sensor shiftDown 
                    or:[ sensor ctrlDown]].

            ((key == #CursorDown and:[eatCursorUpDown])
                or:[ (key == #CursorUp and:[eatCursorUpDown])
                or:[ ((key == #CursorLeft) and:[eatCursorLeftOrRight])
                or:[ ((key == #CursorRight) and:[eatCursorLeftOrRight])
                or:[ ((key == #Return) and:[ completionView hasSelection ])
            ]]]]) ifTrue:[
                "/ forward to completion view
                completionView sensor pushAction:[ completionView keyPress:key x:0 y:0 ].
                ^ true.
            ].

            (key == #Control_L or:[ key == #Control_R or:[ key == #Control or:[ key == #Ctrl ]]]) ifTrue:[
                "/ CTRL is a toggle
"/                self closeCompletionView.   
"/                ^ true.
                ^ false "/ don't eat
            ].
            (key == #Escape) ifTrue:[
                self closeCompletionView.
                ^ true  "/ EAT
            ].
            "/ shift does not close
            (key == #Shift_L or:[ key == #Shift_R or:[ key == #Shift]]) ifTrue:[
                ^ false "/ don' eat
            ].

            (key == #BackSpace) ifTrue:[
                ^ false "/ don' eat
            ].
            self closeCompletionView.
            ^ false "/ don' eat
        ].
    ].
    ^ false.

    "Modified: / 24-08-2017 / 21:32:52 / cg"
    "Modified: / 03-07-2018 / 13:41:45 / sr"
    "Modified: / 05-06-2019 / 17:06:15 / Claus Gittinger"
!

postKeyPress:key
    <resource: #keyboard ( #'BasicBackspace' #BackSpace)>

    |doComplete ch w|

    UserPreferences current immediateCodeCompletion ifFalse:[
        "/ only update, if already open
        completionView isNil ifTrue:[^ self].
    ].

    "/ (completionView notNil and:[completionView realized]) ifTrue:[^ self].
    editView hasSelection ifTrue:[^ self].

    ch := editView characterAfterCursor.
    "/ not when within a word
    (ch notNil and:[ch isLetterOrDigit]) ifTrue:[^ self]. 

false ifTrue:[
    ch := editView characterBeforeCursor.
    (ch notNil and:[ch isLetterOrDigitOrUnderline]) ifFalse:[
        ^ self
    ].
].
    (key == #BackSpace or:[key == #BasicBackspace]) ifTrue:[
        autoSelect := false.
        self updateCompletionList.
        ^ self
    ].

    key isCharacter ifTrue:[
        (doComplete := key isSeparator not) ifFalse:[
            "/ also on a separator, but only if at the end of a non-empty line
            doComplete := editView lineStringBeforeCursor withoutSeparators notEmpty.
        ].
        doComplete ifTrue:[
            w := editView wordBeforeCursor.
            w isNil ifTrue:[
                doComplete := false
            ] ifFalse:[
                "/ self halt.
            ]
        ].

        doComplete ifFalse:[
            self closeCompletionView
        ] ifTrue:[
            autoSelect := false.
            self updateCompletionList.
        ].
        ^ self
    ].
!

startTimeoutForEditViewLostFocus
    "see comment in #editViewLostFocus"

    editViewLostFocusBlock isNil ifTrue:[
        editViewLostFocusBlock := [self editViewLostFocus].
"/ Pro: This saves some warnings about timeout for dead process.
"/ Con: Can add more than a single exit action
"/        Processor activeProcess 
"/            addExitAction:[Processor removeTimedBlock:editViewLostFocusBlock].
    ].
    Processor addTimedBlock:editViewLostFocusBlock afterMilliseconds:200.

    "Modified: / 24-10-2019 / 18:44:41 / Stefan Vogel"
! !

!EditTextViewCompletionSupport methodsFor:'private'!

computeAndShowCompletions
    "compute completions, then push an event to show them.
     Notice: this is interrupted and terminated if the user presses another key
     within delayTime"
    
    |delayTime completions startTime restTime|

    delayTime := 0.4 seconds.

    startTime := Timestamp now.
    completions := self computeCompletions.
    completions notEmptyOrNil ifTrue:[
        restTime := (startTime + delayTime) - Timestamp now.
        restTime positive ifTrue:[
            Delay waitFor:restTime
        ].
        self assert:completions isArray.
        self assert:completions size == 4.
        editView sensor
            pushUserEvent:#'suggestionsArrived:implementations:actions:autoSelect:'
            for:self
            withArguments:completions
    ].

    "Created: / 15-07-2019 / 17:29:54 / Claus Gittinger"
    "Modified: / 24-07-2019 / 07:53:35 / Claus Gittinger"
!

computeCompletions
    "compute the completions.
     Don't know how to do this here."

    ^ nil

    "Created: / 26-09-2013 / 17:35:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

release
    self stopCompletionProcess.
    self closeCompletionView.
    super release
!

startCompletionProcess
    "start the code completion process in the background"

    |initialList cursorX cursorY p|

    "/ terminate any previous process
    self synchronized:[
        self stopCompletionProcess.
    ].
    
    (editView sensor hasKeyPressEventFor:nil) ifTrue:[ 
        "/ 'cl' printCR.
        self closeCompletionView. 
        ^ self
    ].
    ((cursorX := editView xOfCursor) isNil
    or:[ (cursorY := editView yOfCursor) isNil ]) ifTrue:[
        "/ no cursor - user is selecting, or cursor has been scrolled out of sight.
        "/ 'cl2' printCR.
        self closeCompletionView. 
        ^ self
    ].

    initialList := #( 'Busy...' ).
    completionView notNil ifTrue:[
"/        initialList := completionView list.
    ].
    "/ self openCompletionView:initialList.

    completionProcess := p := 
        [
            [
                "/ protect end-user applications from errors
                Error handle:[:ex |
                    (ParseError accepts:ex creator) ifFalse:[
                        Smalltalk isSmalltalkDevelopmentSystem ifTrue:[ ex reject ]
                    ].
                ] do:[ 
                    |startTime|

false ifTrue:[
                    startTime := Timestamp now.
                    "/ Wait a while to give user chance finish typing.
                    "/ This also reduces CPU consumption by avoiding
                    "/ useless computation
                    Delay waitForMilliseconds: 200.
].
                    (editView topView isDebugView) ifTrue:[
                        ControlInterrupt ignoreIn:[
                            self computeAndShowCompletions.
                        ].    
                    ] ifFalse:[    
                        self computeAndShowCompletions.
                    ].
                ].
                p == completionProcess ifTrue:[
                    completionProcess := nil
                ]
            ] ifCurtailed:[
                "/ completionView notNil ifTrue:[
                "/    completionView topView destroy
                "/ ].    
            ].    
        ] newProcess.
    "/ p priority:(Processor activePriority - 1).
    p priorityRange:(Processor activePriority-1 to:Processor activePriority).
    p resume.

    "Modified: / 26-09-2013 / 17:36:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 15-07-2019 / 17:30:55 / Claus Gittinger"
!

stopCompletionProcess
    "kill any background completion process"

    |p|

    (p := completionProcess) notNil ifTrue:[
        completionProcess := nil.
        p terminate.
    ].
!

updateCompletionList
    "called for keypress events"

    self startCompletionProcess.
! !

!EditTextViewCompletionSupport methodsFor:'private-API'!

adjustSizeOfCompletionView:topView
    |screenBounds screenBoundsCorner 
     helpViewsExtent helpViewsWidth helpViewsHeight
     textCursorPosInTextView textCursorPosOnScreen 
     newX newY cursorX cursorY distanceFromCursorIfBelow distanceFromCursorIfAbove|

    editView xOfCursor isNil ifTrue:[ 
        "/ oops - no cursor shown???
        ^ self
    ].

    textCursorPosInTextView := editView xOfCursor @ editView yOfCursor.
    textCursorPosOnScreen := editView device 
                    translatePoint:textCursorPosInTextView 
                    fromView:editView toView:nil.

    cursorX := textCursorPosOnScreen x.
    cursorY := textCursorPosOnScreen y.
    distanceFromCursorIfAbove := editView font height.
    distanceFromCursorIfBelow := distanceFromCursorIfAbove * 2.

    topView resizeToFit.

    "/ make sure, the window is visible
    screenBounds := topView device monitorBoundsAt:editView topView origin.
    screenBoundsCorner := screenBounds corner.

    helpViewsExtent := topView extent.
    helpViewsWidth := helpViewsExtent x.
    helpViewsHeight := helpViewsExtent y.


    newX := cursorX + 20.
    newY := cursorY + distanceFromCursorIfBelow.

    "/ if it does not lie completely inside the screen, move it     
    (newX + helpViewsWidth) > screenBoundsCorner x ifTrue:[
        newX := screenBoundsCorner x - helpViewsWidth.
    ].
    (newY + helpViewsHeight) > screenBoundsCorner y ifTrue:[
        newY := screenBoundsCorner y - helpViewsHeight.
    ].
    newX < 0 ifTrue:[
        newX := 0
    ].    
    newY < 0 ifTrue:[
        newY := 0
    ].

    "/ topView origin:(newX @ newY).
    (cursorY between:newY and:(newY + helpViewsHeight)) ifTrue:[
        "/ lift it towards the top
        newY := cursorY - distanceFromCursorIfAbove - helpViewsHeight.
    ] ifFalse:[
        "/ (cursorX between:newX and:(newX + helpViewsWidth)) ifTrue:[
        "/     self halt.
        "/ ].
    ].
    topView origin:(newX @ newY).

    "Modified: / 24-10-2019 / 18:41:07 / Stefan Vogel"
!

closeCompletionView
    |v|

    (v := completionView) notNil ifTrue:[
        "/ completionView := nil.

        "/ let it close itself - avoids synchronization problems
        v sensor pushAction:[ completionView := nil. v topView destroy ]
    ].

    "Modified (format): / 14-09-2018 / 22:08:05 / Claus Gittinger"
!

openCompletionView
    "Opens the completion view with an initial list. Called as soon as
     completion is initiated but completion options are not yet computed."

    self openCompletionView: (Array with: 'Busy...')

    "Created: / 26-09-2013 / 17:06:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

openCompletionView: list
    "Makes sure the completion view is opened and with given `list`."
    
    |cursorX cursorY textCursorPosInTextView textCursorPosOnScreen movePos topView|

    "/ race here - openCompletionView may arrive late, when the user started to do something else
    "/ (scroll or select). Then it could happen the no cursor is currently visible.
"/ Disable dead code:
"/    cursorX := editView xOfCursor.
"/    cursorY := editView yOfCursor.
"/    (cursorX isNil or:[cursorY isNil]) ifTrue:[^ self].
"/
"/    "/ move the window away from the text cursor (to not cover what user types in)
"/    "/ get the screen-relative position of the text cursor
"/    textCursorPosInTextView := cursorX @ cursorY.
"/    
"/    "/ care for the scroll-offset (xOfCursor/yOFCursor gives me               
"/    textCursorPosInTextView := textCursorPosInTextView - (editView viewOrigin x @ 0).
"/    
"/    textCursorPosOnScreen := editView device 
"/                    translatePoint:textCursorPosInTextView 
"/                    fromView:editView toView:nil.
"/
"/    "/ currently, we have to stay away a bit, to avoid getting the focus
"/    "/ this will be somewhat to the down-right of the textCursor
"/    movePos := textCursorPosOnScreen + (60 @ (editView font height)).

    completionView isNil ifTrue:[
        completionView := CodeCompletionHelpMenuView new.
        completionView name:'completion'.
        completionView level:0.
        completionView list:list.
        completionView enable:false.
        completionView extent:completionView preferredExtentForContents.
        "/ completionView font: editView font.
        topView := CodeCompletionHelpView with:(HVScrollableView forView:completionView).
        "/ topView := CodeCompletionHelpView with:completionView.
        topView editView:editView.
    ] ifFalse:[
        completionView list:list.
        topView := completionView topView.
    ].
    
    topView ~~ completionView ifTrue:[
        topView shown ifTrue:[
            self adjustSizeOfCompletionView:topView.
        ].
    ].

    "Created: / 26-09-2013 / 17:07:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 24-10-2019 / 17:57:57 / Stefan Vogel"
! !


!EditTextViewCompletionSupport class methodsFor:'documentation'!

version
    ^ '$Header$'
!

version_CVS
    ^ '$Header$'
! !