TextCollector subclass:#TerminalView

	instanceVariableNames:'inStream outStream readerProcess shellPid kbdSequences

		escapeSequenceTree currentSequence currentTree kbdMap

		escapeLeadingChars'

	classVariableNames:''

	poolDictionaries:''

	category:'Views-TerminalViews'

!

!TerminalView class methodsFor:'documentation'!

documentation

"

    I provide terminal functionality, by forking a command interpreter

    and comunicating with it via a pty.

    I am abstract - concrete terminal characteristics are defined

    by concrete subclasses (see VT52TerminalView).

    [author:]

        Claus Gittinger

    [start with:]

        VT52TerminalView openShell

"

! !

!TerminalView class methodsFor:'testing'!

openDummy

    |in vt52|

    vt52 := self new.

    in := ForwardingStream on:''.

    in fwdStream:vt52.

    vt52 inStream:in.

    vt52 outStream:in.

    vt52 open

    "

     self openDummy

    "

!

openShell

    |in top scr vt52|

    top := StandardSystemView new.

    scr := HVScrollableView for:self in:top.

    scr origin:0.0@0.0 corner:1.0@1.0.

    vt52 := scr scrolledView.

    vt52 startShell.

    top open

    "

     VT52TerminalView openShell

    "

! !

!TerminalView methodsFor:'accessing'!

inStream

    "return the value of the instance variable 'inStream' (automatically generated)"

    ^ inStream!

inStream:something

    "set the value of the instance variable 'inStream' (automatically generated)"

    inStream := something.!

outStream

    "return the value of the instance variable 'outStream' (automatically generated)"

    ^ outStream!

outStream:something

    "set the value of the instance variable 'outStream' (automatically generated)"

    outStream := something.! !

!TerminalView methodsFor:'cursor handling'!

cursorCol:col

    "check of col is a valid cursor position; return a new col-nr if not.

     Here, the linelength is enforced"

    ^ super cursorCol:(col min:80)

!

cursorLine:l col:col

    "check of col is a valid cursor position; return a new col-nr if not.

     Here, the linelength is enforced"

    ^ super cursorLine:l col:(col min:80)

!

validateCursorCol:col inLine:line

    "check of col is a valid cursor position; return a new col-nr if not.

     Here, the linelength is enforced"

    ^ col min:80

! !

!TerminalView methodsFor:'event handling'!

keyPress:aKey x:x y:y

    |rest rawKey seq|

    inStream isNil ifTrue:[^ self].

Transcript showCR:'----'; show:'key:' ; showCR:aKey printString.

    aKey isCharacter ifTrue:[

        "/ send it down to inStream ...

        inStream nextPut:aKey.

        ^ self

    ].

    seq := kbdSequences at:aKey ifAbsent:nil.

    seq notNil ifTrue:[

Transcript show:'->' ; showCR:seq storeString.

        inStream nextPutAll:(seq withEscapes).

        ^ self

    ].

    rawKey := device keyboardMap keyAtValue:aKey ifAbsent:aKey.

    seq := kbdSequences at:rawKey ifAbsent:nil.

    seq notNil ifTrue:[

Transcript show:'->' ; showCR:seq storeString.

        inStream nextPutAll:(seq withEscapes).

        ^ self

    ].

    (rawKey startsWith:'Ctrl') ifTrue:[

        rest := rawKey copyFrom:5.

        rest size == 1 ifTrue:[

            rest := rest at:1.

            (rest >= $a and:[rest <= $z]) ifTrue:[

Transcript show:'->' ; showCR:(Character value:(rest - $a + 1)) storeString.

                inStream nextPut:(Character value:(rest - $a + 1)).

                ^ self

            ].

            (rest >= $A and:[rest <= $Z]) ifTrue:[

Transcript show:'->' ; showCR:(Character value:(rest - $a + 1)) storeString.

                inStream nextPut:(Character value:(rest - $A + 1)).

                ^ self

            ].

        ]

    ].

    Transcript show:'ignored: '; showCR:rawKey.

"/    super keyPress:aKey x:x y:y

!

shellTerminated

    self warn:'shell terminated'.

    self closeDownShell.

! !

!TerminalView methodsFor:'functions'!

doBackspace

    self cursorLeft.

    self replaceCharAtCursor:(Character space).

    self cursorLeft.

!

doCursorDown

    super cursorDown

!

doCursorHome

    super cursorHome

!

doCursorLeft

    super cursorLeft

!

doCursorNewLine

    super cursorDown

!

doCursorReturn

    super cursorToBeginOfLine

!

doCursorRight

    super cursorRight

!

doCursorUp

    super cursorUp

! !

!TerminalView methodsFor:'initialization'!

closeDownShell

    shellPid notNil ifTrue:[

        OperatingSystem terminateProcess:shellPid.

        OperatingSystem terminateProcessGroup:shellPid.

        shellPid := nil.

    ].

    readerProcess notNil ifTrue:[

        readerProcess terminate.

        readerProcess := nil

    ].

    inStream notNil ifTrue:[

        inStream close.

        inStream := nil

    ].

    outStream notNil ifTrue:[

        outStream close.

        outStream := nil

    ].

!

destroy

    self closeDownShell.

    super destroy

!

escapeSequences:codes

    |tree|

    tree isNil ifTrue:[tree := escapeSequenceTree := IdentityDictionary new].

    codes do:[:specEntry |

        |sequence function|

        sequence := (specEntry at:1) withEscapes.

        function := specEntry at:2.

        tree := escapeSequenceTree.

        sequence keysAndValuesDo:[:idx :char |

            |followup|

            idx == sequence size ifTrue:[

                tree at:char put:function

            ] ifFalse:[

                followup := tree at:char ifAbsent:nil.

                followup isNil ifTrue:[

                    tree at:char put:(followup := IdentityDictionary new).

                ].

                tree := followup

            ]

        ]

    ].

    escapeLeadingChars := escapeSequenceTree keys asArray

!

initialize

    super initialize.

    showMatchingParenthesis := false.

    insertMode := false.

    self initializeEscapeSequences.

    self initializeKeyboardSequences.

    list := OrderedCollection new:24 withAll:''.

    self initializeKeyboardMap.

    "

     VT52TerminalView openShell

    "

!

initializeEscapeSequences

    self subclassResponsibility.

!

initializeKeyboardMap

    |ctrlKeys cmdKeys|

    "/ setup my own keyboardMap, where control-keys are

    "/ not translated.

    kbdMap := device keyboardMap copy.

    ctrlKeys := kbdMap keys select:[:key | key startsWith:'Ctrl'].

    ctrlKeys do:[:key | kbdMap removeKey:key].

    cmdKeys := kbdMap keys select:[:key | key startsWith:'Cmd'].

    cmdKeys do:[:key | kbdMap removeKey:key].

    kbdMap removeKey:#Delete ifAbsent:[].

    kbdMap removeKey:#BackSpace ifAbsent:[].

    "

     VT52TerminalView openShell

    "

!

initializeKeyboardSequences

    self subclassResponsibility.

!

keyboardMap

    ^ kbdMap

!

startReaderProcess

    readerProcess isNil ifTrue:[

        readerProcess := [

            [

                |buffer n|

                buffer := String new:1024.

                [true] whileTrue:[

Transcript showCR:'wait ...'.

                    outStream readWait.

Transcript showCR:'... avail'.

                    n := outStream nextAvailableBytes:1024 into:buffer startingAt:1.

Transcript show:'got:'; showCR:n.

                    n > 0 ifTrue:[

                        self nextPutAll:(buffer copyTo:n).

                    ] ifFalse:[

                        n == 0 ifTrue:[

                            outStream atEnd ifTrue:[

Transcript showCR:'input closed:'.

                                outStream close. outStream := nil.

                                inStream close.  inStream := nil.

                                Processor activeProcess terminate.

                            ]

                        ]

                    ]

                ]

            ] valueOnUnwindDo:[

                readerProcess := nil    

            ]

        ] fork.

    ]

    "

     VT52TerminalView openShell

    "

!

startShell

    |p slaveFD execFdArray blocked exitStatus|

    p := ExternalStream makePTYPair.

    p isNil ifTrue:[

        self warn:'cannot open pty'.

        ^ self.

    ].

    "/ p at:1 is the master;

    "/ p at:2 is the slave

    inStream := outStream := (p at:1).

    inStream buffered:false.

    "/ fork a shell process on the slave-side

    slaveFD := (p at:2) fileDescriptor.

    execFdArray := Array with:slaveFD with:slaveFD with:slaveFD.

    blocked := OperatingSystem blockInterrupts.

    shellPid := Processor

               monitor:[

                  OperatingSystem

                      exec:'/bin/sh'

                      withArguments:#('sh')

                      fileDescriptors:execFdArray

                      closeDescriptors:#()

                      fork:true

                      newPgrp:true

                      inDirectory:nil.

               ]

               action:[:status |

                  Transcript show:'pid:'; showCR:status pid.

                  Transcript show:'status:'; showCR:status status.

                  Transcript show:'code:'; showCR:status code.

                  Transcript show:'core:'; showCR:status core.

                  status stillAlive ifFalse:[

                      exitStatus := status.

                      OperatingSystem closePid:shellPid.

                      shellPid := nil.

                      self pushEvent:#shellTerminated

                  ].

               ].

    shellPid isNil ifTrue:[

        self halt.

        (p at:1) close.

        (p at:2) close.

    ].

    blocked ifFalse:[

        OperatingSystem unblockInterrupts

    ].

    self startReaderProcess.

    "

     VT52TerminalView openShell

    "

! !

!TerminalView methodsFor:'menu'!

editMenu

    "return the views middleButtonMenu"

    <resource: #keyboard (#Copy #Paste #Print)>

    <resource: #programMenu>

    |items m sub shortKeys sensor|

    ((sensor := self sensor) notNil and:[sensor ctrlDown]) ifTrue:[

        items := #(

                        ('Interrupt'      doSendInterrupt)  

                  ).

    ] ifFalse:[

        items := #(

                        ('copy'         copySelection    Copy   )

                        ('paste'        pasteOrReplace   Paste  )

                        ('-'                                    )

                        ('save as ...'  save             SaveAs )

                        ('print'        doPrint          Print  )

                  ).

    ].

    m := PopUpMenu itemList:items resources:resources.

    self hasSelection not ifTrue:[

        m disable:#copySelection.

    ].

    ^ m.

    "Modified: / 21.5.1998 / 15:52:38 / cg"

! !

!TerminalView methodsFor:'misc'!

removeTrailingBlankLines

    ^ self

! !

!TerminalView methodsFor:'processing - input'!

basicNextPut:aCharacter

    super nextPut:aCharacter

!

nextPut:aCharacter

    |where next|

"/    Transcript showCR:aCharacter asciiValue.

    where := currentTree ? escapeSequenceTree.

"/    Transcript showCR:'current: ' , where storeString.

    next := where at:aCharacter ifAbsent:nil.

"/    Transcript showCR:'next: ' , next storeString.

    next isNil ifTrue:[

        "/ something collected so far ?

        currentSequence notNil ifTrue:[

            self halt.

        ].

        self replaceCharAtCursor:aCharacter.

        "/ self cursorRight.

        currentTree := nil.

        ^ self.

    ].

    next isSymbol ifTrue:[

        self perform:next.

        currentTree := nil.

        ^ self

    ].

    currentTree := next

!

nextPutAll:aCollection

    |idx|

    currentTree isNil ifTrue:[

        "/ initial state

        Transcript showCR:'initial'.

        idx := aCollection indexOfAny:escapeLeadingChars.

        idx == 0 ifTrue:[

            Transcript showCR:'nothing special'.

        ]

    ].

    aCollection do:[:ch |

        self nextPut:ch

    ].

! !

!TerminalView methodsFor:'queries'!

preferredExtent

    ^ (fontWidth * 80 + (leftMargin * 2)) @ (self heightForLines:24)

! !

!TerminalView methodsFor:'selection handling'!

paste:someText

    "paste - redefined to send the chars to the shell instead

     of pasting into the view"

    someText asString string do:[:aChar |

        inStream nextPut:aChar

    ]

! !

!TerminalView class methodsFor:'documentation'!