'From Squeak3.5alpha of ''7 January 2003'' [latest update: #5169] on 5 March 2003 at 4:00:37 pm'! "Change Set: Hierarchy-TREG Date: 6 march 2003 Author: Thierry Reignier v2.4: added left arrows as collapsing or moving up (a la windows) added right arrows as expanding or moving down (a la windows) added parentMorph to IndentingListItemMorph for performance v2.3: added expandAllTo:, collapseAll, added respondsTo to expandOrCollapse: since FileList2 does not has its own explorer changed order of parameters in dispatchKeyPressed: aChar modifier: aModifier changed modifier and char in keyStroke: added left and right arrows in specialKeyPressed: added doubleClickSelector (as in PluggableListMorph) added scrolling signalling v2.2: removed event triggering, replaced by direct calls as per theory: morph -> model, morph -> subMorphs: direct call subMorph -> morph: event triggering v2.1: removed registration of itemExpanded and itemCollapsed events from morph. Must be done by subscriber. change to triggerEvent mechanism v2.0: added triggerEvent mechanism to hierarchyMorph exception block to capture unimplemented methods for triggerEvent v1: added navigation key handling (arrows, page up, down) expand / collapse (atl / ctrl + arrows / return) single letter search navigation handling "! StringMorph subclass: #IndentingListItemMorph instanceVariableNames: 'indentLevel isExpanded complexContents firstChild container nextSibling parentMorph ' classVariableNames: '' poolDictionaries: '' category: 'Tools-Explorer'! ScrollPane subclass: #SimpleHierarchicalListMorph instanceVariableNames: 'selectedMorph getListSelector keystrokeActionSelector autoDeselect expandedForm notExpandedForm columns sortingSelector getSelectionSelector setSelectionSelector potentialDropMorph lineColor doubleClickSelector ' classVariableNames: '' poolDictionaries: '' category: 'Tools-Explorer'! !AbstractHierarchicalList methodsFor: '*Hierarchy' stamp: 'TREG 1/25/2003 22:41'! collapseItem: aMorph "TREG: Let my model know about collapse" ^ self! ! !AbstractHierarchicalList methodsFor: '*Hierarchy' stamp: 'TREG 1/25/2003 22:42'! expandItem: aMorph "TREG: Let my model know about expansion" ^ self! ! !IndentingListItemMorph methodsFor: 'accessing' stamp: 'TREG 3/5/2003 14:17'! parentMorph ^parentMorph! ! !IndentingListItemMorph methodsFor: 'accessing' stamp: 'TREG 3/5/2003 14:17'! parentMorph: aMorph parentMorph := aMorph! ! !IndentingListItemMorph methodsFor: 'as yet unclassified' stamp: 'TREG 3/5/2003 14:53'! addChildrenForList: hostList addingTo: morphList withExpandedItems: expandedItems firstChild ifNotNil: [firstChild withSiblingsDo: [:aNode | aNode delete]]. firstChild _ nil. complexContents hasContents ifFalse: [^ self]. firstChild _ hostList addMorphsTo: morphList from: complexContents contents allowSorting: true withExpandedItems: expandedItems atLevel: indentLevel + 1 parentMorph: self! ! !ScrollPane methodsFor: '*Hierarchy' stamp: 'TREG 1/28/2003 13:45'! scrollBarValue: scrollValue scroller hasSubmorphs ifFalse: [^ self]. scroller offset: -3 @ (self leftoverScrollRange * scrollValue) rounded. "TREG: adding signalling so that other interested parties can be notified" self triggerEvent: #scrollBarValueChanged with: scrollValue ifNotHandled: []! ! !SimpleHierarchicalListMorph methodsFor: 'initialization' stamp: 'TREG 3/5/2003 14:51'! list: aCollection | wereExpanded morphList | wereExpanded _ self currentlyExpanded. scroller removeAllMorphs. (aCollection isNil or: [aCollection isEmpty]) ifTrue: [^ self selectedMorph: nil]. morphList _ OrderedCollection new. self addMorphsTo: morphList from: aCollection allowSorting: false withExpandedItems: wereExpanded atLevel: 0 parentMorph: nil. self insertNewMorphs: morphList! ! !SimpleHierarchicalListMorph methodsFor: 'as yet unclassified' stamp: 'TREG 3/5/2003 14:51'! addMorphsTo: morphList from: aCollection allowSorting: sortBoolean withExpandedItems: expandedItems atLevel: newIndent parentMorph: aParentMorph | priorMorph newCollection firstAddition | priorMorph _ nil. newCollection _ (sortBoolean and: [sortingSelector notNil]) ifTrue: [(aCollection asSortedCollection: [:a :b | (a perform: sortingSelector) <= (b perform: sortingSelector)]) asOrderedCollection] ifFalse: [aCollection]. firstAddition _ nil. newCollection do: [:item | priorMorph _ self indentingItemClass basicNew initWithContents: item prior: priorMorph forList: self indentLevel: newIndent. priorMorph parentMorph: aParentMorph. firstAddition ifNil: [firstAddition _ priorMorph]. morphList add: priorMorph. ((item hasEquivalentIn: expandedItems) or: [priorMorph isExpanded]) ifTrue: [priorMorph isExpanded: true. priorMorph addChildrenForList: self addingTo: morphList withExpandedItems: expandedItems]]. ^ firstAddition! ! !SimpleHierarchicalListMorph methodsFor: 'as yet unclassified' stamp: 'TREG 3/5/2003 14:19'! addSubmorphsAfter: parentMorph fromCollection: aCollection allowSorting: sortBoolean | priorMorph morphList newCollection | priorMorph _ nil. newCollection _ (sortBoolean and: [sortingSelector notNil]) ifTrue: [(aCollection asSortedCollection: [:a :b | (a perform: sortingSelector) <= (b perform: sortingSelector)]) asOrderedCollection] ifFalse: [aCollection]. morphList _ OrderedCollection new. newCollection do: [:item | priorMorph _ self indentingItemClass basicNew initWithContents: item prior: priorMorph forList: self indentLevel: parentMorph indentLevel + 1. priorMorph parentMorph: parentMorph. morphList add: priorMorph]. scroller addAllMorphs: morphList after: parentMorph. ^ morphList! ! !SimpleHierarchicalListMorph methodsFor: '*Hierarchy-keyboard' stamp: 'TREG 12/4/2002 22:25'! basicKeyPressed: aChar "TREG provides positioning by pressing letter" | oldSelection nextSelection max nextSelectionList nextSelectionText list | aChar asciiValue < 32 ifTrue: [^false]. nextSelection _ oldSelection _ self selectionIndex. list := self scroller submorphs. max _ self maximumSelection. nextSelectionList _ OrderedCollection newFrom: (list copyFrom: oldSelection + 1 to: max). nextSelectionList addAll: (list copyFrom: 1 to: oldSelection). "Get rid of blanks and style used in some lists" nextSelectionText _ nextSelectionList detect: [:a | a complexContents asString withBlanksTrimmed asLowercase beginsWith: aChar asString] ifNone: [self flash"match not found". ^false]. model okToChange ifFalse: [^false]. nextSelection _ list findFirst: [:a | a == nextSelectionText]. "No change if model is locked" oldSelection == nextSelection ifTrue: [self flash. ^false]. self selectionIndex: nextSelection. self setSelectedMorph: self selectedMorph. ^true! ! !SimpleHierarchicalListMorph methodsFor: '*Hierarchy-keyboard' stamp: 'TREG 1/14/2003 14:13'! dispatchKeyPressed: aChar modifier: aModifier " ^ TREG: last hope: let the model handle the keyboard event Return true if you handle the event" | args | keystrokeActionSelector == nil ifTrue: [^false]. args _ keystrokeActionSelector numArgs. args = 1 ifTrue: [^ model perform: keystrokeActionSelector with: aChar]. args = 2 ifTrue: [^ model perform: keystrokeActionSelector with: aChar with: self]. args = 3 ifTrue: [^ model perform: keystrokeActionSelector with: aChar with: aModifier with: self]. ^ self error: 'keystrokeActionSelector must be a 1-, 2-, or 3-keyword symbol'! ! !SimpleHierarchicalListMorph methodsFor: '*Hierarchy-keyboard' stamp: 'TREG 12/4/2002 21:42'! handlesKeyboard: evt ^true! ! !SimpleHierarchicalListMorph methodsFor: '*Hierarchy-keyboard' stamp: 'TREG 2/6/2003 14:58'! keyStroke: event "TREG improvements to support navigation" | char specialKey modifier | (self scrollByKeyboard: event) ifTrue: [^ self]. char _ event keyCharacter. specialKey _ char asciiValue. modifier _ Character value: event buttons. (event anyModifierKeyPressed not and: [specialKey < 32]) ifTrue: [(self specialKeyPressed: specialKey) ifTrue: [^ self]]. event anyModifierKeyPressed ifTrue: ["For some odd reasons if control is pressed together with a key then that key encoding does not correpsond to the ascii character. Works fine for Alt" (event controlKeyPressed and: [specialKey < 27]) ifTrue: [char _ (event keyValue + $a asciiValue - 1) asCharacter]. (self modifierKeyPressed: char) ifTrue: [^ self]] ifFalse: [(self basicKeyPressed: char) ifTrue: [^ self]]. ^ self dispatchKeyPressed: char modifier: modifier! ! !SimpleHierarchicalListMorph methodsFor: '*Hierarchy-keyboard' stamp: 'TREG 1/23/2003 22:21'! modifierKeyPressed: aChar "TREG support navigation by pressing ctlr or halt + arrows and such to expand. Arrows up and down are for scrolling" (aChar == Character arrowRight or: [aChar == Character cr or: [aChar == Character arrowLeft]]) ifTrue: [self expandOrCollapseCurrentMorph. ^ true]. ^ false! ! !SimpleHierarchicalListMorph methodsFor: '*Hierarchy-keyboard' stamp: 'TREG 2/6/2003 14:29'! mouseDown: evt "TREG: added doubleClickSelector" | aMorph selectors | aMorph _ self itemFromPoint: evt position. (aMorph notNil and: [aMorph inToggleArea: (aMorph point: evt position from: self)]) ifTrue: [^ self toggleExpandedState: aMorph event: evt]. evt yellowButtonPressed ifTrue: ["First check for option (menu) click" ^ self yellowButtonActivity: evt shiftPressed]. aMorph ifNil: [^ super mouseDown: evt]. aMorph highlightForMouseDown. selectors _ Array with: #click: with: (doubleClickSelector ifNotNil: [#doubleClick:]) with: nil with: (self dragEnabled ifTrue: [#startDrag:]). evt hand waitForClicksOrDrag: self event: evt selectors: selectors threshold: 10! ! !SimpleHierarchicalListMorph methodsFor: '*Hierarchy-keyboard' stamp: 'TREG 3/5/2003 15:32'! specialKeyPressed: asciiValue "TREG improvement to support navigation" | oldSelection nextSelection max howManyItemsShowing | (#(1 4 11 12 27 28 29 30 31 ) includes: asciiValue) ifFalse: [^ false]. asciiValue = 27 ifTrue: ["escape key" ActiveEvent shiftPressed ifTrue: [ActiveWorld putUpWorldMenuFromEscapeKey] ifFalse: [self yellowButtonActivity: false]. ^ true]. max _ self maximumSelection. max > 0 ifFalse: [^ false]. nextSelection _ oldSelection _ self selectionIndex. asciiValue = 28 ifTrue: [(self selectedMorph hasToggle and: [self selectedMorph isExpanded]) ifTrue: [self expandOrCollapseCurrentMorph. ^ true]. self selectedMorph parentMorph ifNotNil: [ nextSelection _ self scroller submorphIndexOf: self selectedMorph parentMorph]]. (asciiValue = 29 and: [self selectedMorph hasToggle]) ifTrue: [self selectedMorph isExpanded not ifTrue: [self expandOrCollapseCurrentMorph. ^ true]. nextSelection _ oldSelection + 1]. asciiValue = 30 ifTrue: ["up arrow" nextSelection _ oldSelection - 1. nextSelection < 1 ifTrue: [nextSelection _ max]]. asciiValue = 31 ifTrue: ["down arrow" nextSelection _ oldSelection + 1. nextSelection > max ifTrue: [nextSelection _ 1]]. asciiValue = 1 ifTrue: ["home" nextSelection _ 1]. asciiValue = 4 ifTrue: ["end" nextSelection _ max]. howManyItemsShowing _ self numSelectionsInView. asciiValue = 11 ifTrue: ["page up" nextSelection _ 1 max: oldSelection - howManyItemsShowing]. asciiValue = 12 ifTrue: ["page down" nextSelection _ oldSelection + howManyItemsShowing min: max]. "no change if model is locked" model okToChange ifFalse: [^ false]. oldSelection = nextSelection ifTrue: [self flash. ^ false]. self selectionIndex: nextSelection. self setSelectedMorph: self selectedMorph. ^ true! ! !SimpleHierarchicalListMorph methodsFor: '*Hierarchy-action' stamp: 'TREG 2/6/2003 14:42'! collapseAll self setSelectedMorph: scroller submorphs first. scroller submorphs copy do: [:each | (each canExpand and: [each isExpanded]) ifTrue: [self expandOrCollapse: each]]! ! !SimpleHierarchicalListMorph methodsFor: '*Hierarchy-action' stamp: 'TREG 1/27/2003 13:12'! doubleClick: event | aMorph | doubleClickSelector isNil ifTrue: [^ super doubleClick: event]. aMorph _ self itemFromPoint: event position. aMorph ifNil: [^ super doubleClick: event]. selectedMorph ifNil: [self setSelectedMorph: aMorph]. ^ self model perform: doubleClickSelector! ! !SimpleHierarchicalListMorph methodsFor: '*Hierarchy-action' stamp: 'TREG 1/27/2003 13:23'! doubleClickSelector: aSymbol doubleClickSelector _ aSymbol! ! !SimpleHierarchicalListMorph methodsFor: '*Hierarchy-action' stamp: 'TREG 1/1/2003 22:18'! expandAllTo: level self scroller allMorphsDo: [:each | each = self scroller ifFalse: [self expand: each to: level]]! ! !SimpleHierarchicalListMorph methodsFor: '*Hierarchy-action' stamp: 'TREG 1/2/2003 14:11'! expandOrCollapse: aMorph aMorph toggleExpandedState. self adjustSubmorphPositions. aMorph isExpanded ifTrue: [(self model respondsTo: #expandItem:) ifTrue: [self model expandItem: aMorph complexContents]] ifFalse: [(self model respondsTo: #collapseItem:) ifTrue: [self model collapseItem: aMorph complexContents]]! ! !SimpleHierarchicalListMorph methodsFor: '*Hierarchy-action' stamp: 'TREG 1/23/2003 21:56'! expandOrCollapseCurrentMorph self expandOrCollapse: self selectedMorph! ! !SimpleHierarchicalListMorph methodsFor: '*Hierarchy-action' stamp: 'TREG 11/30/2002 21:38'! toggleExpandedState: aMorph event: event | oldState | "self setSelectedMorph: aMorph." event yellowButtonPressed ifTrue: [ oldState _ aMorph isExpanded. scroller submorphs copy do: [ :each | (each canExpand and: [each isExpanded = oldState]) ifTrue: [ self expandOrCollapse: each]]] ifFalse: [self expandOrCollapse: aMorph] ! ! !SimpleHierarchicalListMorph methodsFor: '*Hierarchy-selecting' stamp: 'TREG 2/4/2003 15:27'! selectionIndex "TREG improvement to support navigation" ^self selectedMorph ifNotNil: [self scroller submorphIndexOf: self selectedMorph] ifNil: [self scroller submorphs isEmpty ifTrue: [0] ifFalse: [1]]! ]style[(14 2 40 3 4 26 4 27 4 26 4 41 1 16 1 2)f1b,f1,f1c152050000,f1,f1c190000135,f1,f1c190000135,f1,f1c190000135,f1,f1c190000135,f1,f1c007163000,f1,f1c007163000,f1! ! SimpleHierarchicalListMorph removeSelector: #addMorphsTo:from:allowSorting:withExpandedItems:atLevel:! !SimpleHierarchicalListMorph reorganize! ('initialization' autoDeselect: currentlyExpanded extent: initialize installModelIn: list: listItemHeight on:list:selected:changeSelected:menu:keystroke:) ('drawing' drawLinesOn: drawOn: highlightSelection unhighlightSelection) ('events' expand:to: expandAll expandAll: expandAll:except: handleMouseMove: handlesMouseOverDragging: mouseEnter: mouseEnterDragging: mouseLeaveDragging: mouseMove: mouseUp:) ('selection' maximumSelection minimumSelection numSelectionsInView selectedMorph selectedMorph: selection: selectionIndex: setSelectedMorph:) ('model access' getList) ('updating' update:) ('as yet unclassified' addMorphsTo:from:allowSorting:withExpandedItems:atLevel:parentMorph: addSubmorphsAfter:fromCollection:allowSorting: adjustSubmorphPositions columns columns: expandedForm getCurrentSelectionItem indentingItemClass insertNewMorphs: notExpandedForm noteRemovalOfAll: scrollDeltaHeight selectionOneOf: sortingSelector:) ('dropping/grabbing' acceptDroppingMorph:event: potentialDropMorph potentialDropMorph: resetPotentialDropMorph startDrag: wantsDroppedMorph:event:) ('accessing' itemFromPoint: lineColor lineColor:) ('obsolete' mouseDown:onItem: mouseEnterDragging:onItem: mouseLeaveDragging:onItem: removeObsoleteEventHandlers startDrag:onItem:) ('*Hierarchy-keyboard' basicKeyPressed: dispatchKeyPressed:modifier: handlesKeyboard: keyStroke: modifierKeyPressed: mouseDown: specialKeyPressed:) ('*Hierarchy-action' collapseAll doubleClick: doubleClickSelector: expandAllTo: expandOrCollapse: expandOrCollapseCurrentMorph toggleExpandedState:event:) ('*Hierarchy-selecting' selectionIndex) !