'From Squeak 2.3 of January 14, 1999 on 27 February 1999 at 8:30:30 pm'! "Change Set: AbsScrollPref Date: 27 February 1999 Author: Doug Way and Marcel Weiher This adds a feature to Morphic scrollbars so that if you alt-click in the scroll area the scrollbar jumps to that absolute spot (like the MVC scrollbar does). Plus, it adds a preference to optionally make this the default plain-click behavior. It currently causes some side effects to the page-up/ page-down behavior, though."! !Preferences class methodsFor: 'initialization' stamp: 'MPW 1/1/1901 01:33'! chooseInitialSettings "Restore the default choices for Preferences." "Preferences chooseInitialSettings" #( (allowSysWindowEmbedding false) (browseWithPrettyPrint false) (cmdDotEnabled true) (confirmFirstUseOfStyle true) (disableSounds false) (fastDragWindowForMorphic false) (ignoreStyleIfOnlyBold true) (inboardScrollbars false) (logDebuggerStackToFile true) (noviceMode false) (printAlternateSyntax false) (reverseWindowStagger true) (scrollAbsolute false) (showDebugHaloHandle true) (showScriptSource false) (showTimeStampsInMenuTitles false) (showProjectZoom false) (suppressCheckForSlips false) (suppressUpdateServerPrompt false) (thoroughSenders true) (unlimitedPaintArea false) (updateSavesFile false) (warnIfNoChangesFile true) (warnIfNoSourcesFile true)) do: [:aPair | aPair last == #true ifTrue: [self enable: aPair first] ifFalse: [self disable: aPair first]] ! ! !Preferences class methodsFor: 'initialization' stamp: 'MPW 1/1/1901 01:32'! initializeHelpMessages "Preferences initializeHelpMessages" HelpDictionary _ Dictionary new. #( (allowSysWindowEmbedding 'Determines whether, in Morphic, SystemWindows should automatically be droppable into willing receptors') (browseWithPrettyPrint 'If true, browsers will automatically format their contents') (cautionBeforeClosing 'If true, Morphic windows seen in an mvc project will put up a warning before allowing themselves to be dismissed') (cmdDotEnabled 'If true, cmd-dot brings up a debugger; if false, the cmd-dot interrupt is disabled') (confirmFirstUseOfStyle 'If true, the first attempt to submit a method with non-standard style will bring up a confirmation dialog') (disableSounds 'If true, all sound playing is disabled') (editPlayerScriptsInPlace 'If true, textual player scripts are edited in place in Scriptors (still imperfectly implemented)') (eToyScheme 'If true, new scripting spaces place the Playfield to the left and the the palette to the right of the window; if false, the opposite is true.') (fastDragWindowForMorphic 'If true, morphic window drag will be done by dragging an outline of the window.') (ignoreStyleIfOnlyBold 'If true, then any method submission in which the only style change is for bolding will be treated as a method with no style specifications') (inboardScrollbars 'If true, then ScrollPane will place scrollbars inside on the right and will not hide them on exit') (logDebuggerStackToFile 'If true, whenever you fall into a debugger a summary of its stack will be written to a file named ''SqueakDebug.log''') (noviceMode 'If true, certain novice-mode accommodations are made.') (printAlternateSyntax 'If true, then prettyPrint using experimental syntax. Otherwise use normal ST-80 syntax.') (reverseWindowStagger 'If true, a reverse-stagger strategy is used for determining where newly launched windows will be placed; if false, a direct- stagger strategy is used.') (scrollAbsolute 'If true, clicking in a scroll-bar will directly move to that position instead of paging, with for the paging behavior. The reverse is true for false.') (showDebugHaloHandle 'If true, a special debugging halo handle is displayed at the right of the halo; if false, no such handle is shown.') (showPlayerSource 'If true, then all Player methods with fewer than 2 arguments are included in Viewers, whether or not they are intended for end-user use. This can be dangerous') (showProjectZoom 'If true, then show a zoom effect when entering or leaving projects. This can be costly of memory (at least an extra screen buffer) so dont use it in low space situations. But it is cool.') (showScriptSource 'If true, then the actual Smalltalk source code for methods is shown in the detail panes for scripts in a viewer; if false, then a help message for scripts is shown instead.') (showTimeStampsInMenuTitles 'If true, then the author''s timestamp is displayed as the menu title of any message list; if false, no author''s timestamps are shown') (suppressCheckForSlips 'If false, then whenever you file out a change set, it is checked for ''slips'' and if any are found, you are so informed and given a chance to open a browser on them') (suppressUpdateServerPrompt 'If true, the prompt for server choice when updating code from the server is suppressed. Set this to true to leave the server choice unchanged from update to update.') (thoroughSenders 'If true, then ''senders'' browsers will dive inside structured literals in their search') (uniformWindowColors 'If true, then all standard windows are given the same color rather than their customized window-type-specific colors') (unlimitedPaintArea 'If true, the painting area for a new drawing will not be limited in size; if false, a reasonable limit will be applied, in an attempt to hold down memory and time price.') (updateRemoveSequenceNum 'If true, then remove the leading sequence number from the filename before automatically saving a local copy of any update loaded.') (updateSavesFile 'If true, then when an update is loaded from the server, a copy of it will automatically be saved on a local file as well.') (useNewViewers 'If true, then the new kinds of viewers introduced in Squeak 2.3 are used; if false, then the old style, from earlier releases, are still used. Old viewers will hopefully soon be removed from the system.') (warnIfNoChangesFile 'If true, then you will be warned, whenever you start up, if no changes file can be found') (warnIfNoSourcesFile 'If true, then you will be warned, whenever you start up, if no sources file can be found')) do: [:pair | HelpDictionary at: pair first put: (pair first, ': ', pair last)] ! ! !Slider methodsFor: 'geometry' stamp: 'MPW 1/1/1901 23:01'! valueForEvent:event ^self valueForPoint:event cursorPoint. ! ! !Slider methodsFor: 'geometry' stamp: 'MPW 1/1/1901 23:06'! valueForPoint:aPoint | p r | r _ self roomToMove. bounds isWide ifTrue: [r width = 0 ifTrue: [^0]] ifFalse: [r height = 0 ifTrue: [^0]]. p _ (aPoint - ( self sliderExtent / 2)) rounded adhereTo:r. ^bounds isWide ifTrue: [(p x - r left) asFloat / r width] ifFalse: [(p y - r top) asFloat / r height].! ! !Slider methodsFor: 'scrolling' stamp: 'MPW 1/1/1901 23:07'! scrollAbsolute: event self setValue:(self valueForEvent:event).! ! !ScrollBar methodsFor: 'initialize' stamp: 'MPW 1/1/1901 01:07'! initializePagingArea pagingArea := RectangleMorph newBounds: self totalSliderArea color: (Color r: 0.6 g: 0.6 b: 0.8). pagingArea borderWidth: 0. pagingArea on: #mouseDown send: #scrollAbsoluteOrRelative: to: self. pagingArea on: #mouseStillDown send: #scrollStillAbsolute: to: self. self addMorph: pagingArea! ! !ScrollBar methodsFor: 'scrolling' stamp: 'MPW 1/1/1901 23:07'! nextPage: event "Note: this method is no longer called, except by old scrollBars" (self waitForDelay1: 300 delay2: 100) ifFalse: [^ self]. event cursorPoint y >= slider center y ifTrue: [self setValue: (value + pageDelta min: (self valueForEvent:event))] ifFalse: [self setValue: (value - pageDelta max: (self valueForEvent:event))] ! ! !ScrollBar methodsFor: 'scrolling' stamp: 'MPW 1/1/1901 01:10'! scrollAbsoluteOrRelative:event (self shouldScrollAbsoluteWithEvent:event) ifTrue: [self scrollAbsolute:event] ifFalse: [self nextPage:event] ! ! !ScrollBar methodsFor: 'scrolling' stamp: 'MPW 1/1/1901 22:40'! scrollStillAbsolute:event (self shouldScrollAbsoluteWithEvent:event) ifTrue: [self scrollAbsolute:event] ifFalse: [self nextPage:event] ! ! !ScrollBar methodsFor: 'scrolling' stamp: 'dew 2/23/1999 02:07'! shouldScrollAbsoluteWithEvent:event " yellow button is on Mac" ^((event yellowButtonPressed) xor: Preferences scrollAbsolute). ! !