'From Squeak 2.3 of January 14, 1999 on 20 April 1999 at 3:12:18 pm'! "Change Set: ReleaseTweaks-di Date: 20 April 1999 Author: Dan Ingalls A few fixes and features added late in the process of releasing 2.4. "! Object subclass: #DocLibrary instanceVariableNames: 'group lastUpdate lastUpdateName methodVersions ' classVariableNames: 'DocsCachePath DropBox External ' poolDictionaries: '' category: 'Interface-Changes'! !PopUpMenu methodsFor: 'basic control sequence' stamp: 'di 4/20/1999 14:35'! startUpSegmented: segmentHeight withCaption: captionOrNil at: location "This menu is too big to fit comfortably on the screen. Break it up into smaller chunks, and manage the relative indices. Inspired by a special-case solution by Reinier van Loon." " (PopUpMenu labels: (String streamContents: [:s | 1 to: 100 do: [:i | s print: i; cr]. s skip: -1]) lines: (5 to: 100 by: 5)) startUpWithCaption: 'Give it a whirl...'. " | nLines nLinesPer allLabels from to subset subLines index | nLines _ (self frameHeight - 4) // MenuStyle lineGrid. allLabels := labelString findTokens: Character cr asString. lineArray ifNil: [lineArray _ Array new]. nLinesPer _ segmentHeight // MenuStyle lineGrid - 3. from := 1. [ true ] whileTrue: [to := (from + nLinesPer) min: nLines. subset := allLabels copyFrom: from to: to. subset add: (to = nLines ifTrue: ['start over...'] ifFalse: ['more...']) before: subset first. subLines _ lineArray select: [:n | n >= from] thenCollect: [:n | n - (from-1) + 1]. subLines _ (Array with: 1) , subLines. index := (PopUpMenu labels: subset asStringWithCr lines: subLines) startUpWithCaption: captionOrNil at: location. index = 1 ifTrue: [from := to + 1. from > nLines ifTrue: [ from := 1 ]] ifFalse: [index = 0 ifTrue: [^ 0]. ^ from + index - 2]]! ! !PopUpMenu methodsFor: 'accessing' stamp: 'di 4/20/1999 14:33'! frameHeight "Designed to avoid the entire frame computation (includes MVC form), since the menu may well end up being displayed in Morphic anyway." | nItems | frame ifNotNil: [^ frame height]. nItems _ 1 + (labelString occurrencesOf: Character cr). ^ (nItems * MenuStyle lineGrid) + 4 "border width"! ! !Project methodsFor: 'release' stamp: 'di 4/20/1999 12:13'! okToChange | ok hasSubProjects | hasSubProjects _ world isMorph ifTrue: [(world submorphs select: [:m | (m isKindOf: SystemWindow) and: [m model isKindOf: Project]]) size > 0] ifFalse: [(world controllerWhoseModelSatisfies: [:m | m isKindOf: Project]) notNil]. hasSubProjects ifTrue: [PopUpMenu notify: 'The project ', self name printString, ' contains sub-projects. You must remove these explicitly before removing their parent.'. ^ false]. ok _ (world isMorph not and: [world scheduledControllers size <= 1]) or: [self confirm: 'Really delete the project ', self name printString, ' and all its windows?']. ok ifFalse: [^ false]. "about to delete this project; clear previous links to it from other Projects:" Project allInstancesDo: [:p | p deletingProject: self]. ProjectViewMorph allInstancesDo: [:p | p deletingProject: self]. world isMorph "special release for wonderlands" ifTrue: [world submorphs do: [:m | (m isKindOf: WonderlandCameraMorph) and: [m getWonderland release]]]. ^ true ! ! !SystemDictionary methodsFor: 'shrinking' stamp: 'di 4/20/1999 12:24'! unusedClasses "Warning: Slow!! Enumerates all classes in the system and returns a list of those that are apparently unused. A class is considered in use if it (a) has subclasses (b) has instances or (c) is referred to by some method. Obsolete classes are not included in this list." "Smalltalk unusedClasses" | unused c n | unused _ SortedCollection new. 'Scanning for unused classes...' displayProgressAt: Sensor cursorPoint from: 0 to: Metaclass instanceCount during: [:bar | n _ 0. Metaclass allInstancesDo: [:meta | bar value: (n _ n+1). c _ meta soleInstance. ((c ~~ nil) and: [('AnOb*' match: c name asString) not]) ifTrue: [ ((c subclasses size = 0) and: [(c inheritsFrom: FileDirectory) not & (c instanceCount = 0) and: [(Smalltalk includesKey: c name) and: [(Smalltalk allCallsOn: (Smalltalk associationAt: c name)) size = 0]]]) ifTrue: [unused add: c name]]]]. ^ unused asArray ! ! !TextURL methodsFor: 'as yet unclassified' stamp: 'mjg 4/20/1999 12:40'! actOnClickFor: anObject "Do what you can with this URL. Later a web browser." | response m browser | "if it's a web browser, tell it to jump" (anObject isWebBrowser) ifTrue: [anObject jumpToUrl: url. ^true] ifFalse: [anObject model isWebBrowser ifTrue: [anObject model jumpToUrl: url. ^true]]. "if it's a morph, see if it is contained in a web browser" (anObject isKindOf: Morph) ifTrue: [ m _ anObject. [ m ~= nil ] whileTrue: [ (m isWebBrowser) ifTrue: [ m jumpToUrl: url. ^true ]. (m hasProperty: #webBrowserView) ifTrue: [ m model jumpToUrl: url. ^true ]. m _ m owner. ] ]. "no browser in sight. ask if we should start a new browser" (self confirm: 'open a browser to view this URL?') ifTrue: [ browser _ Scamper new. browser jumpToUrl: url. browser openAsMorph. ^ true ]. "couldn't display in a browser. Offer to put up just the source" response _ (PopUpMenu labels: 'View web page as source\Cancel' withCRs) startUpWithCaption: 'Couldn''t find a web browser. View page as source?'. response = 1 ifTrue: [HTTPSocket httpShowPage: url]. ^ true! ! !Wonderland class methodsFor: 'instance creation' stamp: 'di 4/20/1999 12:03'! new "Wonderland new" "Create and initialize a new Wonderland." B3DPrimitiveEngine isAvailable ifFalse: [ (self confirm: 'WARNING: This Squeak does not have real 3D support. Opening a Wonderland will EXTREMELY time consuming. Are you sure you want to do this? (NO is probably the right answer :-)') ifFalse: [^ self]]. Display depth < 8 ifTrue: [(self confirm: 'The display depth should be set to at least 8 bit. Shall I do this now for you?') ifTrue: [Display newDepth: 8]]. ^ super new initialize ! !