"======================================================================
|
|   Smalltalk GUI wrapper for text widgets
|
|   $Revision: 1.7.5$
|   $Date: 2000/05/28 16:56:52$
|   $Author: pb$
|
 ======================================================================"


"======================================================================
|
| Copyright 1988-92, 1994-95, 1999, 2000 Free Software Foundation, Inc.
| Written by Brad Diller.
|
| This file is part of GNU Smalltalk.
|
| GNU Smalltalk is free software; you can redistribute it and/or modify it
| under the terms of the GNU General Public License as published by the Free
| Software Foundation; either version 2, or (at your option) any later version.
| 
| GNU Smalltalk 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 General Public License for more
| details.
| 
| You should have received a copy of the GNU General Public License along with
| GNU Smalltalk; see the file COPYING.  If not, write to the Free Software
| Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.  
|
 ======================================================================
"

Primitive subclass:  #PText
	  instanceVariableNames: ' textMsg selection canBeDirty'
	  classVariableNames: ''
	  poolDictionaries: ''
	  category: 'Graphics-Windows'
!

!PText class methodsFor: 'instance creation'!

bloxClass
    ^BText
!

new: parent 
    | view |
    view := self new.
    view canBeDirty: true.
    view parentView: parent.
    view blox: (self bloxClass new: parent blox).
    "view blox backgroundColor: 'LemonChiffon'."
    view blox callback: view message: 'setDirtyFlag'.
    ^view
!

newReadOnly: parent
    | view |
    view := self new.
    view parentView: parent.
    view blox: (self bloxClass newReadOnly: parent blox).
    "view blox backgroundColor: 'LemonChiffon'."
    ^view
! !

!PText methodsFor: 'initializing'!

stateChange: stateChangeKey
    "Install message handler to redraw text pane in response to an stateChangeKey 
    message.  If there is text which is initially selected, select the text.  This
    feature is utilized by some types of message set browsers"
    self stateChange: stateChangeKey updateWith: 
	[ self display.
	  selection notNil
	      ifTrue: [self findString: selection]].
!

selection: aString
    selection := aString
!

setDirtyFlag
    "Set modification state of text view"
    dirty := canBeDirty
!

textMsg: textSelector
    "The textSelector is supplied by the view's data object.  When invoked
    from computeText, the text to be displayed is returned"
    textMsg := textSelector
! !

!PText methodsFor: 'displaying'!

canBeDirty
    ^canBeDirty
!

canBeDirty: aBoolean
    canBeDirty := aBoolean.
    dirty := dirty & canBeDirty
!

displayError: errorString at: lineNo
    "Display error string at end of line indicated by lineNo"
    ((self blox gotoLine: lineNo end: true) = 0)
	ifFalse: [self blox insertSelectedText: errorString]
	ifTrue: [self beep].
!

displayError: errorString
    "Insert error string at cursor and select it"
    self blox insertTextSelection: errorString
!

display
    "Update text view.  Dirty flag is reset"
    textMsg isNil ifFalse: [ self contents: (data perform: textMsg) ].
    dirty := false.
!

findString: aString
    "Select aString in the text view.  If not found, beep"
    (blox searchString: aString) = 0
	ifTrue: [self beep].
!

confirm: aString
    "Used by canUpdate when the text has been modified.  If the user wishes to 
     discard the editing changes by pressing 1, the dirty flag is reset"
    ModalDialog new message: aString in: self;
	addButton: 'Yes' message: [dirty := false];
	addButton: 'No' message: [];
	display: self.
    ^dirty not
!

canUpdate
    "If text has been modified, display a prompter.  If the No button is
    selected, return true"
    | cancel |
    data isNil ifTrue: [^true].
    canBeDirty ifFalse: [^true].
    dirty ifFalse: [^true].
    cancel := self confirm: 'The text has been altered.' , 
	(String with: Character nl), 'Do you wish to discard those changes?'.
    ^cancel.
! !

!PText methodsFor: 'polymorphism'!

contents: text
    blox contents: text
! !

!PText methodsFor: 'blue button menu items'!

gstCut
    self gstCopy.
    self gstClear.
!

gstCopy
    Blox clipboard: blox getSelection.
!


gstPaste
    | clip |
    clip := Blox clipboard.
    clip isEmpty
	ifFalse: [blox replaceSelection: clip].
!

gstClear
    blox replaceSelection: ''.
!

line
    "Prompt user to enter a line number.  If a valid number, attempt
    to scroll to entered line number"
    | prompter |
    prompter := Prompter message: 'Goto line...' in: self.
    prompter response isEmpty ifTrue: [ ^self ].

    (prompter response allSatisfy: [ :ch | ch isDigit ])
	ifTrue: [ blox gotoLine: (prompter response asInteger) end: false ]
!

find
    | prompter |
    prompter := Prompter message: 'Search...' in: self.
    prompter response ~= '' 
	ifTrue: [blox searchString: prompter response].  
!

eval
    | text pos |
    pos := blox currentLine.
    text := blox getSelection.
    (text isNil or: [text size = 0]) ifTrue: [^self beep].
    Behavior  evaluate:  text ifError: [:fname :lineNo :errorString | 
	self displayError: errorString at: lineNo + pos ]
!

evalAndPrintResult
    "Display and select result of evaluation of selected expression to right of
    selection"
    | text obj pos |
    pos := blox currentLine.
    text := blox getSelection.
    (text isNil or: [text size = 0]) ifTrue: [^self beep].
    obj := (Behavior  evaluate:  text ifError: [:fname :lineNo :errorString | 
	self displayError: errorString at: lineNo + pos. ^nil ]).
    blox insertTextSelection: obj printString.
!

evalAndInspectResult
    "Open an inspector on the result of the evaluation of the selected Smalltalk expression"
    | obj text pos |
    pos := blox currentLine.
    text := blox getSelection.
    (text isNil or: [text size = 0]) ifTrue: [^self beep].
    obj := (Behavior  evaluate:  text ifError: [:fname :lineNo :errorString | 
	self displayError: errorString at: lineNo + pos. ^nil ]).
    obj inspect.
!

senders
    blox getSelection ifNotNil: [ :sel |
	MethodSetBrowser sendersOf: sel asSymbol parent: self ]
!

implementors
    blox getSelection ifNotNil: [ :sel |
	MethodSetBrowser implementorsOf: sel asSymbol parent: self ]
!

compileIt 
"Activated when the user selects 'accept' from the popup menu.  Send a 
stateChangeMsg to the data object"
    | text isChanged |
    text := blox contents.
    (text isNil or: [text size = 0]) ifTrue: [^self beep].
    self canChangeState ifTrue: [
	isChanged := stateChangeMsg numArgs = 1
	     "One parameter selector"
	     ifTrue:
		 [ (data perform: stateChangeMsg with: blox contents) isNil]
	     "Two parameter selector"
	     ifFalse:
		 [ (data perform: stateChangeMsg with: blox contents with: self) isNil].

	dirty := isChanged & canBeDirty
    ]
!

revert
    "Revert text changes and replace current text with original text" 
    self display.
! !