Squeak 4.6: 46Deprecated-dtl.4.mcz

Chris Muller uploaded a new version of 46Deprecated to project Squeak 4.6:
http://source.squeak.org/squeak46/46Deprecated-dtl.4.mcz

==================== Summary ====================

Name: 46Deprecated-dtl.4
Author: dtl
Time: 30 May 2015, 6:14:05.154 pm
UUID: 69e9c6e3-c82e-445b-b82d-adc42cacb06b
Ancestors: 46Deprecated-mt.3

Provide an implementation of MCMcmUpdater class>>useLatestPackagesFrom: because an older image may be referencing it while trying to update itself from a block in the earler class side implementation, in which case we should delegate to the current default instance of MCMcmUpdater.

==================== Snapshot ====================

SystemOrganization addCategory: #'46Deprecated-Morphic'!

PluggableListMorph subclass: #PluggableMessageCategoryListMorph
        instanceVariableNames: 'getRawListSelector priorRawList'
        classVariableNames: ''
        poolDictionaries: ''
        category: '46Deprecated-Morphic'!

!PluggableMessageCategoryListMorph commentStamp: '<historical>' prior: 0!
A variant of PluggableListMorph designed specially for efficient handling of the --all-- feature in message-list panes.  In order to be able *quickly* to check whether there has been an external change to the list, we cache the raw list for identity comparison (the actual list is a combination of the --all-- element and the the actual list).!

----- Method: PluggableMessageCategoryListMorph class>>on:list:selected:changeSelected:menu:keystroke:getRawListSelector: (in category 'as yet unclassified') -----
on: anObject list: getListSel selected: getSelectionSel changeSelected: setSelectionSel menu: getMenuSel keystroke: keyActionSel getRawListSelector: getRawSel
        ^ self new on: anObject list: getListSel selected: getSelectionSel changeSelected: setSelectionSel menu: getMenuSel keystroke: keyActionSel getRawListSelector: getRawSel!

----- Method: PluggableMessageCategoryListMorph>>getList (in category 'model access') -----
getList
        "Differs from the generic in that here we obtain and cache the raw list, then cons it together with the special '-- all --' item to produce the list to be used in the browser.  This special handling is done in order to avoid excessive and unnecessary reformulation of the list in the step method"

        getRawListSelector == nil ifTrue: ["should not happen!!" priorRawList := nil.  ^ #()].
        model classListIndex = 0 ifTrue: [^ priorRawList := list := Array new].
        priorRawList := model perform: getRawListSelector.
        list := (Array with: ClassOrganizer allCategory), priorRawList.
        ^list!

----- Method: PluggableMessageCategoryListMorph>>on:list:selected:changeSelected:menu:keystroke:getRawListSelector: (in category 'as yet unclassified') -----
on: anObject list: getListSel selected: getSelectionSel changeSelected: setSelectionSel menu: getMenuSel keystroke: keyActionSel getRawListSelector: getRawSel
        self model: anObject.
        getListSelector := getListSel.
        getIndexSelector := getSelectionSel.
        setIndexSelector := setSelectionSel.
        getMenuSelector := getMenuSel.
        keystrokeActionSelector := keyActionSel.
        autoDeselect := true.
        self borderWidth: 1.
        getRawListSelector := getRawSel.
        self updateList.
        self selectionIndex: self getCurrentSelectionIndex.
        self initForKeystrokes!

----- Method: PluggableMessageCategoryListMorph>>verifyContents (in category 'updating') -----
verifyContents
        | newList existingSelection anIndex newRawList |
        (model editSelection == #editComment) ifTrue: [^ self].
        model classListIndex = 0 ifTrue: [^ self].
        newRawList := model perform: getRawListSelector.
        newRawList == priorRawList ifTrue: [^ self].  "The usual case; very fast"
        priorRawList := newRawList.
        newList := (Array with: ClassOrganizer allCategory), priorRawList.
        list = newList ifTrue: [^ self].
        existingSelection := self selection.
        self updateList.
        (anIndex := newList indexOf: existingSelection ifAbsent: [nil])
                ifNotNil:
                        [model noteSelectionIndex: anIndex for: getListSelector.
                        self selectionIndex: anIndex]
                ifNil:
                        [self changeModelSelection: 0]!

----- Method: MorphicProject>>exportSegmentWithCatagories:classes:fileName:directory: (in category '*46Deprecated') -----
exportSegmentWithCatagories: catList classes: classList fileName: aFileName directory: aDirectory
        "Store my project out on the disk as an *exported* ImageSegment.  All outPointers will be in a form that can be resolved in the target image.  Name it <project name>.extSeg.  What do we do about subProjects, especially if they are out as local image segments?  Force them to come in?
        Player classes are included automatically."

        | is str ans revertSeg roots holder |
        self flag: #toRemove.
        self halt.  "unused"
        "world == World ifTrue: [^ false]."
                "self inform: 'Can''t send the current world out'."
        world ifNil: [^ false].  world presenter ifNil: [^ false].

        ScrapBook default emptyScrapBook.
        world currentHand pasteBuffer: nil.  "don't write the paste buffer."
        world currentHand mouseOverHandler initialize.  "forget about any references here"
                "Display checkCurrentHandForObjectToPaste."
        Command initialize.
        world clearCommandHistory.
        world fullReleaseCachedState; releaseViewers.
        world cleanseStepList.
        world localFlapTabs size = world flapTabs size ifFalse: [
                self error: 'Still holding onto Global flaps'].
        world releaseSqueakPages.
        holder := Project allProjects. "force them in to outPointers, where DiskProxys are made"

        "Just export me, not my previous version"
        revertSeg := self parameterAt: #revertToMe.
        self projectParameters removeKey: #revertToMe ifAbsent: [].

        roots := OrderedCollection new.
        roots add: self; add: world; add: transcript; add: changeSet; add: thumbnail.
        roots add: world activeHand; addAll: classList; addAll: (classList collect: [:cls | cls class]).

        roots := roots reject: [ :x | x isNil]. "early saves may not have active hand or thumbnail"

        catList do: [:sysCat |
                (SystemOrganization listAtCategoryNamed: sysCat asSymbol) do: [:symb |
                        roots add: (Smalltalk at: symb); add: (Smalltalk at: symb) class]].

        is := ImageSegment new copySmartRootsExport: roots asArray.
                "old way was (is := ImageSegment new copyFromRootsForExport: roots asArray)"

        is state = #tooBig ifTrue: [^ false].

        str := ''.
        "considered legal to save a project that has never been entered"
        (is outPointers includes: world) ifTrue: [
                str := str, '\Project''s own world is not in the segment.' withCRs].
        str isEmpty ifFalse: [
                ans := (UIManager default
                                 chooseFrom: #('Do not write file' 'Write file anyway' 'Debug')
                                 title: str).
                ans = 1 ifTrue: [
                        revertSeg ifNotNil: [self projectParameterAt: #revertToMe put: revertSeg].
                        ^ false].
                ans = 3 ifTrue: [self halt: 'Segment not written']].

        is writeForExportWithSources: aFileName inDirectory: aDirectory.
        revertSeg ifNotNil: [self projectParameterAt: #revertToMe put: revertSeg].
        holder.
        world flapTabs do: [:ft |
                        (ft respondsTo: #unhibernate) ifTrue: [ft unhibernate]].
        is arrayOfRoots do: [:obj |
                obj isScriptEditorMorph ifTrue: [obj unhibernate]].
        ^ true
!

----- Method: HierarchyBrowser>>potentialClassNames (in category '*46Deprecated') -----
potentialClassNames
        "Answer the names of all the classes that could be viewed in this browser"
        ^ self classList collect:
                [:aName | aName copyWithout: $ ]!

----- Method: MCMcmUpdater class>>useLatestPackagesFrom: (in category '*46Deprecated') -----
useLatestPackagesFrom: repo
        "For overriding on a per repository basis.
        Implementation is now on the instance side, but is also maintained here because
        an older image may be trying to update to current and may still be evaluating a block
        in its class:>>updateFromRepositoriesMCMcmUpdater that expects thiis method to
        be present. Delegate to the current default instance."

        ^ self default useLatestPackagesFrom: repo
!

----- Method: ScrollPane>>alwaysShowHScrollBar: (in category '*46Deprecated') -----
alwaysShowHScrollBar: bool
        self flag: #deprecated.
        self setProperty: #hScrollBarAlways toValue: bool.

        bool
                ifTrue: [self hScrollBarPolicy: #always]
                ifFalse: [self hScrollBarPolicy: #whenNeeded].
               
        self hHideOrShowScrollBar.
!

----- Method: ScrollPane>>alwaysShowScrollBars: (in category '*46Deprecated') -----
alwaysShowScrollBars: bool
        "Get rid of scroll bar for short panes that don't want it shown."

        self flag: #deprecated.
       
        self
                alwaysShowHScrollBar: bool;
                alwaysShowVScrollBar: bool.
!

----- Method: ScrollPane>>alwaysShowVScrollBar: (in category '*46Deprecated') -----
alwaysShowVScrollBar: bool

        self flag: #deprecated.
       
        self setProperty: #vScrollBarAlways toValue: bool.
       
        bool
                ifTrue: [self vScrollBarPolicy: #always]
                ifFalse: [self vScrollBarPolicy: #whenNeeded].
       
        self vHideOrShowScrollBar.
!

----- Method: ScrollPane>>hInitScrollBarTEMPORARY (in category '*46Deprecated') -----
hInitScrollBarTEMPORARY
"This is called lazily before the hScrollBar is accessed in a couple of places. It is provided to transition old ScrollPanes lying around that do not have an hScrollBar. Once it has been in the image for awhile, and all ScrollPanes have an hScrollBar, this method and it's references can be removed. "

                "Temporary method for filein of changeset"
                hScrollBar ifNil:
                        [hScrollBar := ScrollBar new model: self slotName: 'hScrollBar'.
                        hScrollBar borderWidth: 1; borderColor: Color black.
                        self
                                resizeScrollBars;
                                setScrollDeltas;
                                hideOrShowScrollBars].
!

----- Method: ScrollPane>>hideHScrollBarIndefinitely: (in category '*46Deprecated') -----
hideHScrollBarIndefinitely: bool
        "Get rid of scroll bar for short panes that don't want it shown."

        self flag: #deprecated.
       
        self setProperty: #noHScrollBarPlease toValue: bool.
       
        bool
                ifTrue: [self hScrollBarPolicy: #never]
                ifFalse: [self hScrollBarPolicy: #whenNeeded].
       
        self hHideOrShowScrollBar.
!

----- Method: ScrollPane>>hideScrollBarsIndefinitely: (in category '*46Deprecated') -----
hideScrollBarsIndefinitely: bool
        "Get rid of scroll bar for short panes that don't want it shown."

        self flag: #deprecated.

        self hideVScrollBarIndefinitely: bool.
        self hideHScrollBarIndefinitely: bool.
!

----- Method: ScrollPane>>hideVScrollBarIndefinitely: (in category '*46Deprecated') -----
hideVScrollBarIndefinitely: bool
        "Get rid of scroll bar for short panes that don't want it shown."

        self flag: #deprecated.
       
        self setProperty: #noVScrollBarPlease toValue: bool.
       
        bool
                ifTrue: [self vScrollBarPolicy: #never]
                ifFalse: [self vScrollBarPolicy: #whenNeeded].
       
        self vHideOrShowScrollBar.
!

----- Method: ScrollPane>>isAScrollbarShowing (in category '*46Deprecated') -----
isAScrollbarShowing
        "Return true if a either retractable scroll bar is currently showing"
       
        self flag: #deprectaed. "mt: Use #isAnyScrollbarShowing"
        retractableScrollBar ifFalse:[^true].
        ^self hIsScrollbarShowing or: [self vIsScrollbarShowing]
!

----- Method: ScrollPane>>showHScrollBarOnlyWhenNeeded: (in category '*46Deprecated') -----
showHScrollBarOnlyWhenNeeded: bool
        "Get rid of scroll bar for short panes that don't want it shown."

        self flag: #deprecated.

        self setProperty: #noHScrollBarPlease toValue: bool not.
        self setProperty: #hScrollBarAlways toValue: bool not.
       
        bool
                ifTrue: [self hScrollBarPolicy: #whenNeeded]
                ifFalse: [self hScrollBarPolicy: #never].
       
        self hHideOrShowScrollBar.
!

----- Method: ScrollPane>>showScrollBarsOnlyWhenNeeded: (in category '*46Deprecated') -----
showScrollBarsOnlyWhenNeeded: bool

        self flag: #deprecated.
       
        self showHScrollBarOnlyWhenNeeded: bool.
        self showVScrollBarOnlyWhenNeeded: bool.
!

----- Method: ScrollPane>>showVScrollBarOnlyWhenNeeded: (in category '*46Deprecated') -----
showVScrollBarOnlyWhenNeeded: bool
        "Get rid of scroll bar for short panes that don't want it shown."

        self flag: #deprecated.

        self setProperty: #noVScrollBarPlease toValue: bool not.
        self setProperty: #vScrollBarAlways toValue: bool not.
       
        bool
                ifTrue: [self vScrollBarPolicy: #whenNeeded]
                ifFalse: [self vScrollBarPolicy: #never].
       
        self vHideOrShowScrollBar.
!

TextMorph subclass: #SearchBarMorph
        instanceVariableNames: ''
        classVariableNames: ''
        poolDictionaries: ''
        category: '46Deprecated-Morphic'!

----- Method: SearchBarMorph>>activate: (in category 'search') -----
activate: event

        event hand newKeyboardFocus: self.
        self selectAll!

----- Method: SearchBarMorph>>fillStyle (in category 'initialize') -----
fillStyle

        ^backgroundColor!

----- Method: SearchBarMorph>>initialize (in category 'initialize') -----
initialize

        super initialize.
        text := Text new.
        backgroundColor := TranslucentColor gray alpha: 0.3.
        self width: 200.
        self crAction: (MessageSend receiver: self selector: #smartSearch:).
        self setBalloonText: 'Searches for globals and methods'.!

----- Method: SearchBarMorph>>smartSearch: (in category 'search') -----
smartSearch: evt
        "Take the user input and perform an appropriate search"
        | input newContents |
        input := self contents asString ifEmpty:[^self].
        (Smalltalk bindingOf: input) ifNotNil:[:assoc| | global |
                "It's a global or a class"
                global := assoc value.
                ^ToolSet browse: (global isBehavior ifTrue:[global] ifFalse:[global class]) selector: nil.
        ].
        (SystemNavigation new allImplementorsOf: input asSymbol) ifNotEmpty:[:list|
                ^SystemNavigation new
                        browseMessageList: list
                        name: 'Implementors of ' , input
        ].
        input first isUppercase ifTrue:[
                (UIManager default classFromPattern: input withCaption: '') ifNotNil:[:aClass|
                        ^ToolSet browse: aClass selector: nil.
                ].
        ] ifFalse:[
                ^ToolSet default browseMessageNames: input
        ].
        newContents := input, ' -- not found.'.
        self
                newContents: newContents;
                selectFrom: input size+1 to: newContents size.
        evt hand newKeyboardFocus: self!

----- Method: CodeHolder>>abbreviatedWordingFor: (in category '*46Deprecated') -----
abbreviatedWordingFor: aButtonSelector
        "Answer the abbreviated form of wording, from a static table.  Answer nil if there is no entry -- in which case the long form will be used on the corresponding browser button."

        #(
        (browseMethodFull 'browse')
        (browseSendersOfMessages   'senders')
        (browseMessages 'impl')
        (browseVersions 'vers')
        (methodHierarchy 'inher')
        (classHierarchy 'hier')
        (browseVariableReferences 'refs')
        (offerMenu 'menu')) do:

                [:pair | pair first == aButtonSelector ifTrue: [^ pair second]].
        ^ nil!

----- Method: CodeHolder>>showingDiffsString (in category '*46Deprecated') -----
showingDiffsString
        "Answer a string representing whether I'm showing diffs.  Not sent any more but retained so that prexisting buttons that sent this will not raise errors."

        ^ (self showingRegularDiffs
                ifTrue:
                        ['<yes>']
                ifFalse:
                        ['<no>']), 'showDiffs'!

----- Method: CodeHolder>>toggleDiff (in category '*46Deprecated') -----
toggleDiff
        "Retained for backward compatibility with existing buttons in existing images"

        self toggleDiffing!

----- Method: Browser>>classComment:notifying: (in category '*46Deprecated') -----
classComment: aText notifying: aPluggableTextMorph
        "The user has just entered aText.
        It may be all red (a side-effect of replacing the default comment), so remove the color if it is."

        | theClass cleanedText redRange |
        theClass := self selectedClassOrMetaClass.
        theClass
                ifNotNil: [cleanedText := aText asText.
                        redRange := cleanedText rangeOf: TextColor red startingAt: 1.
                        redRange size = cleanedText size
                                ifTrue: [cleanedText
                                                removeAttribute: TextColor red
                                                from: 1
                                                to: redRange last ].
                        theClass comment: aText stamp: Utilities changeStamp].
        self changed: #classCommentText.
        ^ true!

----- Method: Browser>>defineMessage:notifying: (in category '*46Deprecated') -----
defineMessage: aString notifying: aController
        self deprecated: 'Use Browser >> #defineMessageFrom:notifying:. This returns a Symbol or nil, not a Boolean.'.
        ^ (self defineMessageFrom: aString notifying: aController) notNil.!

----- Method: Browser>>messageListSingleton (in category '*46Deprecated') -----
messageListSingleton

        | name |
        name := self selectedMessageName.
        ^ name ifNil: [Array new]
                ifNotNil: [Array with: name]!

----- Method: Browser>>optionalAnnotationHeight (in category '*46Deprecated') -----
optionalAnnotationHeight

        ^ 10!

----- Method: Browser>>optionalButtonHeight (in category '*46Deprecated') -----
optionalButtonHeight

        ^ 10!

----- Method: Browser>>potentialClassNames (in category '*46Deprecated') -----
potentialClassNames
        "Answer the names of all the classes that could be viewed in this browser.  This hook is provided so that HierarchyBrowsers can indicate their restricted subset.  For generic Browsers, the entire list of classes known to Smalltalk is provided, though of course that really only is accurate in the case of full system browsers."

        ^ Smalltalk classNames!