Morph to display a table ?Lic. Edgar J. De Cleene edgardec2001 at yahoo.com.arThu Apr 24 13:53:15 UTC 2003
On 24/04/03 08:37, "Alain Fischer" <mailinglist.fischer at bluewin.ch> wrote: > Hello Squeakers, > > I have searched a way to display the content of a table (Array of > Array). > The table has 4000 rows and 10 columns (larger than sreen). > > The best I come is with a PluggableMultiColumnListMorph but the > problems are: > - No horizontal scroll bar, I can't view the last columns. > - The vertical scroll bar is very very slow. > - There isn't column name. > > Is there somewhere in the image or a package with these capability ? > > Thanks in advance. > Alain Alain: You can use the atached change set for having horizontal scroll bars from Steven Swerling. Cheers. Edgar -------------- next part -------------- 'From Squeak3.4beta of ''1 December 2002'' [latest update: #5138] on 28 December 2002 at 3:15:11 pm'! "Change Set: scrollport Date: 28 December 2002 Author: Steven Swerling I was adding a horizontal scrollbar to the SimpleHierarchicalListMorph, but realized that many of the methods would be generic to any subclass of ScrollPane. And there were many methods. So I moved the changes up to ScrollPane. This changeset adds a horizontal scrollbar to ScrollPane, which appears as needed. I don't know if there is any demand for this, so I'm just running it up the flagpole. WARNING: The last thing you need is for a bug in ScrollPane. I don't know of any in this code, but better safe then sorry. So consider this a beta. Please tinker around with your applications to make sure everything is working ok before saving your image. Tested on a fresh 3.4 image w/ updates up to #5138. "! ComponentLikeModel subclass: #ScrollPane instanceVariableNames: 'scrollBar scroller retractableScrollBar scrollBarOnLeft getMenuSelector getMenuTitleSelector scrollBarHidden hasFocus hScrollBar ' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Windows'! !ScrollPane commentStamp: '<historical>' prior: 0! The scroller (a transform) of a scrollPane is driven by the scrollBar. The scroll values vary from 0.0, meaning zero offset to 1.0 meaning sufficient offset such that the bottom of the scrollable material appears 3/4 of the way down the pane. The total distance to achieve this range is called the totalScrollRange.! !ScrollBar methodsFor: 'geometry' stamp: 'sps 12/27/2002 00:14'! totalSliderArea | upperBoundsButton | upperBoundsButton _ menuButton ifNil: [upButton]. bounds isWide ifTrue:[ upButton right > upperBoundsButton right ifTrue:[upperBoundsButton _ upButton ]] ifFalse:[ upButton bottom > upperBoundsButton bottom ifTrue: [upperBoundsButton _ upButton]]. ^ bounds isWide ifTrue: [upperBoundsButton bounds topRight corner: downButton bounds bottomLeft] ifFalse: [upperBoundsButton bounds bottomLeft corner: downButton bounds topRight]. ! ! !ScrollPane methodsFor: 'initialization' stamp: 'sps 12/28/2002 01:33'! initialize retractableScrollBar _ (Preferences valueOfFlag: #inboardScrollbars) not. scrollBarOnLeft _ (Preferences valueOfFlag: #scrollBarsOnRight) not. super initialize. hasFocus _ false. borderWidth _ 2. borderColor _ Color black. scrollBar := ScrollBar new model: self slotName: 'vScrollBar'. scrollBar borderWidth: 1; borderColor: Color black. hScrollBar := ScrollBar new model: self slotName: 'hScrollBar'. hScrollBar borderWidth: 1; borderColor: Color black. scroller := TransformMorph new color: Color transparent. scroller offset: -3 at 0. self addMorph: scroller. scrollBar initializeEmbedded: retractableScrollBar not. retractableScrollBar ifFalse: [self addMorph: scrollBar]. retractableScrollBar ifFalse: [self addMorph: hScrollBar]. self extent: 150 at 120. self hideOrShowScrollBars. ! ! !ScrollPane methodsFor: 'access' stamp: 'sps 12/28/2002 01:07'! adoptPaneColor: paneColor super adoptPaneColor: paneColor. scrollBar adoptPaneColor: paneColor. hScrollBar adoptPaneColor: paneColor. ! ! !ScrollPane methodsFor: 'access' stamp: 'dew 3/23/2002 01:20'! flatColoredScrollBarLook "Currently only show the flat (not rounded) + colored-to-match-window scrollbar look when inboard." ^ Preferences alternativeScrollbarLook and: [retractableScrollBar not or: [ScrollBar alwaysShowFlatScrollbarForAlternativeLook]] ! ! !ScrollPane methodsFor: 'access' stamp: 'dew 10/17/1999 19:40'! hasFocus "hasFocus is currently set by mouse enter/leave events. This inst var should probably be moved up to a higher superclass." ^ hasFocus ifNil: [false]! ! !ScrollPane methodsFor: 'access' stamp: 'sps 12/20/2002 22:33'! retractableOrNot "Change scroll bar operation" retractableScrollBar _ retractableScrollBar not. retractableScrollBar ifTrue: [self privateRemoveMorph: scrollBar; privateRemoveMorph: hScrollBar] ifFalse: [ (submorphs includes: scrollBar) ifFalse: [self privateAddMorph: scrollBar atIndex: 1]. (submorphs includes: hScrollBar) ifFalse: [self privateAddMorph: hScrollBar atIndex: 1]]. self extent: self extent ! ! !ScrollPane methodsFor: 'access' stamp: 'LC 6/12/2000 09:28'! retractableScrollBar ^ retractableScrollBar! ! !ScrollPane methodsFor: 'access' stamp: 'LC 6/12/2000 09:28'! scrollBarOnLeft ^ scrollBarOnLeft! ! !ScrollPane methodsFor: 'access'! scroller ^ scroller! ! !ScrollPane methodsFor: 'access' stamp: 'ar 5/19/1999 18:06'! scroller: aTransformMorph scroller ifNotNil:[scroller delete]. scroller _ aTransformMorph. self addMorph: scroller. self resizeScroller.! ! !ScrollPane methodsFor: 'access' stamp: 'di 6/7/97 10:42'! wantsSlot "For now do it the old way, until we sort this out" ^ true! ! !ScrollPane methodsFor: 'geometry' stamp: 'sps 12/24/2002 16:20'! containsPoint: aPoint (super containsPoint: aPoint) ifTrue: [^ true]. "Also include v scrollbar when it is extended..." ((retractableScrollBar and: [submorphs includes: scrollBar]) and: [scrollBar containsPoint: aPoint]) ifTrue:[ ^true ]. "Also include hScrollbar when it is extended..." ^ (retractableScrollBar and: [self hIsScrollbarShowing]) and: [hScrollBar containsPoint: aPoint] ! ! !ScrollPane methodsFor: 'geometry' stamp: 'sps 12/28/2002 01:29'! extent: newExtent | oldW oldH oldE wasHShowing wasVShowing noVPlease noHPlease minH minW | oldW _ self width. oldH _ self height. oldE _ self extent. wasHShowing _ self hIsScrollbarShowing. wasVShowing _ self vIsScrollbarShowing. "Figure out the minimum width and height for this pane so that scrollbars will appear" noVPlease _ self valueOfProperty: #noVScrollBarPlease ifAbsent: [false]. noHPlease _ self valueOfProperty: #noHScrollBarPlease ifAbsent: [false]. minH _ self scrollBarThickness + 16. minW _ self scrollBarThickness + 20. noVPlease ifTrue:[ noHPlease ifTrue:[minH _ 1. minW _ 1 ] ifFalse:[minH _ self scrollBarThickness ]. ] ifFalse:[ noHPlease ifTrue:[minH _ self scrollBarThickness + 5]. ]. super extent: (newExtent max: (minW at minH)). "If extent has not changed, no need to reset scroll deltas, etc" (self extent = oldE) ifTrue:[ ^self ]. "Now reset widget sizes" self resizeScrollBars; resizeScroller; hideOrShowScrollBars. "Now resetScrollDeltas where appropriate" ((self height ~~ oldH) or: [ wasHShowing ~~ self hIsScrollbarShowing]) ifTrue:[ (retractableScrollBar or: [ self vIsScrollbarShowing ]) ifTrue:[ self vSetScrollDelta ]. ]. ((self width ~~ oldW) or: [wasVShowing ~~ self vIsScrollbarShowing]) ifTrue:[ (retractableScrollBar or: [ self hIsScrollbarShowing ]) ifTrue:[ self hSetScrollDelta ]. ]. ! ! !ScrollPane methodsFor: 'geometry' stamp: 'sps 12/24/2002 00:13'! hExtraScrollRange "Return the amount of extra blank space to include below the bottom of the scroll content." ^ self scrollDeltaWidth ! ! !ScrollPane methodsFor: 'geometry' stamp: 'sps 12/27/2002 14:06'! hIsScrollbarNeeded "Return whether the horz scrollbar is needed" "Don't do anything with the retractable scrollbar unless we have focus" retractableScrollBar & self hasFocus not ifTrue: [^false]. "Don't show it if we were told not to." (self valueOfProperty: #noHScrollBarPlease ifAbsent: [false]) ifTrue: [^false]. ^self hIsScrollable ! ! !ScrollPane methodsFor: 'geometry' stamp: 'sps 12/26/2002 12:25'! hLeftoverScrollRange "Return the entire scrolling range minus the currently viewed area." | w | "scroller localSubmorphBounds ifNil: [^ 0]." scroller hasSubmorphs ifFalse:[^0]. w _ bounds width. self vIsScrollbarShowing ifTrue:[ w _ w - self scrollBarThickness ]. ^ (self hTotalScrollRange - w roundTo: self scrollDeltaHeight) max: 0 ! ! !ScrollPane methodsFor: 'geometry' stamp: 'sps 12/27/2002 01:30'! hResizeScrollBar | topLeft h border | (self valueOfProperty: #noHScrollBarPlease ifAbsent: [false]) ifTrue: [^self]. h _ self scrollBarThickness. border _ borderWidth. topLeft _ retractableScrollBar ifTrue: [bounds bottomLeft + (border @ border negated)] ifFalse: [bounds bottomLeft + (border @ (h + border) negated)]. hScrollBar bounds: (topLeft extent: self hScrollBarWidth@ h) ! ! !ScrollPane methodsFor: 'geometry' stamp: 'sps 12/25/2002 16:16'! hScrollBarWidth "Return the width of the horizontal scrollbar" | w | w _ bounds width - (2 * borderWidth). (retractableScrollBar not and: [self vIsScrollbarNeeded]) ifTrue: [w _ w - self scrollBarThickness ]. ^w ! ! !ScrollPane methodsFor: 'geometry' stamp: 'sps 12/26/2002 15:09'! hSetScrollDelta "Set the ScrollBar deltas, value and interval, based on the current scroll pane size, offset and range." | range delta | scroller hasSubmorphs ifFalse:[scrollBar interval: 1.0. ^self]. delta _ self scrollDeltaWidth. range _ self hLeftoverScrollRange. range = 0 ifTrue: [^ hScrollBar scrollDelta: 0.02 pageDelta: 0.2; interval: 1.0; setValue: 0]. "Set up for one line (for arrow scrolling), or a full pane less one line (for paging)." hScrollBar scrollDelta: (delta / range) asFloat pageDelta: ((self innerBounds width - delta) / range) asFloat. hScrollBar interval: ((self innerBounds width) / self hTotalScrollRange) asFloat. hScrollBar setValue: (scroller offset x / self hLeftoverScrollRange min: 1.0) asFloat. ! ! !ScrollPane methodsFor: 'geometry' stamp: 'sps 12/24/2002 00:17'! hTotalScrollRange "Return the entire scrolling range." ^ self hUnadjustedScrollRange + self hExtraScrollRange ! ! !ScrollPane methodsFor: 'geometry' stamp: 'sps 12/24/2002 16:07'! hUnadjustedScrollRange "Return the width extent of the receiver's submorphs." | submorphBounds | submorphBounds := scroller localSubmorphBounds ifNil: [^ 0]. ^ submorphBounds right ! ! !ScrollPane methodsFor: 'geometry' stamp: 'sps 12/24/2002 16:18'! innerBounds | inner | inner _ super innerBounds. retractableScrollBar | (submorphs includes: scrollBar) not ifFalse:[ inner _ (scrollBarOnLeft ifTrue: [scrollBar right @ inner top corner: inner bottomRight] ifFalse: [inner topLeft corner: scrollBar left @ inner bottom]) ]. (retractableScrollBar | self hIsScrollbarShowing not) ifTrue: [^ inner] ifFalse: [^ inner topLeft corner: (inner bottomRight - (0 at self scrollBarThickness))]. ! ! !ScrollPane methodsFor: 'geometry' stamp: 'dew 10/17/1999 19:41'! resetExtent "Reset the extent. (may be overridden by subclasses which need to do more than this)" self resizeScroller! ! !ScrollPane methodsFor: 'geometry' stamp: 'sps 12/25/2002 16:34'! resizeScrollBars self vResizeScrollBar; hResizeScrollBar ! ! !ScrollPane methodsFor: 'geometry' stamp: 'di 11/11/1998 09:48'! resizeScroller scroller bounds: self innerBounds! ! !ScrollPane methodsFor: 'geometry' stamp: 'sps 12/20/2002 22:36'! scrollBarFills: aRectangle "Return true if a flop-out scrollbar fills the rectangle" retractableScrollBar ifFalse:[^false]. ((submorphs includes: scrollBar) and: [scrollBar bounds containsRect: aRectangle]) ifTrue:[ ^true ]. ^((submorphs includes: hScrollBar) and: [hScrollBar bounds containsRect: aRectangle]) ! ! !ScrollPane methodsFor: 'geometry' stamp: 'sps 12/25/2002 15:38'! scrollBarThickness self flatColoredScrollBarLook ifTrue: [(Preferences scrollBarsNarrow) ifTrue: [^ 10] ifFalse: [^ 14]] ifFalse: [(Preferences scrollBarsNarrow) ifTrue: [^ 12] ifFalse: [^ 16]] ! ! !ScrollPane methodsFor: 'geometry' stamp: 'dew 2/19/1999 17:08'! scrollDeltaHeight "Return the increment in pixels which this pane should be scrolled (normally a subclass responsibility)." ^ 12 ! ! !ScrollPane methodsFor: 'geometry' stamp: 'sps 12/22/2002 01:41'! scrollDeltaWidth "Return the increment in pixels which this pane should be scrolled (normally a subclass responsibility)." ^ 1 ! ! !ScrollPane methodsFor: 'geometry' stamp: 'sps 12/26/2002 12:43'! setScrollDeltas "Set the ScrollBar deltas, value and interval, based on the current scroll pane size, offset and range." scroller hasSubmorphs ifFalse: [scrollBar interval: 1.0. ^ self]. "NOTE: fullbounds commented out now -- trying to find a case where this expensive step is necessary -- perhaps there is a less expensive way to handle that case." "scroller fullBounds." "force recompute so that leftoverScrollRange will be up-to-date" self hideOrShowScrollBars. (retractableScrollBar or: [ self vIsScrollbarShowing ]) ifTrue:[ self vSetScrollDelta ]. (retractableScrollBar or: [ self hIsScrollbarShowing ]) ifTrue:[ self hSetScrollDelta ]. ! ! !ScrollPane methodsFor: 'geometry' stamp: 'sps 12/25/2002 14:40'! vExtraScrollRange "Return the amount of extra blank space to include below the bottom of the scroll content." "The classic behavior would be ^bounds height - (bounds height * 3 // 4)" ^ self scrollDeltaHeight ! ! !ScrollPane methodsFor: 'geometry' stamp: 'sps 12/27/2002 14:06'! vIsScrollbarNeeded "Return whether the verticle scrollbar is needed" "Don't do anything with the retractable scrollbar unless we have focus" retractableScrollBar & self hasFocus not ifTrue: [^false]. "Don't show it if we were told not to." (self valueOfProperty: #noVScrollBarPlease ifAbsent: [false]) ifTrue: [^false]. ^self vIsScrollable ! ! !ScrollPane methodsFor: 'geometry' stamp: 'sps 12/26/2002 12:24'! vLeftoverScrollRange "Return the entire scrolling range minus the currently viewed area." | h | "scroller localSubmorphBounds ifNil: [^ 0]." scroller hasSubmorphs ifFalse:[^0]. h _ self vScrollBarHeight. (retractableScrollBar not and: [self hIsScrollbarNeeded]) ifTrue:[ h _ h - self scrollBarThickness ]. ^ (self vTotalScrollRange - h roundTo: self scrollDeltaHeight) max: 0 ! ! !ScrollPane methodsFor: 'geometry' stamp: 'sps 12/27/2002 01:30'! vResizeScrollBar | w topLeft | (self valueOfProperty: #noVScrollBarPlease ifAbsent: [false]) ifTrue: [^self]. w _ self scrollBarThickness. topLeft _ scrollBarOnLeft ifTrue: [retractableScrollBar ifTrue: [bounds topLeft - (w-borderWidth@(0-borderWidth))] ifFalse: [bounds topLeft + (borderWidth at borderWidth)]] ifFalse: [retractableScrollBar ifTrue: [bounds topRight - (borderWidth@(0-borderWidth))] ifFalse: [bounds topRight - (w+borderWidth@(0-borderWidth))]]. scrollBar bounds: (topLeft extent: w @ self vScrollBarHeight). ! ! !ScrollPane methodsFor: 'geometry' stamp: 'sps 12/25/2002 16:14'! vScrollBarHeight | h | h _ bounds height - (2 * borderWidth). (retractableScrollBar not and: [self hIsScrollbarNeeded]) ifTrue:[ h _ h - self scrollBarThickness. ]. ^h ! ! !ScrollPane methodsFor: 'geometry' stamp: 'sps 12/25/2002 16:36'! vSetScrollDelta "Set the ScrollBar deltas, value and interval, based on the current scroll pane size, offset and range." | range delta | scroller hasSubmorphs ifFalse:[scrollBar interval: 1.0. ^self]. delta _ self scrollDeltaHeight. range _ self vLeftoverScrollRange. range = 0 ifTrue: [^ scrollBar scrollDelta: 0.02 pageDelta: 0.2; interval: 1.0; setValue: 0]. "Set up for one line (for arrow scrolling), or a full pane less one line (for paging)." scrollBar scrollDelta: (delta / range) asFloat pageDelta: ((self innerBounds height - delta) / range) asFloat. scrollBar interval: ((self innerBounds height) / self vTotalScrollRange) asFloat. scrollBar setValue: (scroller offset y / self vLeftoverScrollRange min: 1.0) asFloat. ! ! !ScrollPane methodsFor: 'geometry' stamp: 'sps 12/25/2002 16:28'! vTotalScrollRange "Return the entire scrolling range." ^ self unadjustedScrollRange + self vExtraScrollRange ! ! !ScrollPane methodsFor: 'geometry' stamp: 'sps 12/25/2002 14:43'! vUnadjustedScrollRange "Return the height extent of the receiver's submorphs." | submorphBounds | submorphBounds := scroller localSubmorphBounds ifNil: [^ 0]. ^ submorphBounds bottom ! ! !ScrollPane methodsFor: 'pane events' stamp: 'di 5/7/1998 09:52'! handlesMouseDown: evt ^ true! ! !ScrollPane methodsFor: 'pane events' stamp: 'ar 9/18/2000 22:11'! handlesMouseOver: evt "Could just ^ true, but this ensures that scroll bars won't flop out if you mouse-over appendages such as connecting pins." self flag: #arNote. "I have no idea how the code below could've ever worked. If the receiver does not handle mouse over events then it should not receive any #mouseLeave if the mouse leaves the receiver for real. This is because 'evt cursorPoint' describes the *end* point of the movement and considering that the code would return false if the move ends outside the receiver the scroll bars should never pop back in again. Which is exactly what happens with the new event logic if you don't just ^true. I'm leaving the code in for reference - perhaps somebody can make sense from it; I sure cannot." ^true " | cp | cp _ evt cursorPoint. (bounds containsPoint: cp) ifTrue: [^ true] ifFalse: [self submorphsDo: [:m | (m containsPoint: cp) ifTrue: [m == scrollBar ifTrue: [^ true] ifFalse: [^ false]]]. ^ false] "! ! !ScrollPane methodsFor: 'pane events' stamp: 'bf 4/14/1999 12:39'! keyStroke: evt "If pane is not full, pass the event to the last submorph, assuming it is the most appropriate recipient (!!)" (self scrollByKeyboard: evt) ifTrue: [^self]. scroller submorphs last keyStroke: evt! ! !ScrollPane methodsFor: 'pane events' stamp: 'di 6/30/1998 08:48'! mouseDown: evt evt yellowButtonPressed "First check for option (menu) click" ifTrue: [^ self yellowButtonActivity: evt shiftPressed]. "If pane is not full, pass the event to the last submorph, assuming it is the most appropriate recipient (!!)" scroller hasSubmorphs ifTrue: [scroller submorphs last mouseDown: (evt transformedBy: (scroller transformFrom: self))]! ! !ScrollPane methodsFor: 'pane events' stamp: 'sps 12/25/2002 14:55'! mouseEnter: event hasFocus _ true. (owner isKindOf: SystemWindow) ifTrue: [owner paneTransition: event]. retractableScrollBar ifTrue:[ self hideOrShowScrollBars ]. ! ! !ScrollPane methodsFor: 'pane events' stamp: 'sps 12/20/2002 22:31'! mouseLeave: event hasFocus _ false. retractableScrollBar ifTrue: [self hideScrollBars]. (owner isKindOf: SystemWindow) ifTrue: [owner paneTransition: event] ! ! !ScrollPane methodsFor: 'pane events' stamp: 'ar 10/10/2000 23:01'! mouseMove: evt "If pane is not full, pass the event to the last submorph, assuming it is the most appropriate recipient (!!)." scroller hasSubmorphs ifTrue: [scroller submorphs last mouseMove: (evt transformedBy: (scroller transformFrom: self))]! ! !ScrollPane methodsFor: 'pane events' stamp: 'di 5/7/1998 11:46'! mouseUp: evt "If pane is not full, pass the event to the last submorph, assuming it is the most appropriate recipient (!!)" scroller hasSubmorphs ifTrue: [scroller submorphs last mouseUp: (evt transformedBy: (scroller transformFrom: self))]! ! !ScrollPane methodsFor: 'pane events' stamp: 'th 12/11/1999 17:21'! scrollByKeyboard: event "If event is ctrl+up/down then scroll and answer true" (event controlKeyPressed or:[event commandKeyPressed]) ifFalse: [^ false]. event keyValue = 30 ifTrue: [scrollBar scrollUp: 3. ^ true]. event keyValue = 31 ifTrue: [scrollBar scrollDown: 3. ^ true]. ^ false! ! !ScrollPane methodsFor: 'scroll bar events' stamp: 'sps 12/27/2002 00:13'! hScrollBarMenuButtonPressed: event ^ self scrollBarMenuButtonPressed: event ! ! !ScrollPane methodsFor: 'scroll bar events' stamp: 'di 6/26/1998 13:31'! scrollBarMenuButtonPressed: event ^ self yellowButtonActivity: event shiftPressed! ! !ScrollPane methodsFor: 'scroll bar events' stamp: 'sw 3/22/2001 12:03'! shiftedTextPaneMenuRequest "The more... button was hit from the text-pane menu" ^ self yellowButtonActivity: true! ! !ScrollPane methodsFor: 'scroll bar events' stamp: 'di 6/26/1998 13:31'! shiftedYellowButtonActivity ^ self yellowButtonActivity: true! ! !ScrollPane methodsFor: 'scroll bar events' stamp: 'di 6/26/1998 13:32'! unshiftedYellowButtonActivity ^ self yellowButtonActivity: false! ! !ScrollPane methodsFor: 'scroll bar events' stamp: 'sps 12/27/2002 00:13'! vScrollBarMenuButtonPressed: event ^ self scrollBarMenuButtonPressed: event ! ! !ScrollPane methodsFor: 'scroll bar events' stamp: 'RAA 6/12/2000 09:02'! yellowButtonActivity: shiftKeyState | menu | (menu _ self getMenu: shiftKeyState) ifNotNil: [menu setInvokingView: self. menu popUpEvent: self activeHand lastEvent in: self world]! ! !ScrollPane methodsFor: 'menu' stamp: 'di 11/14/97 09:07'! addCustomMenuItems: aCustomMenu hand: aHandMorph super addCustomMenuItems: aCustomMenu hand: aHandMorph. retractableScrollBar ifTrue: [aCustomMenu add: 'make scrollbar inboard' action: #retractableOrNot] ifFalse: [aCustomMenu add: 'make scrollbar retractable' action: #retractableOrNot]. scrollBarOnLeft ifTrue: [aCustomMenu add: 'scroll bar on right' action: #leftOrRight] ifFalse: [aCustomMenu add: 'scroll bar on left' action: #leftOrRight]! ! !ScrollPane methodsFor: 'menu' stamp: 'sw 9/23/1998 08:47'! getMenu: shiftKeyState "Answer the menu for this text view, supplying an empty menu to be filled in. If the menu selector takes an extra argument, pass in the current state of the shift key." | menu aMenu aTitle | getMenuSelector == nil ifTrue: [^ nil]. menu _ MenuMorph new defaultTarget: model. aTitle _ getMenuTitleSelector ifNotNil: [model perform: getMenuTitleSelector]. getMenuSelector numArgs = 1 ifTrue: [aMenu _ model perform: getMenuSelector with: menu. aTitle ifNotNil: [aMenu addTitle: aTitle]. ^ aMenu]. getMenuSelector numArgs = 2 ifTrue: [aMenu _ model perform: getMenuSelector with: menu with: shiftKeyState. aTitle ifNotNil: [aMenu addTitle: aTitle]. ^ aMenu]. ^ self error: 'The getMenuSelector must be a 1- or 2-keyword symbol'! ! !ScrollPane methodsFor: 'menu' stamp: 'di 11/14/97 09:09'! leftOrRight "Change scroll bar location" scrollBarOnLeft _ scrollBarOnLeft not. self extent: self extent! ! !ScrollPane methodsFor: 'menu' stamp: 'sw 8/18/1998 12:38'! menuTitleSelector: aSelector getMenuTitleSelector _ aSelector! ! !ScrollPane methodsFor: 'menu' stamp: 'sw 11/5/1998 14:14'! retractable: aBoolean retractableScrollBar == aBoolean ifFalse: [self retractableOrNot "toggles it"]! ! !ScrollPane methodsFor: 'menu' stamp: 'sw 1/13/98 21:27'! scrollBarOnLeft: aBoolean scrollBarOnLeft _ aBoolean. self extent: self extent! ! !ScrollPane methodsFor: 'OBSOLETE METHODS' stamp: 'sps 12/25/2002 14:40'! extraScrollRange ^self vExtraScrollRange ! ! !ScrollPane methodsFor: 'OBSOLETE METHODS' stamp: 'sps 12/25/2002 14:49'! hideOrShowScrollBar ^self hideOrShowScrollBars ! ! !ScrollPane methodsFor: 'OBSOLETE METHODS' stamp: 'sps 12/25/2002 14:35'! hideScrollBar ^self vHideScrollBar ! ! !ScrollPane methodsFor: 'OBSOLETE METHODS' stamp: 'sps 12/26/2002 23:24'! hideScrollBarIndefinitely ^self hideScrollBarsIndefinitely ! ! !ScrollPane methodsFor: 'OBSOLETE METHODS' stamp: 'sps 12/25/2002 14:32'! isScrollable ^self vIsScrollable ! ! !ScrollPane methodsFor: 'OBSOLETE METHODS' stamp: 'sps 12/25/2002 14:26'! isScrollbarShowing ^self vIsScrollbarShowing ! ! !ScrollPane methodsFor: 'OBSOLETE METHODS' stamp: 'sps 12/25/2002 14:26'! isScrolled ^self vIsScrolled ! ! !ScrollPane methodsFor: 'OBSOLETE METHODS' stamp: 'sps 12/25/2002 14:41'! leftoverScrollRange ^self vLeftoverScrollRange ! ! !ScrollPane methodsFor: 'OBSOLETE METHODS' stamp: 'sps 12/25/2002 14:47'! resizeScrollBar ^self vResizeScrollBar ! ! !ScrollPane methodsFor: 'OBSOLETE METHODS' stamp: 'sps 12/25/2002 14:58'! scrollBarValue: scrollValue ^self vScrollBarValue: scrollValue ! ! !ScrollPane methodsFor: 'OBSOLETE METHODS' stamp: 'sps 12/25/2002 15:40'! scrollbarWidth ^self scrollBarThickness ! ! !ScrollPane methodsFor: 'OBSOLETE METHODS' stamp: 'sps 12/25/2002 14:25'! showScrollBar ^self vShowScrollBar ! ! !ScrollPane methodsFor: 'OBSOLETE METHODS' stamp: 'sps 12/25/2002 14:42'! totalScrollRange ^self vTotalScrollRange ! ! !ScrollPane methodsFor: 'OBSOLETE METHODS' stamp: 'sps 12/25/2002 14:43'! unadjustedScrollRange ^self vUnadjustedScrollRange ! ! !ScrollPane methodsFor: 'HSCROLL TODO' stamp: 'sps 12/25/2002 18:32'! isRetractableScrollbarShowing "Return true if a retractable scroll bar is currently showing" "NOTE: It appears this has no senders. Move to obsolete?" retractableScrollBar ifFalse:[^false]. ^submorphs includes: scrollBar ! ! !ScrollPane methodsFor: 'scrolling' stamp: 'sps 12/25/2002 01:10'! hHideOrShowScrollBar "Hide or show the scrollbar depending on if the pane is scrolled/scrollable." self hIsScrollbarNeeded ifTrue:[ self hShowScrollBar ] ifFalse: [ self hHideScrollBar ]. ! ! !ScrollPane methodsFor: 'scrolling' stamp: 'sps 12/24/2002 00:09'! hHideScrollBar self hIsScrollbarShowing ifFalse: [^self]. self privateRemoveMorph: hScrollBar. hScrollBar privateOwner: nil. retractableScrollBar ifFalse: [self resetExtent]. ! ! !ScrollPane methodsFor: 'scrolling' stamp: 'sps 12/24/2002 17:25'! hIsScrollable "(Preferences valueOfFlag: #hiddenScrollBars) ifFalse: [^ true]." "If the contents of the pane are too small to scroll, return false." ^ self hLeftoverScrollRange > 0 "treat a single line as non-scrollable" " and: [self hTotalScrollRange > (self scrollDeltaWidth * 3/2)]" ! ! !ScrollPane methodsFor: 'scrolling' stamp: 'sps 12/24/2002 15:49'! hIsScrollbarShowing "Return true if a horz scroll bar is currently showing" ^submorphs includes: hScrollBar ! ! !ScrollPane methodsFor: 'scrolling' stamp: 'sps 12/23/2002 23:58'! hIsScrolled "If the scroller is not set to x = 0, then the pane has been h-scrolled." ^scroller offset x > 0 ! ! !ScrollPane methodsFor: 'scrolling' stamp: 'sps 12/24/2002 16:01'! hScrollBarValue: scrollValue self hIsScrollbarShowing ifFalse: [^ self]. scroller offset: ((self hLeftoverScrollRange * scrollValue) rounded at scroller offset y) ! ! !ScrollPane methodsFor: 'scrolling' stamp: 'sps 12/24/2002 00:15'! hShowScrollBar self hIsScrollbarShowing ifTrue: [^self]. self hResizeScrollBar. self privateAddMorph: hScrollBar atIndex: 1. "scrollBar changed." retractableScrollBar ifFalse: [self resetExtent]. ! ! !ScrollPane methodsFor: 'scrolling' stamp: 'sps 12/26/2002 23:23'! hideHScrollBarIndefinitely "Get rid of scroll bar for short panes that don't want it shown." self setProperty: #noHScrollBarPlease toValue: true. self hHideScrollBar. ! ! !ScrollPane methodsFor: 'scrolling' stamp: 'sps 12/27/2002 13:59'! hideOrShowScrollBars | wasHShowing wasVShowing | wasVShowing _ self vIsScrollbarShowing. wasHShowing _ self hIsScrollbarShowing. self vHideOrShowScrollBar; hHideOrShowScrollBar; resizeScrollBars. (wasVShowing and: [self vIsScrollbarShowing not]) ifTrue:[ "Make sure the delta is 0" (scroller offset y == 0) ifFalse:[ scroller offset: (scroller offset x at 0) ] ]. (wasHShowing and: [self hIsScrollbarShowing not]) ifTrue:[ (scroller offset x = 0) ifFalse:[ scroller offset: (0 at scroller offset y)] ].! ! !ScrollPane methodsFor: 'scrolling' stamp: 'sps 12/25/2002 16:30'! hideScrollBars self vHideScrollBar; hHideScrollBar ! ! !ScrollPane methodsFor: 'scrolling' stamp: 'sps 12/26/2002 23:23'! hideScrollBarsIndefinitely "Get rid of scroll bar for short panes that don't want it shown." self setProperty: #noHScrollBarPlease toValue: true. self setProperty: #noVScrollBarPlease toValue: true. self hideScrollBars. ! ! !ScrollPane methodsFor: 'scrolling' stamp: 'sps 12/26/2002 23:24'! hideVScrollBarIndefinitely "Get rid of scroll bar for short panes that don't want it shown." self setProperty: #noVScrollBarPlease toValue: true. self vHideScrollBar. ! ! !ScrollPane methodsFor: 'scrolling' stamp: 'sps 12/25/2002 14:38'! isAScrollbarShowing "Return true if a either retractable scroll bar is currently showing" retractableScrollBar ifFalse:[^true]. ^self hIsScrollbarShowing or: [self vIsScrollbarShowing] ! ! !ScrollPane methodsFor: 'scrolling' stamp: 'dew 5/22/2000 15:17'! isScrolledFromTop "Have the contents of the pane been scrolled, so that the top of the contents are not visible?" ^scroller offset y > 0 ! ! !ScrollPane methodsFor: 'scrolling' stamp: 'sps 12/26/2002 23:15'! scrollBy: delta "Move the contents in the direction delta." | newYoffset r newXoffset | "Set the offset on the scroller" newYoffset _ scroller offset y - delta y max: 0. newXoffset _ scroller offset x - delta x max: -3. scroller offset: newXoffset@ newYoffset. "Update the scrollBars" (r _ self vLeftoverScrollRange) = 0 ifTrue: [scrollBar value: 0.0] ifFalse: [scrollBar value: newYoffset asFloat / r]. (r _ self hLeftoverScrollRange) = 0 ifTrue: [hScrollBar value: 0.0] ifFalse: [hScrollBar value: newXoffset asFloat / r] ! ! !ScrollPane methodsFor: 'scrolling' stamp: 'sps 12/25/2002 16:35'! showScrollBars self vShowScrollBar; hShowScrollBar ! ! !ScrollPane methodsFor: 'scrolling' stamp: 'sps 12/25/2002 16:31'! vHideOrShowScrollBar self vIsScrollbarNeeded ifTrue:[ self vShowScrollBar ] ifFalse:[ self vHideScrollBar ]. ! ! !ScrollPane methodsFor: 'scrolling' stamp: 'sps 12/25/2002 14:34'! vHideScrollBar (submorphs includes: scrollBar) ifFalse: [^self]. self privateRemoveMorph: scrollBar. scrollBar privateOwner: nil. retractableScrollBar ifFalse: [self resetExtent]. ! ! !ScrollPane methodsFor: 'scrolling' stamp: 'sps 12/25/2002 16:35'! vIsScrollable "Return whether the verticle scrollbar is scrollable" "(Preferences valueOfFlag: #hiddenScrollBars) ifFalse: [^ true]." "If the contents of the pane are too small to scroll, return false." ^ self vLeftoverScrollRange > 0 "treat a single line as non-scrollable" and: [self vTotalScrollRange > (self scrollDeltaHeight * 3/2)] ! ! !ScrollPane methodsFor: 'scrolling' stamp: 'sps 12/28/2002 01:27'! vIsScrollbarShowing "Return true if a retractable scroll bar is currently showing" ^submorphs includes: scrollBar ! ! !ScrollPane methodsFor: 'scrolling' stamp: 'sps 12/25/2002 14:25'! vIsScrolled "If the scroller is not set to y = 0, then the pane has been scrolled." ^scroller offset y > 0 ! ! !ScrollPane methodsFor: 'scrolling' stamp: 'sps 12/25/2002 16:32'! vScrollBarValue: scrollValue scroller hasSubmorphs ifFalse: [^ self]. scroller offset: (scroller offset x @ (self vLeftoverScrollRange * scrollValue) rounded) ! ! !ScrollPane methodsFor: 'scrolling' stamp: 'sps 12/25/2002 16:34'! vShowScrollBar (submorphs includes: scrollBar) ifTrue: [^ self]. self vResizeScrollBar. self privateAddMorph: scrollBar atIndex: 1. "scrollBar changed." retractableScrollBar ifFalse: [self resetExtent] ! ! !PluggableListMorph methodsFor: 'initialization' stamp: 'sps 12/26/2002 13:34'! list: listOfStrings "Set the receiver's list as specified" | morphList h loc index converter item aSelector | scroller removeAllMorphs. list _ listOfStrings ifNil: [Array new]. list isEmpty ifTrue: [self setScrollDeltas. ^ self selectedMorph: nil]. "NOTE: we will want a quick StringMorph init message, possibly even combined with event install and positioning" font ifNil: [font _ Preferences standardListFont]. converter _ self valueOfProperty: #itemConversionMethod. converter ifNil: [converter _ #asStringOrText]. morphList _ list collect: [:each | item _ each. item _ item perform: converter. item isText ifTrue: [StringMorph contents: item font: font emphasis: (item emphasisAt: 1)] ifFalse: [StringMorph contents: item font: font]]. (aSelector _ self valueOfProperty: #balloonTextSelectorForSubMorphs) ifNotNil: [morphList do: [:m | m balloonTextSelector: aSelector]]. self highlightSelector ifNotNil: [model perform: self highlightSelector with: list with: morphList]. "Lay items out vertically and install them in the scroller" h _ morphList first height "self listItemHeight". loc _ 0 at 0. "Don't call #bounds: and #addAllMorphs, which do a lot of redundant or unneeded layout and updating. Replace those calls with privateBounds: and #quickAddAllMorphs morphList do: [:m | m bounds: (loc extent: 9999 at h). loc _ loc + (0 at h)]. scroller addAllMorphs: morphList." morphList do: [:m | m privateBounds: (loc extent: 9999 at h). loc _ loc + (0 at h)]. scroller quickAddAllMorphs: morphList. index _ self getCurrentSelectionIndex. self selectedMorph: ((index = 0 or: [index > morphList size]) ifTrue: [nil] ifFalse: [morphList at: index]). self setScrollDeltas. scrollBar setValue: 0.0 ! ! !PluggableListMorph methodsFor: 'scrolling' stamp: 'sps 12/24/2002 18:31'! hExtraScrollRange "Return the amount of extra blank space to include to the right of the scroll content." ^5 ! ! !PluggableListMorph methodsFor: 'scrolling' stamp: 'sps 12/26/2002 15:03'! hUnadjustedScrollRange "Return the width of the widest item in the list" | max stringW count | max _ 0. count _ 0. scroller submorphsDo: [ :each | stringW _ each font widthOfString: each contents. max _ max max: stringW. "NOTE: need to optimize this method by caching those list item morph widths. For now, just punt on really long lists" ((count _ count + 1) > 300) ifTrue:[ ^max * 2]. ]. ^max ! ! !PluggableListMorph methodsFor: 'scrolling' stamp: 'sps 12/26/2002 13:36'! vUnadjustedScrollRange "Return the height extent of the receiver's submorphs." (scroller submorphs size > 0) ifFalse:[ ^0 ]. ^(scroller submorphs last fullBounds bottom) ! ! !PluggableMultiColumnListMorph methodsFor: 'scrolling' stamp: 'sps 12/25/2002 01:47'! hUnadjustedScrollRange "Return the width of the widest item in the list" | max stringW | max _ 0. scroller submorphsDo: [ :each | stringW _ each font widthOfString: each contents. max _ max max: (each bounds left + stringW). ]. ^max ! ! !PluggableTextMorph methodsFor: 'scrolling' stamp: 'sps 12/24/2002 18:30'! hUnadjustedScrollRange "Return the width of the widest item in the list" textMorph ifNil: [ ^0 ]. textMorph isWrapped ifTrue:[ ^0 ]. ^super hUnadjustedScrollRange ! ! !ScrollPane class methodsFor: 'as yet unclassified' stamp: 'di 2/21/98 11:02'! includeInNewMorphMenu "OK to instantiate" ^ true! ! !SimpleHierarchicalListMorph methodsFor: 'scrolling' stamp: 'sps 12/24/2002 18:31'! hExtraScrollRange "Return the amount of extra blank space to include below the bottom of the scroll content." ^5 ! ! !SimpleHierarchicalListMorph methodsFor: 'scrolling' stamp: 'sps 12/26/2002 14:17'! hUnadjustedScrollRange "Return the width of the widest item in the list" | max right stringW count | max _ 0. count _ 0. scroller submorphsDo: [ :each | stringW _ each font widthOfString: each contents. right _ (each toggleRectangle right + stringW + 10). max _ max max: right. "NOTE: need to optimize this method by caching list item morph widths (can init that cache most efficiently in the #list: method before the item widths are reset to 9999). For now, just punt on really long lists" ((count _ count + 1) > 200) ifTrue:[ ^max * 3]. ]. ^max ! ! !SimpleHierarchicalListMorph methodsFor: 'scrolling' stamp: 'sps 12/26/2002 13:37'! vUnadjustedScrollRange "Return the width of the widest item in the list" (scroller submorphs size > 0) ifFalse:[ ^0 ]. ^scroller submorphs last fullBounds bottom ! ! !TransformMorph methodsFor: 'accessing' stamp: 'sps 12/28/2002 02:09'! quickAddAllMorphs: aCollection "A fast add of all the morphs for the PluggableListMorph>>list: method to use -- assumes that fullBounds will get called later by the sender, so it avoids doing any updating on the morphs in aCol or updating layout of this scroller. So the sender should handle those tasks as appropriate" | myWorld itsWorld | myWorld _ self world. aCollection do: [:m | m owner ifNotNil: [ itsWorld _ m world. itsWorld == myWorld ifFalse: [m outOfWorld: itsWorld]. m owner privateRemoveMorph: m]. m privateOwner: self. "inWorld ifTrue: [self addedOrRemovedSubmorph: m]." itsWorld == myWorld ifFalse: [m intoWorld: myWorld]. ]. submorphs _ aCollection. "self layoutChanged." ! ! ScrollPane removeSelector: #hInitScrollBar! ComponentLikeModel subclass: #ScrollPane instanceVariableNames: 'scrollBar hScrollBar scroller retractableScrollBar scrollBarOnLeft getMenuSelector getMenuTitleSelector scrollBarHidden hasFocus ' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Windows'! !ScrollPane reorganize! ('initialization' initialize) ('access' adoptPaneColor: flatColoredScrollBarLook hasFocus retractableOrNot retractableScrollBar scrollBarOnLeft scroller scroller: wantsSlot) ('geometry' containsPoint: extent: hExtraScrollRange hIsScrollbarNeeded hLeftoverScrollRange hResizeScrollBar hScrollBarWidth hSetScrollDelta hTotalScrollRange hUnadjustedScrollRange innerBounds resetExtent resizeScrollBars resizeScroller scrollBarFills: scrollBarThickness scrollDeltaHeight scrollDeltaWidth setScrollDeltas vExtraScrollRange vIsScrollbarNeeded vLeftoverScrollRange vResizeScrollBar vScrollBarHeight vSetScrollDelta vTotalScrollRange vUnadjustedScrollRange) ('pane events' handlesMouseDown: handlesMouseOver: keyStroke: mouseDown: mouseEnter: mouseLeave: mouseMove: mouseUp: scrollByKeyboard:) ('scroll bar events' hScrollBarMenuButtonPressed: scrollBarMenuButtonPressed: shiftedTextPaneMenuRequest shiftedYellowButtonActivity unshiftedYellowButtonActivity vScrollBarMenuButtonPressed: yellowButtonActivity:) ('menu' addCustomMenuItems:hand: getMenu: leftOrRight menuTitleSelector: retractable: scrollBarOnLeft:) ('OBSOLETE METHODS' extraScrollRange hideOrShowScrollBar hideScrollBar hideScrollBarIndefinitely isScrollable isScrollbarShowing isScrolled leftoverScrollRange resizeScrollBar scrollBarValue: scrollbarWidth showScrollBar totalScrollRange unadjustedScrollRange) ('HSCROLL TODO' isRetractableScrollbarShowing) ('scrolling' hHideOrShowScrollBar hHideScrollBar hIsScrollable hIsScrollbarShowing hIsScrolled hScrollBarValue: hShowScrollBar hideHScrollBarIndefinitely hideOrShowScrollBars hideScrollBars hideScrollBarsIndefinitely hideVScrollBarIndefinitely isAScrollbarShowing isScrolledFromTop scrollBy: showScrollBars vHideOrShowScrollBar vHideScrollBar vIsScrollable vIsScrollbarShowing vIsScrolled vScrollBarValue: vShowScrollBar) ! "Postscript: Add a tmp method to scrollpane for initializing hScrollBars in existing ScrollPanes, then add the hScrollBar to any open ScrollPane's, then delete the tmp method." ScrollPane compile: 'hInitScrollBar "Temporary method for filein of changeset" hScrollBar := ScrollBar new model: self slotName: ''hScrollBar''. hScrollBar borderWidth: 1; borderColor: Color black. self resizeScrollBars; setScrollDeltas; hideOrShowScrollBars.' classified: 'initialization'. Cursor wait showWhile: [ ScrollPane withAllSubclassesDo: [:cls | cls allInstancesDo: [ :i | i hInitScrollBar ] ]]. ScrollPane removeSelector: #hInitScrollBar. !
More information about the Squeak-dev mailing list |