'From Squeak3.1alpha of 28 February 2001 [latest update: #4344] on 22 September 2001 at 4:54:17 pm'! "Change Set: TextPrintIt-ar Date: 22 September 2001 Author: Andreas Raab Adds a TextPrintIt action so that we can embed an expression like 3 + 4 in text and when clicking on it, print the result."! TextDoIt subclass: #TextPrintIt instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Collections-Text'! !NewParagraph methodsFor: 'editing' stamp: 'ar 9/22/2001 16:22'! clickAt: clickPoint for: model controller: editor "Give sensitive text a chance to fire. Display flash: (100@100 extent: 100@100)." | startBlock action target range boxes box | action _ false. startBlock _ self characterBlockAtPoint: clickPoint. (text attributesAt: startBlock stringIndex forStyle: textStyle) do: [:att | att mayActOnClick ifTrue: [ (target _ model) ifNil: [target _ editor morph]. range _ text rangeOf: att startingAt: startBlock stringIndex forStyle: textStyle. boxes _ self selectionRectsFrom: (self characterBlockForIndex: range first) to: (self characterBlockForIndex: range last+1). box _ boxes detect: [:each | each containsPoint: clickPoint]. Utilities awaitMouseUpIn: ((editor transformFrom: nil) invertBoundsRect: box) repeating: [] ifSucceed: [(att actOnClickFor: target in: self at: clickPoint editor: editor) ifTrue: [action _ true]]. ]]. ^ action! ! !Paragraph methodsFor: 'selecting' stamp: 'ar 9/22/2001 16:22'! clickAt: clickPoint for: model controller: aController "Give sensitive text a chance to fire. Display flash: (100@100 extent: 100@100)." | startBlock action range box boxes | action _ false. startBlock _ self characterBlockAtPoint: clickPoint. (text attributesAt: startBlock stringIndex forStyle: textStyle) do: [:att | att mayActOnClick ifTrue: [range _ text rangeOf: att startingAt: startBlock stringIndex forStyle: textStyle. boxes _ self selectionRectsFrom: (self characterBlockForIndex: range first) to: (self characterBlockForIndex: range last+1). box _ boxes detect: [:each | each containsPoint: clickPoint] ifNone: [^ action]. Utilities awaitMouseUpIn: box repeating: [] ifSucceed: [aController terminateAndInitializeAround: [(att actOnClickFor: model in: self at: clickPoint editor: aController) ifTrue: [action _ true]]]]]. ^ action! ! !ParagraphEditor methodsFor: 'editing keys' stamp: 'ar 9/22/2001 15:58'! changeEmphasis: characterStream "Change the emphasis of the current selection or prepare to accept characters with the change in emphasis. Emphasis change amounts to a font change. Keeps typeahead." | keyCode attribute oldAttributes index thisSel colors extras | "control 0..9 -> 0..9" keyCode _ ('0123456789-=' indexOf: sensor keyboard ifAbsent: [1]) - 1. oldAttributes _ paragraph text attributesAt: startBlock stringIndex forStyle: paragraph textStyle. thisSel _ self selection. "Decipher keyCodes for Command 0-9..." (keyCode between: 1 and: 5) ifTrue: [attribute _ TextFontChange fontNumber: keyCode]. keyCode = 6 ifTrue: [colors _ #(black magenta red yellow green blue cyan white). extras _ ((self class name = #TextMorphEditor) and: [(self morph isKindOf: TextMorphForEditView) not]) "not a system window" ifTrue: [#()] ifFalse: [#('Link to comment of class' 'Link to definition of class' 'Link to hierarchy of class' 'Link to method')]. index _ (PopUpMenu labelArray: colors , #('choose color...' 'Do it' 'Print it'), extras, #('be a web URL link' 'Edit hidden info' 'Copy hidden info') lines: (Array with: colors size +1)) startUp. index = 0 ifTrue: [^ true]. index <= colors size ifTrue: [attribute _ TextColor color: (Color perform: (colors at: index))] ifFalse: [index _ index - colors size - 1. "Re-number!!!!!!" index = 0 ifTrue: [attribute _ self chooseColor]. index = 1 ifTrue: [attribute _ TextDoIt new. thisSel _ attribute analyze: self selection asString]. index = 2 ifTrue: [attribute _ TextPrintIt new. thisSel _ attribute analyze: self selection asString]. (extras size = 0) & (index > 2) ifTrue: [index _ index + 5]. "skip those" index = 3 ifTrue: [attribute _ TextLink new. thisSel _ attribute analyze: self selection asString with: 'Comment']. index = 4 ifTrue: [attribute _ TextLink new. thisSel _ attribute analyze: self selection asString with: 'Definition']. index = 5 ifTrue: [attribute _ TextLink new. thisSel _ attribute analyze: self selection asString with: 'Hierarchy']. index = 6 ifTrue: [attribute _ TextLink new. thisSel _ attribute analyze: self selection asString]. index = 7 ifTrue: [attribute _ TextURL new. thisSel _ attribute analyze: self selection asString]. index = 8 ifTrue: ["Edit hidden info" thisSel _ self hiddenInfo. "includes selection" attribute _ TextEmphasis normal]. index = 9 ifTrue: ["Copy hidden info" self copyHiddenInfo. ^ true]. "no other action" thisSel ifNil: [^ true]]. "Could not figure out what to link to" ]. (keyCode between: 7 and: 11) ifTrue: [sensor leftShiftDown ifTrue: [keyCode = 10 ifTrue: [attribute _ TextKern kern: -1]. keyCode = 11 ifTrue: [attribute _ TextKern kern: 1]] ifFalse: [attribute _ TextEmphasis perform: (#(bold italic narrow underlined struckOut) at: keyCode - 6). oldAttributes do: [:att | (att dominates: attribute) ifTrue: [attribute turnOff]]]]. (keyCode = 0) ifTrue: [attribute _ TextEmphasis normal]. beginTypeInBlock ~~ nil ifTrue: "only change emphasisHere while typing" [self insertTypeAhead: characterStream. emphasisHere _ Text addAttribute: attribute toArray: oldAttributes. ^ true]. self replaceSelectionWith: (thisSel asText addAttribute: attribute). ^ true! ! !RunArray class methodsFor: 'instance creation' stamp: 'ar 9/22/2001 16:27'! scanFrom: strm "Read the style section of a fileOut or sources file. nextChunk has already been done. We need to return a RunArray of TextAttributes of various kinds." | rr vv aa this | (strm peekFor: $( ) ifFalse: [^ nil]. rr _ OrderedCollection new. [strm skipSeparators. strm peekFor: $)] whileFalse: [rr add: (Number readFrom: strm)]. vv _ OrderedCollection new. "Value array" aa _ OrderedCollection new. "Attributes list" [(this _ strm next) == nil] whileFalse: [ this == $, ifTrue: [vv add: aa asArray. aa _ OrderedCollection new]. this == $f ifTrue: [aa add: (TextFontChange new fontNumber: (Number readFrom: strm))]. this == $b ifTrue: [aa add: (TextEmphasis bold)]. this == $i ifTrue: [aa add: (TextEmphasis italic)]. this == $u ifTrue: [aa add: (TextEmphasis underlined)]. this == $= ifTrue: [aa add: (TextEmphasis struckOut)]. this == $n ifTrue: [aa add: (TextEmphasis normal)]. this == $- ifTrue: [aa add: (TextKern kern: -1)]. this == $+ ifTrue: [aa add: (TextKern kern: 1)]. this == $c ifTrue: [aa add: (TextColor scanFrom: strm)]. "color" this == $L ifTrue: [aa add: (TextLink scanFrom: strm)]. "L not look like 1" this == $R ifTrue: [aa add: (TextURL scanFrom: strm)]. "R capitalized so it can follow a number" this == $q ifTrue: [aa add: (TextSqkPageLink scanFrom: strm)]. this == $p ifTrue: [aa add: (TextSqkProjectLink scanFrom: strm)]. this == $P ifTrue: [aa add: (TextPrintIt scanFrom: strm)]. this == $d ifTrue: [aa add: (TextDoIt scanFrom: strm)]. "space, cr do nothing" ]. aa size > 0 ifTrue: [vv add: aa asArray]. ^ self runs: rr asArray values: vv asArray " RunArray scanFrom: (ReadStream on: '(14 50 312)f1,f1b,f1LInteger +;i') "! ! !TextAttribute methodsFor: 'as yet unclassified' stamp: 'ar 9/22/2001 16:00'! actOnClickFor: model in: aParagraph ^self actOnClickFor: model! ! !TextAttribute methodsFor: 'as yet unclassified' stamp: 'ar 9/22/2001 16:08'! actOnClickFor: model in: aParagraph at: clickPoint ^self actOnClickFor: model in: aParagraph! ! !TextAttribute methodsFor: 'as yet unclassified' stamp: 'ar 9/22/2001 16:22'! actOnClickFor: model in: aParagraph at: clickPoint editor: editor ^self actOnClickFor: model in: aParagraph at: clickPoint! ! !TextMorph methodsFor: 'editing' stamp: 'ar 9/22/2001 16:50'! handleInteraction: interactionBlock fromEvent: evt "Perform the changes in interactionBlock, noting any change in selection and possibly a change in the size of the paragraph (ar 9/22/2001 - added for TextPrintIts)" "Also couple ParagraphEditor to Morphic keyboard events" | oldEditor oldParagraph oldSize | self editor sensor: (KeyboardBuffer new startingEvent: evt). oldEditor _ editor. oldParagraph _ paragraph. oldSize _ oldParagraph text size. self selectionChanged. "Note old selection" interactionBlock value. (oldParagraph == paragraph) ifTrue:[ "this will not work if the paragraph changed" editor _ oldEditor. "since it may have been changed while in block" ]. self selectionChanged. "Note new selection" (oldSize = paragraph text size) ifFalse:[self updateFromParagraph]. ! ! !TextMorphEditor methodsFor: 'accessing' stamp: 'ar 9/22/2001 16:16'! transformFrom: owner ^morph transformFrom: owner! ! !TextPrintIt methodsFor: 'as yet unclassified' stamp: 'ar 9/22/2001 16:29'! actOnClickFor: anObject in: aParagraph at: clickPoint editor: editor "Note: evalString gets evaluated IN THE CONTEXT OF anObject -- meaning that self and all instVars are accessible" | result range index | result _ Compiler evaluate: evalString for: anObject logged: false. result _ ' ', result printString,' '. "figure out where the attribute ends in aParagraph" index _ (aParagraph characterBlockAtPoint: clickPoint) stringIndex. range _ aParagraph text rangeOf: self startingAt: index forStyle: TextStyle default. editor selectFrom: range last+1 to: range last. editor zapSelectionWith: result. editor selectFrom: range last to: range last + result size. ^ true ! ! !TextPrintIt methodsFor: 'as yet unclassified' stamp: 'ar 9/22/2001 16:28'! writeScanOn: strm strm nextPut: $P; nextPutAll: evalString; nextPutAll: ';;'! !