SmallSense__PO.st
author Claus Gittinger <cg@exept.de>
Fri, 18 Nov 2016 11:56:15 +0100
branchcvs_MAIN
changeset 996 f5c13fa1943d
parent 977 0ec81b33ba14
permissions -rw-r--r--
#OTHER by cg documentation

"
stx:goodies/smallsense - A productivity plugin for Smalltalk/X IDE
Copyright (C) 2013-2014 Jan Vrany

This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License. 

This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
Lesser General Public License for more details.

You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
"
"{ Package: 'stx:goodies/smallsense' }"

"{ NameSpace: SmallSense }"

HierarchicalItem subclass:#PO
	instanceVariableNames:'label relevance context'
	classVariableNames:'IconWidth'
	poolDictionaries:''
	category:'SmallSense-Core-Interface-PO'
!

!PO class methodsFor:'documentation'!

copyright
"
stx:goodies/smallsense - A productivity plugin for Smalltalk/X IDE
Copyright (C) 2013-2014 Jan Vrany

This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License. 

This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
Lesser General Public License for more details.

You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
"
! !

!PO class methodsFor:'initialization'!

initialize
    "Invoked at system start or when the class is dynamically loaded."

    "/ please change as required (and remove this comment)

    IconWidth := 16.

    "Modified: / 18-09-2013 / 00:13:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!PO class methodsFor:'Instance creation'!

forClass: aClass
    ^ ClassPO new initializeWithClass: aClass

    "Created: / 20-05-2014 / 09:56:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

forClass: aClass selector: aSymbol
    ^ MethodPO new initializeWithClass: aClass selector: aSymbol

    "Created: / 20-05-2014 / 10:31:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

forClasses: aCollection selector: aSymbol
    ^ MethodPO new initializeWithClasses: aCollection selector: aSymbol

    "Created: / 20-05-2014 / 10:33:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

forClasses: aCollection selector: aSymbol prefix: aString
    ^ aString notEmptyOrNil 
        ifTrue: [ MethodKeywordRestPO new initializeWithClasses: aCollection selector: aSymbol prefix: aString ]
        ifFalse:[ MethodPO new initializeWithClasses: aCollection selector: aSymbol ]

    "Created: / 20-05-2014 / 10:43:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

forFieldBinding: binding
    ^ VariableBindingPO new binding: binding

    "Created: / 14-08-2014 / 09:04:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

forGlobalNamed: name
    ^ VariablePO globalVariable: name

    "Created: / 24-07-2014 / 16:50:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

forInstanceVariableNamed: nm in: cls
    ^ VariablePO instanceVariable: nm in: cls.

    "Created: / 13-08-2014 / 21:27:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

forLocalVariableBinding: binding
    ^ VariableBindingPO new binding: binding

    "Created: / 14-08-2014 / 09:04:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

forLocalVariableNamed: nm
    ^ VariablePO variable: nm

    "Created: / 12-08-2014 / 10:40:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

subject: anObject
    <resource: #obsolete>

    ^self new subject: anObject

    "Created: / 06-04-2011 / 21:01:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!PO class methodsFor:'instance creation-java'!

forMethodBinding: binding
    ^ MethodBindingPO new binding: binding

    "Created: / 13-08-2014 / 22:24:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!PO methodsFor:'accessing'!

context
    ^ context
!

context:something
    something notNil ifTrue:[
        context := something.
    ].

    "Modified: / 17-10-2013 / 01:16:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

cursorColumnAfterCompleteForLanguage: language
    "Answers a cursor column after completion. The number returned
     is relative to the start of the text being replaced"

    ^ (self stringToCompleteForLanguage: language) size

    "Created: / 03-10-2013 / 16:49:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 04-10-2013 / 07:48:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

hint
    "Return a hint text to be displayed in gray after a label
     (if there's space). If nil is returned, no hint is shown"

    ^ nil

    "Created: / 20-05-2014 / 11:52:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

icon

    ^nil

    "Created: / 04-04-2011 / 17:25:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

label
    "Return a text to be displayed. The label may be cached
     `label` instvar."

    ^ self subclassResponsibility

    "Created: / 07-04-2011 / 09:55:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 20-05-2014 / 11:30:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

name
    <resource: #obsolete>

    self obsoleteMethodWarning.
    ^ self label

    "Modified: / 20-05-2014 / 11:36:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

name:aString
    <resource: #obsolete>

    self shouldNeverBeSent

    "Modified: / 20-05-2014 / 11:36:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

relevance
    "Return relevance value, i.e., how much likely is that this
     is what user wants to complete.

     Relevance is an integer between 1 (least relevant) and 
     100 (most relevant)"

    ^ relevance ? 1

    "Modified: / 18-01-2014 / 22:41:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

relevance: anInteger
    "Set the relevance value, i.e., how much likely is that this
     is what user wants to complete.

     Relevance is an integer between 1 (least relevant) and 
     100 (most relevant)"

    ^ relevance := anInteger.

    "Modified: / 18-01-2014 / 22:41:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

stringAlreadyWritten
    "Answers a string already written in the textview"    

    ^ context wordBeforeCursor

    "Created: / 20-10-2013 / 00:14:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

stringToComplete
    ^ self stringToCompleteForLanguage: context language.

    "Created: / 05-04-2011 / 16:48:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 31-03-2014 / 23:10:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

stringToCompleteForLanguage: aProgrammingLanguage
    "Answers a string to complete"

    ^ self subclassResponsibility

    "Created: / 02-10-2013 / 02:32:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 20-05-2014 / 11:32:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

subject
    <resource: #obsolete>

    self error: 'Should no longer be sent'.

    "Modified: / 20-05-2014 / 10:16:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

subject:anObject
    <resource: #obsolete>

    self error: 'Should no longer be sent'.

    "Modified: / 20-05-2014 / 10:16:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!PO methodsFor:'completion'!

insert
    "Insert given completion item at cursor position"

    | po stringToComplete stringAlreadyWritten stringToInsert textView |

    po := self.
    textView := context codeView.
    stringToComplete := po stringToCompleteForLanguage: context language.
    stringAlreadyWritten := self stringAlreadyWritten.
    stringToInsert := stringToComplete copyFrom: (stringAlreadyWritten size + 1).
    textView isCodeView2 ifTrue:[textView := textView textView].
    (stringToComplete startsWith: stringAlreadyWritten) ifTrue:[
        context support 
                electricInsert:stringToInsert
                ignoreKeystrokes:stringToInsert.
        textView cursorCol: textView cursorCol - stringToComplete size + (po cursorColumnAfterCompleteForLanguage: context language).
    ] ifFalse:[
       | startCol endCol |
       textView undoableDo:[
            endCol := textView cursorCol - 1.
            startCol := textView cursorCol - stringAlreadyWritten size.
            textView insertStringAtCursor: stringToComplete.
            textView deleteFromLine:textView cursorLine col: startCol toLine:textView cursorLine col:endCol.
        ].
        textView cursorCol: startCol + (po cursorColumnAfterCompleteForLanguage: context language).

    ].

    "Created: / 17-10-2013 / 01:08:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 16-02-2014 / 00:02:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!PO methodsFor:'displaying'!

displayLabel:lab h:labelH on:gc x:x0 y:y0 h:h
    | cx cy icon hint hintW |

    cx := x0.

    "/ Display icon...
    icon := self icon.
    icon notNil ifTrue:[
        icon displayOn: gc x: cx y: y0 + (h // 2) - (icon height // 2).
    ].
    cx := cx + IconWidth.

    "/ Display label
    super displayLabel:lab h:labelH on:gc x:cx y:y0 h:h.

    "/ Display hint
    hint := self hint.
    hint notNil ifTrue:[ 
        cx := cx + (lab widthOn: gc).
        hintW := hint widthOn: gc.
        "/ Check whether there's enougn space fit the hint
        (gc width) > (cx + hintW + 10"spacing") ifFalse:[ 
            hint isString ifFalse:[ 
                "/ There's nothing to do for non-strings
                ^ self 
            ].
            "/ Try to shorten the text.
            hint := hint contractAtEndTo: ((gc width - cx - 10) // ('m' widthOn: gc)).
            hint size < 6 ifTrue:[ 
                "/ To short to be meaningfull, give up.
                ^ self.
            ].
            hintW := hint widthOn: gc.
            "/ Check again if it can fit...
            (gc width) > (cx + hintW + 10"spacing") ifFalse:[ 
                "/ Give up.
                ^ self.
            ]
        ].

        cx := gc width - hintW - 3"right padding".
        cy := y0 - ((labelH + 1 - h) // 2).    
        (hint isString and:[hint isText not]) ifTrue:[ 
            | savPaint |

            cy := cy + (hint ascentOn:gc).   
            savPaint := gc paint.
            gc paint: (Color gray: 40).
            hint displayOn:gc x: cx y:cy.  
            gc paint: savPaint
        ] ifFalse:[ 
            hint isText ifTrue:[ 
                cy := cy + (hint ascentOn:gc).   
            ].
            hint displayOn:gc x: cx y:cy.  
        ].
    ].

    "Created: / 24-07-2013 / 00:22:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 20-05-2014 / 12:22:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

displayString
    ^ self label

    "Created: / 20-04-2012 / 18:19:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 20-05-2014 / 11:34:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!PO methodsFor:'printing & storing'!

printOn:aStream
    "append a printed representation of the receiver to the argument, aStream"

    super printOn:aStream.
    aStream nextPut:$(.
    aStream nextPutAll:self label.
    aStream nextPut:$).

    "Modified: / 13-08-2014 / 01:53:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!PO methodsFor:'queries'!

startsWith: prefix

    ^self stringToComplete startsWith: prefix

    "Created: / 26-11-2011 / 19:25:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!PO methodsFor:'testing'!

isSmallSenseClassPO
    ^ false
!

isSmallSenseConstantPO
    ^ false
!

isSmallSenseMethodBindingPO
    "return false here; to be redefined in subclass(es)"

    ^ false
!

isSmallSenseMethodPO
    ^ false
!

isSmallSenseSnippetPO
    ^ false
!

isSmallSenseVariableBindingPO
    "return false here; to be redefined in subclass(es)"

    ^ false
!

isSmallSenseVariablePO
    ^ false
! !

!PO class methodsFor:'documentation'!

version
    ^ '$Header$'
!

version_CVS
    ^ '$Header$'
!

version_HG

    ^ '$Changeset: <not expanded> $'
!

version_SVN
    ^ '$Id$'
! !


PO initialize!