From VisualWorks®, 7.2 of October 20, 2003 on October 20, 2003 at 1:27:11 pm (Dialog confirm: 'You are filing-in a Parcel source file!\\While this is possible it will not have\the same effect as loading the parcel.\None of the Parcel''s prerequisites will\be loaded and none of its load actions\will be performed.\\Are you sure you want to file-in?' withCRs) ifFalse: [self error: 'Parcel file-in abandoned. Choose terminate or close.'] <class> <name>ArborHyperlink</name> <environment>VWHelp</environment> <super>Core.Object</super> <private>false</private> none linkObject color emphasis <imports></imports> <category>Help-Arbor Hypertext</category> <attributes> <package>Arbor Hypertext</package> </attributes> </class> <comment> VWHelp.ArborHyperlink
This class has not yet been commented. The comment should state the purpose of the class, what messages are subclassResponsibility, and the type and purpose of each instance and class variable. The comment should also explain any unobvious aspects of the implementation. Instance Variables: linkObject <ClassOfVariable> description of variable's function
</comment> <class> <name>ArborReversibleColorValue</name> <environment>VWHelp</environment> <super>Graphics.ColorValue</super> <private>false</private> none <imports></imports> <category>Help-Arbor Widget Extensions</category> <attributes> <package>Arbor Hypertext</package> </attributes> </class> <comment> VWHelp.ArborReversibleColorValue
Copyright 1998 AppNet Systems, Inc. ArborReversibleColorValue Instances of this class have an added property in that they are able to reverse its color when installing themselves on a GraphicsContext. During the #installOn: process, the graphics context is checked to see if the last paint applied appeared to be SymbolicPaint selectionForeground. If so, and the selectionForeground color is different from the foreground color, then an inverse of the defined color is placed on the graphics context rather than the actual color defined by its instance variables. Why is this useful? Glad you asked... When a Text object is displayed on the graphics context (via a subclass of ComposedTextView), the only object that is aware of whether the text is selected or not is the view itself. If the default system color is used for the #foreground color, the system is able to adjust the color correctly to display an appropriate #selectionForeground when it is highlighted. However, if the Text has a color applied to it as part of its emphasis, the system displays that specified color regardless of whether or not the text is selected (through a rather complex sequence of events, but it generally boils down to a SyntheticFont being created with the desired color, and this is what displays the text - obviously the knowledge of whether or not the text is selected is lost at this level). However, the graphics context still 'knows' because it's devicePaint is still set to what the ComposedTextView set it to - "SymbolicPaint selectionForeground". So if an instance of ArborReversibleColorValue is used to colorize text, when it is highlighted in a text editor it will display a reversed color instead, usually providing a good bit more contrast and thereby allowing the user to read the text even when highlighted. Got it?
</comment> <class> <name>ArborHypertextSelectionTracker</name> <environment>VWHelp</environment> <super>UI.TextSelectionTracker</super> <private>false</private> none <imports></imports> <category>Help-Arbor Hypertext</category> <attributes> <package>Arbor Hypertext</package> </attributes> </class> <comment> VWHelp.ArborHypertextSelectionTracker
This class has not yet been commented. The comment should state the purpose of the class, what messages are subclassResponsibility, and the type and purpose of each instance and class variable. The comment should also explain any unobvious aspects of the implementation. Instance Variables:
</comment> <class> <name>ArborHypertextEditorController</name> <environment>VWHelp</environment> <super>UI.TextEditorController</super> <private>false</private> none <imports></imports> <category>Help-Arbor Hypertext</category> <attributes> <package>Arbor Hypertext</package> </attributes> </class> <comment> VWHelp.ArborHypertextEditorController
This class has not yet been commented. The comment should state the purpose of the class, what messages are subclassResponsibility, and the type and purpose of each instance and class variable. The comment should also explain any unobvious aspects of the implementation. Instance Variables: Class Variables: FingerCursor <ClassOfVariable> description of variable''s function
</comment> <class> <name>ArborHypertextController</name> <environment>VWHelp</environment> <super>VWHelp.ArborHypertextEditorController</super> <private>false</private> none <imports></imports> <category>Help-Arbor Hypertext</category> <attributes> <package>Arbor Hypertext</package> </attributes> </class> <comment> VWHelp.ArborHypertextController
ArborHypertextController Intended to be used with TextView instances (NOT TextEditorView instances!)
</comment> <class> <name>ArborHyperlinkAssociation</name> <environment>VWHelp</environment> <super>Core.Association</super> <private>false</private> none <imports></imports> <category>Help-Arbor Hypertext</category> <attributes> <package>Arbor Hypertext</package> </attributes> </class> <comment> VWHelp.ArborHyperlinkAssociation
ArborHyperlinkAssociation An extension to Association providing necessary tweaks to normal Association behavior when used as part of a Text's emphasis. In particular, #supersedesAsTextEmphasis now checks both the key and value before answering true, ensuring that different hyperlinks are not considered equivalent.
</comment> <class> <name>ArborHypertext</name> <environment>VWHelp</environment> <super>Core.Text</super> <private>false</private> none <imports></imports> <category>Help-Arbor Hypertext</category> <attributes> <package>Arbor Hypertext</package> </attributes> </class> <comment> VWHelp.ArborHypertext
This class has not yet been commented. The comment should state the purpose of the class, what messages are subclassResponsibility, and the type and purpose of each instance and class variable. The comment should also explain any unobvious aspects of the implementation. Instance Variables:
</comment> <name>FingerCursor</name> <environment>VWHelp.ArborHypertextEditorController</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>Arbor Hypertext</package> </attributes> <methods> VWHelp.ArborHyperlink <category>comparing</category>
= anotherHyperLinkObject "Base equality solely on the linkObject. This is most useful when looking to remove links from a hypertext - when told to remove links of a given linkObject, all will be removed." ^self species == anotherHyperLinkObject species and: [self linkObject = anotherHyperLinkObject linkObject]
hash ^self linkObject hash
</methods> <methods> VWHelp.ArborHyperlink <category>resources</category>
textEmphasis ^self class textEmphasis
</methods> <methods> VWHelp.ArborHyperlink <category>converting</category>
asEmphasis ^ArborHyperlinkAssociation value: self
</methods> <methods> VWHelp.ArborHyperlink <category>accessing</category>
linkObject ^linkObject
linkObject: anObject linkObject := anObject
</methods> <methods> VWHelp.ArborHyperlink <category>engaging</category>
engageFor: anObject "The hyperlink has been engaged within the context of anObject." ^self subclassResponsibility
</methods> <methods> VWHelp.ArborHyperlink <category>copying</category>
postCopy super postCopy. linkObject := linkObject copy
</methods> <methods> VWHelp.ArborHyperlink <category>testing</category>
supersedesAsTextEmphasis: aLinkObject "Tests for superceding should only concern themselves with the link object. This method is only here in case a decision is made at some point to override #= in a subclass, which otherwise could cause bad behavior when editing hyperText." ^self species = aLinkObject species and: [self linkObject = aLinkObject linkObject]
</methods> <methods> VWHelp.ArborHyperlink class <category>color & emphasis</category>
color ^color = #none ifTrue: [nil] ifFalse: [ (color isNil or: [color = #default]) ifTrue: [self defaultColor] ifFalse: [color]]
color: aValue "Set the hyperlink color (may be a ColorValue, nil, #none, or #default)." color := aValue.
defaultColor "Answer the default color for the hyperlink. A nil value indicates no special coloring." ^nil
defaultEmphasis "Answer the default non-color emphasis for the hyperlink. May be a single emphasis, a collection, or nil." ^nil
emphasis ^emphasis = #none ifTrue: [nil] ifFalse: [ (emphasis isNil or: [emphasis = #default]) ifTrue: [self defaultEmphasis] ifFalse: [emphasis]]
emphasis: aValue "Set the hyperlink emphasis (may be a single emphasis, a collection, nil, #none, or #default)." emphasis := aValue.
textEmphasis "Answer the emphasis to use when displaying this hyperlink, built from the #color and #emphasis attributes." | result emph | result := Array new writeStream. ((emph := self emphasis) isSequenceable and: [emph isSymbol not]) ifTrue: [result nextPutAll: emph] ifFalse: [emph notNil ifTrue: [result nextPut: emph]]. self color notNil ifTrue: [result nextPut: #color->self color]. emph := result contents. ^emph isEmpty ifTrue: [nil] ifFalse: [ emph size = 1 ifTrue: [emph first] ifFalse: [emph]]
</methods> <methods> VWHelp.ArborHyperlink class <category>defaulting</category>
defaultColorValueClass "Use Arbor's reversible color value if possible (which reverses its color when highlighted), otherwise use ColorValue." ^#{ArborReversibleColorValue} valueOrDo: [ColorValue]
</methods> <methods> VWHelp.ArborHyperlink class <category>instance creation</category>
newLink: anObject "creates an instance of a hyper link" ^self new linkObject: anObject
</methods> <methods> VWHelp.ArborReversibleColorValue <category>private</category>
reversedFor: aColorValue "Given aColorValue, answer a ColorValue that should have a high degree of contrast." "This simple implementation ignores aColorValue and simply inverts everything, then brightens the resulting color up if too dim. Subclasses may override this method to make it sensitive to aColorValue." | color | color := ColorValue scaledRed: MaxValue - red scaledGreen: MaxValue - green scaledBlue: MaxValue - blue. ^(color brightness < 0.8) ifTrue: [ColorValue hue: color hue saturation: color saturation brightness: 0.8] ifFalse: [color]
</methods> <methods> VWHelp.ArborReversibleColorValue <category>installing</category>
installOn: aGraphicsContext "Install a device paint representing the receiver on aGraphicsContext." | fore selectionFore | fore := aGraphicsContext paintPreferencesMatchAt: SymbolicPaint foreground. selectionFore := aGraphicsContext paintPreferencesMatchAt: SymbolicPaint selectionForeground. (fore ~= selectionFore and: [(selectionFore asDevicePaintOn: aGraphicsContext medium) = aGraphicsContext aisDevicePaint]) ifTrue: [ "The ideal thing here would be to get the color of #selectionBackground from the graphics device's palette and use that as the basis for a color inversion. Unfortunately, those values are generally DevicePaints which are not easily mapped back into ColorValues. So we must request a simple color inversion rather than an inversion based on a known selection color. In general, the selection background color will be dark, so any reasonably light color should be acceptable." aGraphicsContext setPaintToColor: (self reversedFor: ColorValue veryDarkGray)] ifFalse: [super installOn: aGraphicsContext]
</methods> <methods> VWHelp.ArborReversibleColorValue class <category>constants</category>
black ^self newFrom: super black
blue ^self newFrom: super blue
brown ^self newFrom: super brown
chartreuse ^self newFrom: super chartreuse
cyan ^self newFrom: super cyan
darkCyan ^self newFrom: super darkCyan
darkGray ^self newFrom: super darkGray
darkGreen ^self newFrom: super darkGreen
darkMagenta ^self newFrom: super darkMagenta
darkRed ^self newFrom: super darkRed
gray ^self newFrom: super gray
green ^self newFrom: super green
lightCyan ^self newFrom: super lightCyan
lightGray ^self newFrom: super lightGray
lightYellow ^self newFrom: super lightYellow
magenta ^self newFrom: super magenta
navy ^self newFrom: super navy
olive ^self newFrom: super olive
orange ^self newFrom: super orange
orchid ^self newFrom: super orchid
paleGreen ^self newFrom: super paleGreen
pink ^self newFrom: super pink
purple ^self newFrom: super purple
red ^self newFrom: super red
royalBlue ^self newFrom: super royalBlue
salmon ^self newFrom: super salmon
springGreen ^self newFrom: super springGreen
veryDarkGray ^self newFrom: super veryDarkGray
veryLightGray ^self newFrom: super veryLightGray
white ^self newFrom: super white
yellow ^self newFrom: super yellow
</methods> <methods> VWHelp.ArborReversibleColorValue class <category>instance creation</category>
newFrom: aColorValue "Answer a new instance of myself that is based on aColorValue." ^aColorValue copy changeClassToThatOf: self basicNew
</methods> <methods> VWHelp.ArborHypertextSelectionTracker <category>events</category>
redButtonReleasedEvent: aMouseButtonEvent "Our controller wants to know when the red button is released because it uses that to do hyperlinking." | ctrlr | ctrlr := self controller. super redButtonReleasedEvent: aMouseButtonEvent. ctrlr redButtonReleasedEvent: aMouseButtonEvent.
</methods> <methods> VWHelp.ArborHypertextEditorController <category>private-hypermedia</category>
availableLink: aMouseEvent "Answer the hyperlink at the location identified by aMouseEvent, or nil if there isn't a hyperlink there." ^(self cursorInViewFrom: aMouseEvent) ifTrue: [| aHyperText | aHyperText := self trackTextPosition: (self cursorPointInViewFrom: aMouseEvent). aHyperText notNil ifTrue: [aHyperText firstAvailableLink]]
checkHyperlinks: aMouseEvent "Tweak cursor if necessary, and if the red <select> button is pressed then engage hyperlink if necessary. Answer true if a hyperlink was engaged." | link | (link := self availableLink: aMouseEvent) notNil ifTrue: [^self engageIfPossible: link withEvent: aMouseEvent]. Cursor normal show. ^false
engageIfPossible: aLink withEvent: aMouseEventOrNil "Try to engage the hyperlink. If successfully engaged, answer true." self canEngageHypermedia ifTrue: [ self class hyperFinger show. (self shouldEngageHypermedia: aMouseEventOrNil) ifTrue: ["jump to the hyperlink" Cursor normal show. Object errorSignal handle: [:ex | "There is a handler for any exception raised during the control sequence in VisualPart>>objectWantingControl which will result in closing the active window (via the handler in ControlManager>>activeControllerLoop). Since typos and whatnot fall into that category, this can make for frustrating debugging. To work around this problem, any exception raised during a hyperlink action is trapped and re-raised as an information signal, which circumvents the standard handler and will result in a walkback opening." Object informationSignal raiseErrorString: ex errorString] do: [aLink engageFor: self performer]. ^true]] ifFalse: [Cursor normal show]. ^false
</methods> <methods> VWHelp.ArborHypertextEditorController <category>events</category>
mouseMovedEvent: event self checkHyperlinks: event. ^super mouseMovedEvent: event
redButtonPressedEvent: event "Only allow red button presses through if we're not read only." ^self readOnly ifTrue: [nil] ifFalse: [super redButtonPressedEvent: event]
redButtonReleasedEvent: event ((self checkHyperlinks: event) not and: [self readOnly not]) ifTrue: [^super redButtonReleasedEvent: event]. ^nil
</methods> <methods> VWHelp.ArborHypertextEditorController <category>event driven</category>
handlerForMouseEvent: aMouseEvent "We want redButtonPressed and mouseMoved events in order to change the cursor and engage hyperlinks" ^((aMouseEvent isButtonReleasedEvent and: [aMouseEvent redButtonReleased]) or: [aMouseEvent isKindOf: MouseMovedEvent]) ifTrue: [(self viewHasCursorWithEvent: aMouseEvent) ifTrue: [self getEventHandler] ifFalse: [nil]] ifFalse: [super handlerForMouseEvent: aMouseEvent]
selectionTracker ^ArborHypertextSelectionTracker on: self
</methods> <methods> VWHelp.ArborHypertextEditorController <category>testing</category>
canEngageHypermedia "Answer true if things are in a state where a hyperlink may be invoked." ^self readOnly or: [self sensor ctrlDown]
shouldEngageHypermedia: aMouseEventOrNil "Answer true if it appears that conditions allow for engaging a hyperlink. nil is used for non-event driven environments. Use the button-up state in event-driven environments to better mimic existing hypertext browsers." ^aMouseEventOrNil isNil ifTrue: [self sensor redButtonPressed] ifFalse: [ aMouseEventOrNil isButtonReleasedEvent and: [aMouseEventOrNil redButtonReleased]]
</methods> <methods> VWHelp.ArborHypertextEditorController <category>private</category>
characterIsValid: aCharacter "Ignore non valid characters like cr, lf, space, nil." ^(aCharacter isNil or: [aCharacter = Character cr or: [aCharacter = Character lf]]) not
cursorInViewFrom: anEvent "Answer true if the mouse cursor is within the bounds of the view. Use anEvent if non-nil." ^anEvent isNil ifTrue: [self viewHasCursor] ifFalse: [self viewHasCursorWithEvent: anEvent]
cursorPointInViewFrom: anEvent "Answer the associated cursor/mouse point in local coordinates. Use anEvent if non-nil." ^anEvent isNil ifTrue: [self sensor cursorPoint] ifFalse: [self sensor mousePointFor: anEvent]
setEmphasisHere "We don't want the default emphasis to include any hyperlinks!" emphasisHere := self text asArborHypertext rawEmphasisAt: self selectionStartIndex
trackTextPosition: aPoint "checks if the pointer is over a text. If it is and the text is a hypertext then return the (hyper) character corresponding to the pointer location." | characterIndex aCharacterBlock aCharacter | aCharacterBlock := self view characterBlockAtPoint: aPoint. aCharacter := aCharacterBlock character. (self characterIsValid: aCharacter) ifFalse: [characterIndex := nil] ifTrue: [ characterIndex := aCharacterBlock stringIndex. "Account for the characterBlock calculation being based on the character center rather than the edge." aPoint x < aCharacterBlock left ifTrue: [characterIndex := characterIndex - 1]]. ^characterIndex isNil ifTrue: [nil] ifFalse: [(self view displayContents text copyFrom: characterIndex to: characterIndex) asArborHypertext]
</methods> <methods> VWHelp.ArborHypertextEditorController <category>basic control sequence</category>
controlTerminate "Restore the cursor, but only if non-event driven." super controlTerminate. self sensor window isEventDriven ifFalse: [Cursor normal show].
</methods> <methods> VWHelp.ArborHypertextEditorController <category>control defaults</category>
isControlWanted self checkHyperlinks: nil. self viewHasCursor ifFalse: [^false]. ^super isControlWanted
</methods> <methods> VWHelp.ArborHypertextEditorController class <category>class accessing</category>
hyperFinger FingerCursor isNil ifTrue: [self initializeCursors]. ^FingerCursor
</methods> <methods> VWHelp.ArborHypertextEditorController class <category>class initialization</category>
initializeCursors "self initializeCursors" FingerCursor := Cursor imageArray: #( 2r0001100000000000 2r0010010000000000 2r0010010000000000 2r0001001110110000 2r0001001001001110 2r0001001001001001 2r0110101001001001 2r1001100000000001 2r1000100000000010 2r0100000000000010 2r0010000000000010 2r0001000000000100 2r0001000000000100 2r0000100000001000 2r0000010000001000 2r0000010000001000) maskArray: #( 2r0001100000000000 2r0011110000000000 2r0011110000000000 2r0001111110110000 2r0001111111111110 2r0001111111111111 2r0111111111111111 2r1111111111111111 2r1111111111111110 2r0111111111111110 2r0011111111111110 2r0001111111111100 2r0001111111111100 2r0000111111111000 2r0000011111111000 2r0000011111111000) hotSpot: 4@1 name: 'hyper finger'
</methods> <methods> VWHelp.ArborHypertextController <category>private</category>
doAccept "Send the accept message to the model. Answer what the model answers." | acceptMsg | acceptMsg := view acceptMessage. acceptMsg == nil ifTrue: [view flash. ^ false]. ^ acceptMsg numArgs = 1 ifTrue: "one arg selectors get text only" [model perform: acceptMsg with: self text] ifFalse: "two arg selectors get text and controller as well" [model perform: acceptMsg with: self text with: self]
</methods> <methods> VWHelp.ArborHypertextController <category>menu messages</category>
accept (self textHasChanged and: [model changeRequestFrom: view]) ifFalse: [^view flash]. self doAccept ifTrue: [self textHasChanged: false] ifFalse: [view flash]
alwaysAccept "Try to do an accept even if the text is the same." (model changeRequestFrom: view) ifFalse: [^view flash]. self doAccept ifTrue: [self textHasChanged: false] ifFalse: [view flash]
alwaysAcceptKey: aCharEvent "The carriage return was typed by the user. This designates that the receiver should give up control. Try to do an accept even if the text is the same." self alwaysAccept
</methods> <methods> VWHelp.ArborHypertextController <category>model access</category>
model: aModel super model: aModel. self performer: aModel
</methods> <methods> VWHelp.ArborHypertextController <category>initialize-release</category>
initializeMenu self menuHolder: ((PluggableAdaptor on: self) getBlock: [:cont | | menuMsg | menuMsg := cont view menuMessage. menuMsg == nil ifTrue: [nil] ifFalse: [cont model perform: menuMsg]] putBlock: [:cont :v | ] updateBlock: [:cont :a :p | false])
</methods> <methods> VWHelp.ArborHyperlinkAssociation <category>testing</category>
hasStandardLinkTag ^self key = self class hyperlinkTag
isArborHyperlinkAssociation ^true
supersedesAsTextEmphasis: aTextEmphasis "Pass the superseding test on to my value - this is important for AHSHelpHyperlinkObjects." ^(super supersedesAsTextEmphasis: aTextEmphasis) and: [self value supersedesAsTextEmphasis: aTextEmphasis value]
</methods> <methods> VWHelp.ArborHyperlinkAssociation <category>printing</category>
printOn: aStream "Append to the argument, aStream, the two elements of the Association separated by a right arrow." aStream print: self key; nextPutAll: '~>'; print: self value
</methods> <methods> VWHelp.ArborHyperlinkAssociation class <category>instance creation</category>
value: value "Answer a new instance of the receiver with the key defaulted to the hyperlink tag and the value being the argument." ^self key: self hyperlinkTag value: value
</methods> <methods> VWHelp.ArborHyperlinkAssociation class <category>constants</category>
hyperlinkTag "Answer the symbol used as the key for any hyperlink association embedded in an ArborHypertext." ^#aisHyperlink
</methods> <methods> VWHelp.ArborHypertext <category>private</category>
linkBoundsAt: anInteger "Private - Answer an Interval containing the starting and stopping position of the link located at anInteger." ^runs aisBoundsForAttributeAt: anInteger
reduceEmphasis: emphasis "Flatten emphasis into a single-level array. Keep the hyperlink emphasis present, but embed it in an Array." emphasis isSymbol ifTrue: [^Array with: emphasis]. (self isHyperLink: emphasis) ifTrue: [^(self reduceEmphasis: emphasis value textEmphasis), (Array with: emphasis)]. emphasis isSequenceable ifTrue: [| str | str := (Array new: 10) writeStream. emphasis do: [:emph | str nextPutAll: (self reduceEmphasis: emph)]. ^str contents]. ^Array with: emphasis
</methods> <methods> VWHelp.ArborHypertext <category>accessing</category>
collectHypermediaAround: anIndex "Collect all hypermedia immediately around (to the left and right) the character in the position anIndex." | bounds | bounds := self linkBoundsAt: anIndex. ^ self copyFrom: bounds first to: bounds last
firstAvailable: aBlock "Returns the first available link using block test on this text, or nil. For efficiency, loops only through the runs values" runs values do: [:emphasis | (emphasis isSymbol not and: [emphasis isSequenceable]) ifTrue: [emphasis do: [:item | (aBlock value: item) ifTrue:[^item value]]] ifFalse: [(aBlock value: emphasis) ifTrue: [^emphasis value]]]. ^nil
firstAvailableLink "returns the first available Hyper link found in the text or nil" ^self firstAvailable: [:item | self isHyperLink: item]
replaceFrom: start to: stop with: aTextOrString "If aTextOrString is a string or a text with no emphasis then leave the original emphasis alone when replacing the range." ^aTextOrString isString ifTrue: [self replaceStringFrom: start to: stop with: aTextOrString] ifFalse: [super replaceFrom: start to: stop with: aTextOrString asArborHypertext]
replaceStringFrom: start to: stop with: aTextOrString "Replace the my string value only from start to stop with the entire contents of aTextOrString, leaving the existing emphasis intact." | selectedText | selectedText := self copyFrom: start to: stop. selectedText replaceStringWith: aTextOrString. super replaceFrom:start to: stop with: selectedText.
replaceStringWith: aString "Does replace of String, using the text emphasis of the receiver. For cases where the string being copied is longer than the receiver string, it extends the emphasis of the last character." | difference | string := string changeFrom: 1 to: self size with: aString. (difference := string size - runs size) > 0 ifTrue: [ runs isEmpty ifTrue: [ runs addLast: nil. difference := difference - 1]. runs runs at: (runs runs size) put: (runs runs last + difference)] ifFalse: [difference < 0 ifTrue: [runs := runs copyFrom: 1 to: aString size]].
</methods> <methods> VWHelp.ArborHypertext <category>emphasis</category>
addHyperlink: aLinkEmphasis "Change the text attributes to indicate that a hyper link exists." self addEmphasis: (Array with: aLinkEmphasis) removeEmphasis: #() allowDuplicates: false.
addHyperlink: aLinkEmphasis from: start to: stop "Change the text attributes to indicate that a hyper link exists." self addEmphasis: (Array with: aLinkEmphasis) removeEmphasis: #() allowDuplicates: false from: start to: stop
emphasisAt: characterIndex "Answer the actual emphasis, plus any implied emphasis computed from any hyperlinks." | emphasis | emphasis := self reduceEmphasis: (super emphasisAt: characterIndex). ^emphasis size = 1 ifTrue: [emphasis first] ifFalse: [emphasis]
rawEmphasisAt: characterIndex "Answer the actual, unmodified emphasis at characterIndex." ^super emphasisAt: characterIndex
removeAllHyperLinks "Removes all Hyperlinks from selected text" self aisAddEmphasis: #() removeEmphasisTest: [:emph | self isHyperLink: emph].
removeAllStyle "Removes all Style (Bold, Italics, etc.) from selected text, but leave hyperlinks" self aisAddEmphasis: #() removeEmphasisTest: [:emph | (self isHyperLink: emph) not].
</methods> <methods> VWHelp.ArborHypertext <category>printing</category>
printOn: aStream "Append to the argument aStream a sequence of characters that identifies the receiver." aStream nextPutAll: self class name; nextPutAll: ' for: '; print: string.
storeOn: aStream "Append to the argument aStream a sequence of characters that is an expression whose evaluation creates text similar to the receiver." aStream nextPut: $(; nextPutAll: self class name; nextPutAll: ' string: '; store: string; nextPutAll: ' runs: '; store: runs; nextPut: $)
</methods> <methods> VWHelp.ArborHypertext <category>testing</category>
isHyperLink: anEmphasis "Returns true if anEmphasis is a hyperlink" ^anEmphasis notNil and: [anEmphasis aisIsAssociation and: [anEmphasis isArborHyperlinkAssociation and: [anEmphasis hasStandardLinkTag]]]
</methods> <methods> VWHelp.ArborHypertext <category>converting</category>
asArborHypertext ^self
</methods> <methods> Core.RunArray <category>Arbor Hypertext adds</category>
aisAdd: newEmphasis removeTest: removeBlock "Taking each value in the receiver, add components found in newEmphasis and remove any components where removeBlock evaluates to true. Store the new value in another RunArray. Duplication is suppressed." | last cellSize newValues newRuns | last := nil. cellSize := 0. newValues := (Array new: runs size) writeStream. newRuns := (Array new: runs size) writeStream. 1 to: runs size do: [:runIndex || new | new := self aisPrivateAdd: newEmphasis removeTest: removeBlock to: (values at: runIndex). (new = last or: [cellSize = 0]) ifFalse: [ newValues nextPut: last. newRuns nextPut: cellSize. cellSize := 0]. cellSize := cellSize + (runs at: runIndex). last := new]. cellSize > 0 ifTrue: [ newValues nextPut: last. newRuns nextPut: cellSize]. ^self class runs: newRuns contents values: newValues contents
aisBoundsForAttributeAt: anInteger "Answer an Interval containing the start and stop points for the attribute located at anInteger." | result | self at: anInteger setRunAndOffset: [:run :offset || start | start := anInteger - offset. result := Interval from: start to: start + (runs at: run) - 1]. ^ result
aisPrivateAdd: addValues removeTest: removeBlock to: value "Begin with 'value', add components found in addValues, remove any items that test true in the removeBlock, answer the result. " | v existingValues | value == nil ifTrue: [existingValues := v := OrderedCollection new: addValues size + 5] ifFalse: [value class == Array ifTrue: [v := OrderedCollection new: addValues size + value size + 5. existingValues := value. 1 to: value size do: [:i | v add: (value at: i)]] ifFalse: [existingValues := v := OrderedCollection new: addValues size + 5. v add: value]]. 1 to: existingValues size do: [:i | | old | old := existingValues at: i. (removeBlock value: old) ifTrue: [v remove: old]]. v addAll: addValues. ^v isEmpty ifTrue: [nil] ifFalse: [v size = 1 ifTrue: [v at: 1] ifFalse: [v asArray]]
</methods> <methods> Graphics.GraphicsContext <category>Arbor Widgets adds</category>
aisDevicePaint ^devicePaint
</methods> <methods> Core.Text <category>Arbor Hypertext adds</category>
aisAddEmphasis: newEmphasis removeEmphasisTest: removeBlock "Add new emphases and remove and emphases where removeBlock evaluates to true." runs := runs aisAdd: newEmphasis removeTest: removeBlock
asArborHypertext ^#{VWHelp.ArborHypertext} value string: self string runs: self runs
emphasesDo: aBlock "Iterate through all emphases, evaluating aBlock for every atomic emphasis element. aBlock is a two-parameter block - first is the emphasis, second is an interval describing the range it emphasizes." | start | start := 1. runs runs with: runs values do: [:length :emph || range | range := start to: (start := start + length) - 1. self emphasis: emph do: [:e | aBlock value: e value: range]].
emphasesLike: anEmphasis do: aBlock "For each emphasis like anEmphasis, evaluate aBlock with the emphasis as a parameter." self emphasesDo: [:emph :interval | (anEmphasis supersedesAsTextEmphasis: emph) ifTrue: [aBlock value: emph]].
emphasis: anEmphasis do: aBlock "Simple way to process an emphasis, which may be nil, a symbol, association, generic object, or array. aBlock is a single-parameter block which is evaluated once for each atomic emphasis element." (anEmphasis isSymbol not and: [anEmphasis isSequenceable]) ifTrue: [anEmphasis do: [:emph | self emphasis: emph do: aBlock]] ifFalse: [aBlock value: anEmphasis].
rawEmphasisAt: anIndex "Polymorphism with ArborHypertext." ^self emphasisAt: anIndex
</methods> <methods> Core.Text <category>Arbor Core adds</category>
replaceFrom: start to: stop with: aTextOrString startingAt: anInteger "If not overridden, this method will answer a text with the emphases all stripped out. This is undesireable for the most part, so it is added by Arbor." ^self replaceFrom: start to: stop with: (aTextOrString copyFrom: anInteger to: (anInteger + stop - start))
</methods> <methods> Core.String <category>Arbor Hypertext adds</category>
asArborHypertext ^#{VWHelp.ArborHypertext} value fromString: self
</methods> <methods> Core.LookupKey <category>Arbor Hypertext adds</category>
isArborHyperlinkAssociation ^false
</methods> "Imported Classes:" self error: 'Attempting to file-in parcel imports. Choose terminate or close' <class> <name>Object</name> <environment>Core</environment> <super></super> <private>false</private> none <imports></imports> <category>Kernel-Objects</category> <attributes> <package>Kernel-Objects</package> </attributes> </class> <class> <name>LookupKey</name> <environment>Core</environment> <super>Core.Magnitude</super> <private>false</private> none key <imports></imports> <category>Collections-Support</category> <attributes> <package>Collections-Support</package> </attributes> </class> <class> <name>Association</name> <environment>Core</environment> <super>Core.LookupKey</super> <private>false</private> none value <imports></imports> <category>Collections-Support</category> <attributes> <package>Collections-Support</package> </attributes> </class> <class> <name>Text</name> <environment>Core</environment> <super>Core.CharacterArray</super> <private>false</private> none string runs <imports> private Graphics.TextConstants.* </imports> <category>Collections-Text</category> <attributes> <package>Collections-Text</package> </attributes> </class> <class> <name>ColorValue</name> <environment>Graphics</environment> <super>Graphics.SimplePaint</super> <private>false</private> none red green blue <imports></imports> <category>Graphics-Support</category> <attributes> <package>Graphics-Support</package> </attributes> </class> <class> <name>String</name> <environment>Core</environment> <super>Core.CharacterArray</super> <private>false</private> none <imports></imports> <category>Collections-Text</category> <attributes> <package>Collections-Text</package> </attributes> </class> <class> <name>TextSelectionTracker</name> <environment>UI</environment> <super>UI.ScrollingTracker</super> <private>false</private> none pivotBlock currentBlock nextBlock showingCaret gc prevStartBlock prevStopBlock <imports></imports> <category>Interface-Events-Trackers</category> <attributes> <package>Interface-Events-Trackers</package> </attributes> </class> <class> <name>GraphicsContext</name> <environment>Graphics</environment> <super>Core.Object</super> <private>false</private> none medium clipOriginX clipOriginY clipWidth clipHeight lineWidth capStyle joinStyle deviceFont devicePaint offsetX offsetY phaseX phaseY scaleX scaleY font paint paintPolicy fontPolicy clientData paintPreferences <imports></imports> <category>Graphics-Support</category> <attributes> <package>Graphics-Support</package> </attributes> </class> <class> <name>TextEditorController</name> <environment>UI</environment> <super>UI.ParagraphEditor</super> <private>false</private> none keyboardProcessor keyboardHook readOnly accepted autoAccept continuousAccept tabMeansNextField tabRequiresControl dispatcher <imports> private Graphics.TextConstants.* </imports> <category>UIBasics-Controllers</category> <attributes> <package>UIBasics-Controllers</package> </attributes> </class> <class> <name>RunArray</name> <environment>Core</environment> <super>Core.ArrayedCollection</super> <private>false</private> none runs values cacheRun cacheRunStart <imports></imports> <category>Collections-Arrayed</category> <attributes> <package>Collections-Arrayed</package> </attributes> </class>