CodeView.st
author Claus Gittinger <cg@exept.de>
Fri, 01 Aug 1997 21:48:27 +0200
changeset 1293 c0806b73dc48
parent 1261 bdb18f73205c
child 1396 4e019d312d6f
permissions -rw-r--r--
disable accept menuItem, if there is no acceptAction

"
 COPYRIGHT (c) 1989 by Claus Gittinger
	      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.
"

Workspace subclass:#CodeView
	instanceVariableNames:'explainAction commentStrings'
	classVariableNames:''
	poolDictionaries:''
	category:'Interface-Workspace'
!

!CodeView class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 1989 by Claus Gittinger
	      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
"
    a view for text which is known to be smalltalk code. 
    It adds 'explain' to the menu, and defines another action: 
      explainAction to be performed for explain.

    This action is to be defined by the user of this view 
    (i.e. usually the owning browser)

    In addition, uncomment/comment are added to the controlMenu.
    These are smalltalk specific - if you plan to edit other language code,
    you need a different kind of CodeView for that.

    If used with a model, accept sends the changeMsg to it (as defined in EditTextView).
    (however, it is possible to define both changeMsg and acceptAction)

    See how doIt/printIt/inspectIt are handled in the superclass: Workspace.

    Caveat:
        in this version, CodeView does not yet support MVC setups for doIt
        and explain.
        If required, simulate this by setting the doItAction and
        explainAction, to notify the model manually about whats going on.

    [instance variables:]
        commentStrings          <Array>         an array with 2 entries;
                                                the first defining the EOL-comment string,
                                                the 2nd (another array) defining opening
                                                and closing comment strings.
                                                Default to ST/X comments,
                                                can be changed in an instance for other
                                                programming languages.

    [author:]
        Claus Gittinger

    [see also:]
        Workspace EditTextView TextView
"
! !

!CodeView methodsFor:'accessing'!

commentStrings:anArrayOfCommentStrings
    "define the comment strings"

    commentStrings := anArrayOfCommentStrings

    "Created: 7.1.1997 / 20:25:06 / cg"
!

explainAction:aBlock
    "set the action to be performed on explain"

    explainAction := aBlock
! !

!CodeView methodsFor:'editing'!

commentFrom:line1 to:line2
    "convenient function to comment out a block.
     All lines from line1 to line2 get an end-of-line comment
     in the first col."

    |eolComment opening closing|

    eolComment := commentStrings at:1.
    eolComment isNil ifTrue:[
        opening := (commentStrings at:2) at:1.
        closing := (commentStrings at:2) at:2.
        (opening isNil or:[closing isNil]) ifTrue:[^ self].
    ].

    line1 to:line2 do:[:lineNr |
        |l|

        l := self listAt:lineNr.
        l isNil ifTrue:[l := ''].
        eolComment notNil ifTrue:[
            l := eolComment , l
        ] ifFalse:[
            l := opening , l , closing
        ].
        self at:lineNr put:l
    ].
    self textChanged.

    "Modified: 7.1.1997 / 20:15:06 / cg"
!

commentSelection
    "convenient function to comment out a block.
     All lines from line1 to line2 get an end-of-line comment
     in the first col."

    |e commentPair opening closing|

    selectionStartLine notNil ifTrue:[
        (selectionStartCol == 1 and:[selectionEndCol == 0]) ifTrue:[
            self commentFrom:selectionStartLine to:selectionEndLine-1
        ] ifFalse:[
            commentPair := commentStrings at:2.
            opening := commentPair at:1.
            closing := commentPair at:2.
            (opening isNil or:[closing isNil]) ifTrue:[^ self].

            e := selectionEndCol.

            self insertString:closing atLine:selectionEndLine col:e+1.
            self insertString:opening atLine:selectionStartLine col:selectionStartCol.

            selectionStartLine == selectionEndLine ifTrue:[e := e + opening size].
            self selectFromLine:selectionStartLine col:selectionStartCol
                         toLine:selectionEndLine col:e+closing size.
        ]
    ]

    "Modified: 7.1.1997 / 20:13:25 / cg"
!

uncommentFrom:line1 to:line2
    "convenient function to comment out a block.
     All lines from line1 to line2 get an end-of-line comment
     in the first col."

    |eolComment opening closing rest|

    eolComment := commentStrings at:1.
    eolComment isNil ifTrue:[
        opening := (commentStrings at:2) at:1.
        closing := (commentStrings at:2) at:2.
        (opening isNil or:[closing isNil]) ifTrue:[^ self].
    ] ifFalse:[
        rest := eolComment size + 1.
    ].

    line1 to:line2 do:[:lineNr |
        |l|

        l := self listAt:lineNr.
        l notNil ifTrue:[
            eolComment notNil ifTrue:[
                (l startsWith:eolComment) ifTrue:[
                    l := l copyFrom:rest
                ]
            ] ifFalse:[
                ((l startsWith:opening)
                and:[l endsWith:closing]) ifTrue:[
                    l := l copyFrom:opening size + 1.
                    l := l copyWithoutLast:closing size.
                ]
            ].
            self at:lineNr put:l
        ]
    ].
    self textChanged.

    "Modified: 7.1.1997 / 20:17:44 / cg"
!

uncommentSelection
    "convenient function to comment out a block.
     All lines from line1 to line2 get an end-of-line comment
     in the first col."

    |e commentPair opening closing sz1 sz2|

    selectionStartLine notNil ifTrue:[
        (selectionStartCol == 1 and:[selectionEndCol == 0]) ifTrue:[
            self uncommentFrom:selectionStartLine to:selectionEndLine-1
        ] ifFalse:[
            commentPair := commentStrings at:2.
            opening := commentPair at:1.
            closing := commentPair at:2.
            (opening isNil or:[closing isNil]) ifTrue:[^ self].

            sz1 := opening size.
            sz2 := closing size.

            ((self 
                stringAtLine:selectionStartLine 
                from:selectionStartCol
                to:selectionStartCol+sz1 - 1) = opening
            and:[(self 
                stringAtLine:selectionEndLine 
                from:selectionEndCol - sz2 + 1
                to:selectionEndCol) = closing ]) ifTrue:[

                self deleteCharsAtLine:selectionEndLine fromCol:selectionEndCol-sz2+1 toCol:selectionEndCol.
                self deleteCharsAtLine:selectionStartLine fromCol:selectionStartCol toCol:selectionStartCol+sz1-1.

                e := selectionEndCol - sz2.
                selectionStartLine == selectionEndLine ifTrue:[e := e - sz1].
                self selectFromLine:selectionStartLine col:selectionStartCol
                             toLine:selectionEndLine col:e.
            ]
        ]
    ]

    "Modified: 7.1.1997 / 20:13:32 / cg"
! !

!CodeView methodsFor:'event handling'!

keyPress:key x:x y:y
    "catch keyboard shortcuts"

    <resource: #keyboard (#Explain #Help 
                          #CommentSelection #UncommentSelection)>

    (key == #Explain) ifTrue:[^ self explain].
    (key == #Help)    ifTrue:[^ self explain].
    (key == #CommentSelection)    ifTrue:[^ self commentSelection].
    (key == #UncommentSelection)  ifTrue:[^ self uncommentSelection].

    super keyPress:key x:x y:y

    "Modified: 9.1.1997 / 12:14:00 / cg"
! !

!CodeView methodsFor:'initialization'!

initialize
    super initialize.

    commentStrings := #('"/'
                        ('"' '"'))

    "Created: 7.1.1997 / 19:47:13 / cg"
! !

!CodeView methodsFor:'menu & menu actions'!

accept
    "redefined accept action;
     save cursor and selection to allow restore in case of an error
     (we are typically compiling here ... and the compiler may show
     errors by highlighting them)"

    acceptEnabled == false ifTrue:[
        device beep.
        ^ self
    ].

    codeStartPosition := 1.
    [
        AbortSignal handle:[:ex |
            self cursor:Cursor normal.
            "redraw selection in normal color"
            self selectFromLine:selectionStartLine col:selectionStartCol 
                         toLine:selectionEndLine col:selectionEndCol.
            ex return
        ] do:[
            super accept.
        ]
    ] valueNowOrOnUnwindDo:[
        self unselect.
    ]

    "Modified: 7.3.1997 / 11:06:13 / cg"
!

editMenu
    "return the popUpMenu;
     to make this independent from what is defined in superclasses,
     get the superclass menu and add my functions."

    <resource: #keyboard (#CommentSelection #UncommentSelection 
                          #Accept #Explain)>
    <resource: #programMenu>

    |m sub|

    m := super editMenu.

    self sensor ctrlDown ifTrue:[
        m addLabels:(resources array:#('-' 'commentIt' 'uncommentIt'))
          selectors:#(nil commentSelection uncommentSelection)
          accelerators:#(nil CommentSelection UncommentSelection)
          after:#again.

        self hasSelection ifFalse:[
            m disableAll:#(commentSelection uncommentSelection) 
        ].
    ] ifFalse:[

        "
         codeViews do support #accept
         ... add it after #inspectIt
        "
        m addLabels:(resources array:#('-' 'accept'))
          selectors:#(nil accept)
          accelerators:#(nil #Accept)
          after:#inspectIt.

        (acceptEnabled == false 
        or:[acceptAction isNil]) ifTrue:[
            m disable:#accept
        ].

        "
         and add #explain after $gotoLine in the extra menu
        "
        sub := m subMenuAt:#others.
        sub notNil ifTrue:[
            sub addLabels:(resources array:#('-' 'explain'))
                selectors:#(nil explain)
                accelerators:#(nil Explain)
                after:#gotoLine.

            self hasSelection ifFalse:[
                sub disable:#explain 
            ].
        ].
    ].
    ^ m.

    "Modified: 1.8.1997 / 21:47:55 / cg"
!

explain
    "explain action;
     evaluate the explainBlock passing whole contents and 
     selection as arguments."

    |text|

    explainAction notNil ifTrue:[
	text := self selection.
	text notNil ifTrue:[
	    explainAction value:(self contents) value:(text asString)
	]
    ]
! !

!CodeView class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libwidg/CodeView.st,v 1.37 1997-08-01 19:48:27 cg Exp $'
! !