Transcript nextPutAll: ' The changes being imported provide enhancements to TextPane and TextEditor: 1. Triple-click on a line to select the entire line. 2. Command-H to find the current selection without getting an intervening dialog. 3. Shift key to reverse direction of find 4. Command-[ to shift selected line(s) left 4 spaces, command-] to shift right 4 spaces. Shift key modifies these to one space. 5. Command-5 to position cursor before first character in pane. Command-6 to position cursor after last character. 6. Auto-indenting to help maintain statement nesting The list of changes: -- the bulk of the changes are in: entire class for ProgrammingEditor entire class for ProgrammingPane -- some support for triple-clicking is in: single method for TerminalStream>>leftButton: single method for TerminalStream>>underDoubleClickDelay single method for TerminalStream>>underTripleClickDelay -- some modified uses of TextPane are in: single method for ClassBrowser>>openOn: single method for ClassHierarchyBrowser>>openOn: single method for FileStream>>edit single method for String>>edit single method for Debugger>>Debug -- support for changing Transcript to a ProgrammingEditor is in: single method for DispatchManager class>>makeTranscript single method for DisplayScreen class>>initSystem -- This really is not part of ProgrammingPane/Editor, but I included it anyway. It reduces the rate of bytes remaining messages when opening a file from every one K to every ten K: single method for StringModel>>fileInFrom: After these changes are filed in, a Scheduler reinitialize will be needed to complete some of the changes (like the Transcript). As this is a rather rude thing to do, I leave it up to you. These changes affect the primary places for editing (at least in my view) in the basic system. You may extend this to other methods (such as browsers not in the standard system) by replacing references to TextPane with ProgrammingPane and TextEditor with ProgrammingEditor. ' ! TextEditor subclass: #ProgrammingEditor instanceVariableNames: '' classVariableNames: '' poolDictionaries: 'CharacterConstants FunctionKeys SystemMenus ' ! TextPane subclass: #ProgrammingPane instanceVariableNames: '' classVariableNames: '' poolDictionaries: 'SystemMenus CharacterConstants ' ! !ProgrammingEditor class methods ! initializeTranscript "Private - create the system transcript window." | aTopPane text | SystemTranscript := self new. aTopPane := TopPane new. aTopPane label: 'System Transcript'; model: aTopPane dispatcher; menu: #transcriptMenu; minimumSize: 200@100; addSubpane: (text := (ProgrammingPane "--TextPane--" new dispatcher: SystemTranscript; model: String new; yourself)). aTopPane closeable: false. ^ aTopPane! windowLabeled: aString frame: aRectangle "Create a new window with label aString, frame aRectangle and answer its dispatcher." | aPane aTopPane | aPane := ProgrammingPane new. aPane model: String new; dispatcher: aPane dispatcher. aTopPane := TopPane new. aTopPane label: aString; addSubpane: aPane. aTopPane dispatcher openIn: aRectangle. Scheduler add: aTopPane dispatcher. ^ aPane dispatcher! ! !ProgrammingEditor methods ! adjustLeft "comment" ^self processAdjustKey: $[! adjustRight "comment" ^self processAdjustKey: $]! jumpToBottom "comment" ^self processJumpKey: false! jumpToTop "comment" ^self processJumpKey: true! processAdjustKey: aCharacter "Private - For a non-gap selection, replace the selected text with the aCharacter. For a gap selection, insert the aCharacter at the selection." | d | pane adjustLines: aCharacter. modified := true. pane makeSelectionVisible. EventRecord mouseOrKeyBoardEventAvailable ifFalse: [ pane displayChanges; showSelection ].! processControlKey: aCharacter "Private - Process control keys (keys with either the command or control modifiers pressed)." | d r | d := self topDispatcher activeTextDispatcher. (d notNil and: [ self ~= d ]) ifTrue: [ ^ d processControlKey: aCharacter ]. (aCharacter == $[) | (aCharacter == ${) | (aCharacter == $]) | (aCharacter == $}) ifTrue: [ ^self processAdjustKey: aCharacter]. (aCharacter == $5) | (aCharacter == $6) ifTrue: [ ^self processJumpKey: aCharacter == $5]. (aCharacter == Bs or: [aCharacter == Cr or: [aCharacter == Tab]]) ifTrue: [^ self processInputKey: aCharacter]. (pane topPane menuBar canHandleKey: aCharacter) ifTrue: [ ^ self ]. (r := KeyboardMacros at: aCharacter ifAbsent: [ nil ]) isNil ifFalse: [ ^ self processInputString: r ]. pane displayChanges; showSelection. super processControlKey: aCharacter! processJumpKey: aBoolean "Jump to beginning or end of selection." | d | pane jumpTo: aBoolean. pane makeSelectionVisible. EventRecord mouseOrKeyBoardEventAvailable ifFalse: [ pane displayChanges; showSelection ].! searchSelection "Search for the selected string." CursorManager execute change. newSelection := pane searchSelection. CursorManager normal change.! ! !ProgrammingPane class methods ! editMenu "Answer the menu to be displayed under the Edit heading." ^ (Menu labels: ('Undo/Z\', 'Cut/X\Copy/C\Paste/V\Clear\Select All/A\', 'Find.../F\Find Selection/H\Replace.../R\Again/G\', 'Adjust Left/[\Adjust Right/]\Top/5\Bottom/6') breakLinesAtBackSes lines: #(1 6 10 12) selectors: #(undeleteSelection cutSelection copySelection pasteSelection clearSelection selectAll search searchSelection replaceAll again adjustLeft adjustRight jumpToTop jumpToBottom)) title: 'Edit'; disable: #again; yourself! initialize "Create our expanded Edit menu." SystemMenus at: 'EditMenu' put: self editMenu.! ! !ProgrammingPane methods ! activatePane "comment" #(searchSelection adjustLeft adjustRight jumpToTop jumpToBottom) do: [ :m | EditMenu enable: m]. ^super activatePane! adjustLines: aCharacter "Adjust selected line(s) by: aCharacter = [ left 4 spaces aCharacter = { left 1 space aCharacter = ] right 4 spaces aCharacter = } right 1 space ." | theLine s origin corner numChars lastSpace endPt maxShift replText | origin := selection origin. corner := selection corner. (corner y > origin y) & (corner x = 0) ifTrue: [ corner := corner - (0 @ 1)]. ((aCharacter == $}) | (aCharacter == ${) or: [CurrentEvent isShift]) ifTrue: [maxShift := 1. replText := ' '] ifFalse: [maxShift := 4. replText := ' ']. origin y to: corner y do: [ :row | self selectBefore: (0 @ row). (aCharacter == $[) | (aCharacter == ${) ifTrue: [ theLine := textHolder lineAt: row. lastSpace := numChars := maxShift min: theLine size. numChars to: 1 by: -1 do: [ :i | (theLine at: i) == $ ifFalse: [lastSpace := i - 1]]. lastSpace > 0 ifTrue: [ endPt := textHolder offsetPoint: (0 @ row) by: (lastSpace @ 0). self selectFrom: (0 @ row) to: endPt. textHolder delete: selection. ]. ]. (aCharacter == $]) | (aCharacter == $}) ifTrue: [textHolder replace: selection withText: replText]. ]. ^ self selectBefore: (0 @ origin y); selectFrom: (0 @ origin y) to: 0 @ ( corner y + 1)! deactivateWindow "comment" #(searchSelection adjustLeft adjustRight jumpToTop jumpToBottom) do: [ :m | EditMenu disable: m]. ^super deactivateWindow! defaultDispatcherClass "Answer ProgrammingEditor which is the default dispatcher of a ProgrammingPane." ^ ProgrammingEditor! jumpTo: toTheTop "Jump to beginning or end of text" toTheTop ifTrue: [^ selection selectBefore:0@1] ifFalse: [^ self selectAtEnd].! replaceWithChar: aCharacter "Replace the selected text with aCharacter. If it is a new line, auto-indent to the start of the line above. Answer the position of the new character." | priorLine priorSpaces s | s := selection selectAt: (textHolder replace: selection withChar: aCharacter). aCharacter = LineDelimiter ifTrue: [priorLine := textHolder lineAt: selection origin y - 1. priorLine trimBlanks isEmpty ifTrue: [priorSpaces := priorLine size] ifFalse: [priorSpaces := (priorLine findFirst: [ :c | c ~= $ ]) - 1]. priorSpaces timesRepeat: [ s := selection selectAt: (textHolder replace: selection withChar: $ )]. ]. ^s! search "Search for the selected string or prompted string if the selection is a gap selection. Answer the selection containing the string." (self searchInitAuto: false) isNil ifTrue: [^ self].! searchBackAndForwards: isForward "Search in either direction for the search string. Answer the selection containing the string." isForward ifTrue: [(textHolder searchFrom: selection for: (Pattern new: SearchString)) isNil ifTrue: [Terminal bell]. ] ifFalse: [(textHolder searchBack: selection for: (Pattern new: SearchString)) isNil ifTrue: [Terminal bell]. ]. self forceSelectionOntoDisplay. ^ selection! searchBackOld "Search backwards for the selected string or prompted string if the selection is a gap selection. Answer the selection containing the string." ^ self searchBackAndForwards: (CurrentEvent isShift)! searchInitAuto: isAuto "Prompt for and initialize the string to be searched for." | answer aString forward | selection isGap ifFalse: [ SearchString := self selectedString ]. isAuto ifTrue: [ forward := CurrentEvent isShift not. ] ifFalse: [ answer := (Dialog findDialog: SearchString). (answer at: 1) ifFalse: [ ^ nil ]. aString := answer at: 2. forward := (answer at: 3). aString isNil ifTrue: [ ^ nil ] ifFalse: [ SearchString := aString]. ]. forward ifTrue: [ self dispatcher class searching ] ifFalse: [ self dispatcher class searchingBack ]. self searchBackAndForwards: forward.! searchOld "Search for the selected string or prompted string if the selection is a gap selection. Answer the selection containing the string." ^ self searchBackAndForwards: (CurrentEvent isShift not)! searchSelection "Search for the selected string. Answer the selection containing the string." (self searchInitAuto: true) isNil ifTrue: [^ self].! selectAtCursor "Place the gap selection at the cursor position." | old new | (frame containsPoint: Cursor offset) ifTrue: [ old := selection origin. new := self stringCoordinate: Cursor offset - frame origin. ((old y = new y) and: [Terminal underTripleClickDelay]) ifTrue: [ ^self selectLineAtCurrentSelection ]. (old = new and: [ selection isGap and: [ Terminal underDoubleClickDelay ]]) ifTrue: [ selection origin x = topCorner x ifTrue: [ ^self selectLineAtCurrentSelection ] ifFalse: [ ^self selectWordAtCurrentSelection ] ]. ^ selection selectBefore: new; displayGap ]! unGraySelection "comment" #(searchSelection adjustLeft adjustRight jumpToTop jumpToBottom) do: [ :m | EditMenu enable: m]. ^super unGraySelection! ! !TerminalStream methods ! leftButton: value "Private - Decode left button down event based on state of shift key." state := #beginSelect. value = 16r1 "left button down" ifTrue: [ mouseOffset := Cursor globalOffset. (lastTime isKindOf: Collection) ifTrue: [lastTime at: 2 put: (lastTime at: 1). lastTime at: 1 put: mouseTime. ] ifFalse: [lastTime := Array with: mouseTime with: 0]. "lastTime := mouseTime." mouseTime := CurrentEvent when. ^ SelectFunction]. "shift key must be down" ^ SelectToFunction! ! !TerminalStream methods ! underDoubleClickDelay "Answer true if the last two clicks (left button down) occurred less than the double click time apart." | lt | (lastTime isKindOf: Collection) ifTrue: [lt := lastTime at: 1] ifFalse: [lt := lastTime]. ^ mouseTime - lt between: 0 and: (Memory longAtOffset: DoubleTime)! ! !TerminalStream methods ! underTripleClickDelay "Answer true if the last three clicks (left button down) occurred less than the double click time apart." | lt | (lastTime isKindOf: Collection) ifTrue: [lt := lastTime at: 2] ifFalse: [lt := lastTime]. ^ mouseTime - lt between: 0 and: (Memory longAtOffset: DoubleTime)! ! !ClassBrowser methods ! openOn: aClass "Create a class browser window on aClass. Define the type, behavior and relative size of each pane and schedule the window." | aTopPane twoLineHeight pane | (aClass isKindOf: Class) ifFalse: [^ nil]. browsedClass := aClass. aTopPane := TopPane new label: aClass name, ' | Class Browser'; minimumSize: 300 @ 150; yourself. twoLineHeight := Font menuFont height * 2 + 16. aTopPane addSubpane: (VerticalButtonPane new model: self; change: #classOrInstance:; buttons: #(Instance Class); framingBlock: [:box| box origin extent: box width // 4 @ twoLineHeight]; push: 1). selectedDictionary := browsedClass. aTopPane addSubpane: (pane := (ListPane new model: self; name: #selectors; change: #selector:; menu: #selectorMenu; framingBlock: [:box| box origin + (0 @ twoLineHeight) extent: box width // 4 @ (box height - twoLineHeight)])). aTopPane addSubpane: (pane := (ProgrammingPane "--TextPane--" new model: self; name: #text; change: #accept:from:; framingBlock: [:box| box origin + ((box width // 4) @ 0) corner: box corner])). aTopPane dispatcher open scheduleWindow! ! !ClassHierarchyBrowser methods ! openOn: aCollection "Create a class hierarchy browser window giving access to the classes in aCollection and their subclasses. Define the type, behavior and relative size of each pane and schedule the window." | aTopPane listLineHeight ratio aPane | CursorManager execute change. hiddenClasses := Set new: 64. (aCollection includes: Object) ifTrue: [ aCollection do: [ :class | class subclasses do: [:each | each subclasses isEmpty ifFalse: [ hiddenClasses add: each]]]] ifFalse: [ aCollection do: [ :class | class subclasses isEmpty ifFalse: [ hiddenClasses add: class]]]. ratio := 2 / 5. self update: aCollection. listLineHeight := Font menuFont height + 12. instanceSelectedLast := true. methodSelectedLast := false. aTopPane := TopPane new model: self; label: self expandedLabel; minimumSize: 300 @ 200; yourself. pane := aTopPane. aTopPane addSubpane: (aPane := (ListPane new model: self; name: #hierarchy; change: #hierarchy:; menu: #menu; framingRatio: (0 @ 0 extent: 1/2 @ ratio))). aTopPane addSubpane: (aPane := (ListPane new model: self; name: #selectors; change: #selector:; menu: #selectorMenu; framingBlock: [:box| box origin + (box width // 2 @ 0) extent: (box width + 1 // 2) @ ((box height * ratio) truncated - listLineHeight)])). aTopPane addSubpane: (ButtonPane new model: self; change: #classOrInstance:; buttons: #(Instance Class); framingBlock: [ :box | box origin + (box width // 2 @ ((box height * ratio) truncated - listLineHeight)) extent: box width + 1 // 2 @ listLineHeight ]; push: 1). aTopPane addSubpane: (aPane := (ProgrammingPane "--TextPane--" new model: self; name: #text; change: #accept:from:; framingRatio: (0 @ (2/5) corner: 1 @ 1))). aTopPane dispatcher open. self classHighlight: false. (pane menuBar menuAt: 'Methods') disable. aTopPane dispatcher scheduleWindow! ! !FileStream methods ! edit "Open a workspace window with yourself as the contents." | text | self size // 1024 > 100 ifTrue: [ (Dialog yesOrNo: 'File "', self file name, '" size > 100K. Read it?') ifFalse: [ file close. ^ self ]. ]. text := ProgrammingEditor windowLabeled: self pathName frame: TopDispatcher nextFrame. text topDispatcher pane saveFile: self. CursorManager read change. text pane fileInFrom: self. CursorManager normal change. self close.! ! !String methods ! edit "Open a workspace window with the receiver string as the contents." | aTopPane | aTopPane := TopPane new. aTopPane label: 'Workspace'; model: aTopPane dispatcher; menu: #workSpaceMenu; minimumSize: 150@80; rightIcons: #(resize collapse zoom); addSubpane: (ProgrammingPane "--TextPane--" new model: self; framingBlock: [ :box | box]). aTopPane saveFile: ''. aTopPane dispatcher open scheduleWindow! ! !StringModel methods ! fileInFrom: aStream "Read the contents of aStream into yourself." | amountToRead amountRead window line newAmount where | lines := OrderedCollection new. amountRead := 0. amountToRead := aStream size - aStream position // 1024. amountToRead > 15 ifTrue: [ GrafPort push. where := Scheduler activeWindow. where := where isNil ifTrue: [ Screen extent // 3 - (150 @ 50) ] ifFalse: [ where screenRect origin + 10 ]. window := Window dialogBox: (where extent: 200 @ 24). 'Amount left to read:' displayAt: 2 @ 2 font: Font menuFont. amountToRead printString, ' K ' displayAt: 150 @ 2 font: Font menuFont. [aStream atEnd] whileFalse: [ line := aStream nextLine. lines add: line. newAmount := amountRead + line size. amountRead // 10240 < (newAmount // 10240) ifTrue: [ (amountToRead - (newAmount // 1024)) printString, ' K ' displayAt: 150 @ 2 font: Font menuFont. ]. amountRead := newAmount ]. window release. GrafPort pop. extent := self extent. ^ self ]. [aStream atEnd] whileFalse: [lines add: aStream nextLine]. extent := self extent! ! !Debugger methods ! Debug "Private - Close the walkback window and open a debugger window on the process." | aTopPane listLineHeight ratio | Scheduler topDispatcher closeWindow. Scheduler displayAll. listLineHeight := Font menuFont height + 8. ratio := 2/5. label := '{', process name, '} ', label. positions := IdentityDictionary new. aTopPane := TopPane new label: label; model: self; yourself. browseWalkback := true. breakpoints := SortedCollection sortBlock: [ :a :b | a classField name < b classField name or: [ a classField name = b classField name and: [ a selector < b selector]]]. breakpointArray := Array new. aTopPane addSubpane: (ListPane new model: self; name: #walkback; change: #walkback:; returnIndex: true; menu: #menu; selection: 1; framingBlock: [ :box | box origin + (0 @ listLineHeight) corner: box width * 7 // 15 @ (box height * ratio) truncated]). aTopPane addSubpane: (buttons := ButtonPane new model: self; buttons: #(Walkback Breakpoints); framingBlock: [:box| box origin extent: box width * 7 // 15 @ listLineHeight ]; push: 1). aTopPane addSubpane: (ButtonPane new model: self; buttons: #(Hop Skip Jump); framingBlock: [:box| box width * 7 // 15 @ 0 corner: box width @ listLineHeight ]; pulse: true). aTopPane addSubpane: (ListPane new menu: #inspectMenu; model: self; name: #tempList; change: #selectInstance:; returnIndex: true; framingBlock: [ :box | box origin + (box width * 7 // 15 @ listLineHeight) corner: box origin + (box width * 2 // 3 @ (box height * ratio) truncated)]). aTopPane addSubpane: (methodPane := ProgrammingPane "--TextPane--" new model: self; name: #method; change: #take:from:; framingRatio: (0@(ratio) extent: 1@(1 - ratio))). aTopPane addSubpane: (instPane := TextPane new model: self; name: #instance; change: #accept:from:; framingBlock: [ :box | box origin + (box width * 2 // 3 @ listLineHeight) corner: box origin + (box width @ (box height * ratio) truncated)]). aTopPane dispatcher open; activate; display. self walkback: 1. Scheduler add: aTopPane dispatcher. aTopPane dispatcher searchForActivePane. Scheduler searchForActiveDispatcher; run! ! !DispatchManager class methods ! makeTranscript "Initialize the transcript in some reasonable way." | topPane rect | rect := ScreenPort screenRect. topPane := ProgrammingEditor initializeTranscript. Transcript := ProgrammingEditor systemTranscript. topPane closeable: false. topPane dispatcher openIn: (5 @ 43 corner: rect corner // (2 @ 3)). topPane dispatcher scheduleWindow. "Does not return."! ! !DisplayScreen class methods ! initSystem "Initialize the window sustem and the Smalltalk environment." "Set up the standard fonts." TextFont := ListFont := SysFont := MacFont fontName: 'Monaco' pointSize: 12. LabelFont := Font menuFont. Menu initialize. MenuBar initialize. Terminal initialize. TextEditor initialize. ProgrammingEditor initialize. "new line added" TopDispatcher initialize; initFrame. GrafPort initialize. Time initialize. "Set turtle to be a pen." (Turtle := Pen new) frame: (320 @ 0 corner: Display boundingBox corner); defaultNib: 4@3. "Close any windows which are open and restart." Scheduler setUpMenuBar; initialize! ! ProgrammingPane initialize!