[squeak-dev] Squeak 6.0: 60Deprecated-ct.114.mcz
commits at source.squeak.org
commits at source.squeak.org
Wed May 18 12:12:44 UTC 2022
Marcel Taeumel uploaded a new version of 60Deprecated to project Squeak 6.0:
http://source.squeak.org/squeak60/60Deprecated-ct.114.mcz
==================== Summary ====================
Name: 60Deprecated-ct.114
Author: ct
Time: 5 May 2022, 7:08:29.764219 pm
UUID: 0c6ec5c2-197e-2b43-844c-167ee867a0e3
Ancestors: 60Deprecated-ct.113
Complements Tools-ct.1150 (merges toolCodePane.3.cs, improved MVC compatibility for view accesses from model).
==================== Snapshot ====================
SystemOrganization addCategory: #'60Deprecated-Collections-Streams'!
SystemOrganization addCategory: #'60Deprecated-Compiler-Support'!
SystemOrganization addCategory: #'60Deprecated-Etoys-Squeakland-System-Support'!
SystemOrganization addCategory: #'60Deprecated-HelpSystem-Core-Model'!
SystemOrganization addCategory: #'60Deprecated-Kernel-Methods'!
SystemOrganization addCategory: #'60Deprecated-Kernel-Numbers-Exceptions'!
SystemOrganization addCategory: #'60Deprecated-Morphic-Events'!
SystemOrganization addCategory: #'60Deprecated-Morphic-Widgets'!
SystemOrganization addCategory: #'60Deprecated-NSPlugin-System-Support'!
SystemOrganization addCategory: #'60Deprecated-System-Support'!
SystemOrganization addCategory: #'60Deprecated-Tools-Inspector'!
SystemOrganization addCategory: #'60Deprecated-Tools-Menus'!
SystemOrganization addCategory: #'60Deprecated-TrueType-Fonts'!
----- Method: ComplexBorder>>widthForRounding (in category '*60Deprecated-accessing') -----
widthForRounding
self deprecated: 'See BalloonCanvas for drawing rounded corners.'.
^0!
----- Method: Integer>>destinationBuffer: (in category '*60Deprecated-Kernel-Methods') -----
destinationBuffer:digitLength
digitLength <= 1
ifTrue: [self]
ifFalse: [LargePositiveInteger new: digitLength].!
----- Method: Symbol class>>findInterned: (in category '*60Deprecated-instance creation') -----
findInterned:aString
self flag: #deprecated. "use lookup: instead, they are synonym"
^self lookup: aString!
----- Method: Symbol class>>internCharacter: (in category '*60Deprecated-instance creation') -----
internCharacter: aCharacter
self deprecated: 'Use #intern: instead. There is no special table for one-character symbols anymore'.
^ self intern: aCharacter asString!
----- Method: SystemVersion class>>check:andRequestPluginUpdate: (in category '*60Deprecated-testing method dictionary') -----
check: pluginVersion andRequestPluginUpdate: updateURL
"SystemVersion check: 'zzz' andRequestPluginUpdate: 'http://www.squeakland.org/installers/update.html' "
self deprecated.
"We don't have a decent versioning scheme yet, so we are basically checking for a nil VM version on the mac."
(self pluginVersion: pluginVersion newerThan: self currentPluginVersion)
ifFalse: [^true].
(self confirm: 'There is a newer plugin version available. Do you want to install it now?')
ifFalse: [^false].
HTTPClient
requestURL: updateURL , (Smalltalk platformName copyWithout: Character space) asLowercase , '.html'
target: '_top'.
^false!
----- Method: PluggableListMorph>>handleBasicKeys: (in category '*60Deprecated-events') -----
handleBasicKeys: aBoolean
"set whether the list morph should handle basic keys like arrow keys, or whether everything should be passed to the model"
self deprecated.
self handlesBasicKeys: aBoolean.!
----- Method: PluggableListMorph>>list: (in category '*60Deprecated-initialization') -----
list: listOfStrings
self deprecated: 'Use a model instead. See #getFullList.'.!
----- Method: PluggableListMorph>>textHighlightColor (in category '*60Deprecated-initialization') -----
textHighlightColor
"Answer my default text highlight color."
self deprecated: 'See user-interface theme for color information.'.
^ self userInterfaceTheme textHighlightColor ifNil: [TranslucentColor r: 0.0 g: 0.0 b: 0.8 alpha: 0.2]!
----- Method: PluggableListMorph>>textHighlightColor: (in category '*60Deprecated-initialization') -----
textHighlightColor: aColor
"Set my default text highlight color."
self deprecated: 'See user-interface theme for color information.'.
self userInterfaceTheme textHighlightColor: aColor.!
----- Method: TheWorldMainDockingBar>>openHelp:topic:styled: (in category '*60Deprecated-help') -----
openHelp: bookSymbol topic: topicSymbol styled: boolean
self deprecated: 'Styling is configured at the level of help topics. Browse implementors of #usesCodeStyling.'.
^ self openHelp: bookSymbol topic: topicSymbol!
----- Method: SugarLauncher class>>welcomeProjectName (in category '*60Deprecated-accessing') -----
welcomeProjectName
"Deprecated"
^Project home ifNotNil: [:p | p name]!
----- Method: MessageTally>>sonsOver: (in category '*60Deprecated-comparing') -----
sonsOver: threshold
self deprecated: 'Use #childrenOver: instead.'.
^ self childrenOver: threshold!
----- Method: ToolSet class>>debug:context:label:contents:fullView: (in category '*60Deprecated-debugging') -----
debug: aProcess context: aContext label: aString contents: contents fullView: aBool
self deprecated.
^ self debugProcess: aProcess context: aContext label: aString contents: contents fullView: aBool!
----- Method: ToolSet class>>debugActiveProcessContext:label:contents: (in category '*60Deprecated-debugging') -----
debugActiveProcessContext: aContext label: aString contents: contents
self deprecated.
^ self
debugProcess: Processor activeProcess
context: aContext
label: aString
contents: contents
fullView: false!
----- Method: ToolSet class>>debugContext:label:contents: (in category '*60Deprecated-debugging') -----
debugContext: aContext label: aString contents: contents
self deprecated: 'ct: Use Processor >> #debugContext:... instead'.
^ Processor
debugContext: aContext
title: aString
full: false
contents: contents!
----- Method: ToolSet class>>debugError: (in category '*60Deprecated-debugging') -----
debugError: anUnhandledError
self deprecated.
^ self handleError: anUnhandledError!
----- Method: ToolSet class>>debugMethod:forReceiver:inContext: (in category '*60Deprecated-debugging') -----
debugMethod: aCompiledMethod forReceiver: anObject inContext: aContextOrNil
self deprecated.
^ (Process
forMethod: aCompiledMethod
receiver: anObject
arguments: (aContextOrNil ifNil: [{}] ifNotNil: [:c | {c}]))
debugWithTitle: 'Debug it'!
----- Method: ToolSet class>>inspectorClassOf: (in category '*60Deprecated-inspecting') -----
inspectorClassOf: anObject
self deprecated: 'Use #inspectorClass.'.
^ anObject inspectorClass!
----- Method: ToolSet class>>interrupt:label: (in category '*60Deprecated-debugging') -----
interrupt: aProcess label: aString
self deprecated.
aProcess debugWithTitle: aString full: false.!
ArithmeticError subclass: #NaNError
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: '60Deprecated-Kernel-Numbers-Exceptions'!
!NaNError commentStamp: 'ar 12/14/2010 00:03' prior: 0!
NaNError is signaled by various operations that would either result in or operate on an NaN input.!
----- Method: NaNError>>isResumable (in category 'testing') -----
isResumable
"NaNError is always resumable"
^true!
----- Method: NaNError>>messageText (in category 'accessing') -----
messageText
"Return an exception's message text."
^messageText ifNil:['This operation would result in NaN ']!
----- Method: Utilities class>>setAuthorInitials: (in category '*60Deprecated-identification') -----
setAuthorInitials: aString
"mt: Not now (17/04/2018) for SmalltalkCI. See: https://github.com/hpi-swa/smalltalkCI/issues/368
self deprecated: 'Use #authorInitials:.'."
self authorInitials: aString.!
----- Method: IdentityTransform>>offset (in category '*60Deprecated-accessing') -----
offset
self deprecated: 'Use #localPointToGlobal: instead. Behavior of #offset can vary between transform types.'.
^0 at 0!
----- Method: HelpBrowser class>>openForCodeOn: (in category '*60Deprecated-instance creation') -----
openForCodeOn: aHelpTopic
self deprecated: 'Styling is configured at the level of help topics. Browse implementors of #usesCodeStyling.'.
^ self openOn: aHelpTopic!
----- Method: SmalltalkImage>>hasSpecialSelector:ifTrueSetByte: (in category '*60Deprecated-special objects') -----
hasSpecialSelector: aLiteral ifTrueSetByte: aBlock
self deprecated: 'Use BytecodeEncoder class>>scanBlockOrNilForLiteral:'.
1 to: self specialSelectorSize do:
[:index |
(self specialSelectorAt: index) == aLiteral
ifTrue: [aBlock value: index + 16rAF. ^true]].
^false!
----- Method: SmalltalkImage>>unloadFonts (in category '*60Deprecated-shrinking') -----
unloadFonts
self deprecated: 'See ReleaseBuilder >> #clearCaches. Also, you need to unload or change the UI themes that reference those fonts.'!
----- Method: MorphExtension>>inspectElement (in category '*60Deprecated-other') -----
inspectElement
self deprecated: 'Use MorphInspector. Also see Inspector >> #inspectOne'.!
----- Method: PostscriptCanvas>>text:at:font:color:justified:parwidth: (in category '*60Deprecated-private') -----
text: s at:point font: fontOrNil color: c justified:justify parwidth:parwidth
self deprecated: 'Use #textStyled:at:font:color:justified:parwidth: instead'.
self flag: #bob. "deprecated in favor of #textStyled......."
self setFont:(fontOrNil ifNil:[self defaultFont]).
self comment:' text color: ',c printString.
self setColor:c.
self comment:' origin ', origin printString.
self moveto: point.
target print:' (';
print:s asPostscript; print:') '.
justify ifTrue:[
target write:parwidth; print:' jshow'; cr.
] ifFalse:[
target print:'show'.
].
target cr.
!
----- Method: DisplayScreen class>>hostWindowSize: (in category '*60Deprecated') -----
hostWindowSize: aPoint
self deprecated: 'Use ', #hostWindowExtent:.
self hostWindowExtent: aPoint.
!
----- Method: DisplayScreen>>fullScreen (in category '*60Deprecated-other') -----
fullScreen
self deprecated.
clippingBox := super boundingBox.!
----- Method: DisplayScreen>>replacedBy:do: (in category '*60Deprecated-other') -----
replacedBy: aForm do: aBlock
"Permits normal display to draw on aForm instead of the display."
self deprecated: 'See Project >> #imageFormOfSize:depth:.'.
aBlock value.!
----- Method: String>>openInWorkspaceWithTitle: (in category '*60Deprecated-user interface') -----
openInWorkspaceWithTitle: aTitle
"Open up a workspace with the receiver as its contents, with the given title"
self deprecated: 'Use UIManager >> #edit:label:.'.
UIManager default edit: self label: aTitle.!
----- Method: DialogWindow>>findInvocationContext (in category '*60Deprecated-private') -----
findInvocationContext
| context |
context := thisContext.
[context method selector = #getUserResponse and: [context isMethodContext]]
whileFalse: [context := context sender].
^ context!
----- Method: InsetBorder>>colorsAtCorners (in category '*60Deprecated-accessing') -----
colorsAtCorners
| c c14 c23 |
self deprecated: 'See #topLeftColor and #bottomRightColor.'.
c := self color.
c14 := c lighter. c23 := c darker.
^Array with: c23 with: c14 with: c14 with: c23.!
----- Method: RunArray>>addLast:times: (in category '*60Deprecated') -----
addLast: value times: times
"Add value as the last element of the receiver, the given number of times"
self deprecated: 'use add:withOccurrences:'.
^self add: value withOccurrences: times!
SelectionMenu subclass: #StandardFileMenu
instanceVariableNames: 'canTypeFileName pattern'
classVariableNames: ''
poolDictionaries: ''
category: '60Deprecated-Tools-Menus'!
!StandardFileMenu commentStamp: 'tpr 1/8/2019 13:33' prior: 0!
Deprecated: please don't use this class. It provides a really unpleasant UI (after all it was based on java 'swing') that can be better done by using one of the concrete subclasses of FileAbstractSelectionDialog.
Obsoloete comment:
I represent a SelectionMenu which operates like a modal dialog for selecting files, somewhat similar to the StandardFile dialogs in MacOS and Java Swing.
Try for example, the following:
StandardFileMenu oldFile inspect
StandardFileMenu oldFileStream inspect
StandardFileMenu newFile inspect
StandardFileMenu newFileStream inspect
(StandardFileMenu oldFileMenu: FileDirectory default withPattern: '*') startUpWithCaption: 'Select a file:'
(StandardFileMenu oldFileMenu: (FileDirectory default) withPatternList: {'*.txt'. '*.changes'}) startUpWithCaption: 'Select a file:'
!
----- Method: StandardFileMenu class>>newFile (in category 'standard file operations') -----
newFile
^self newFileFrom: (FileDirectory default)!
----- Method: StandardFileMenu class>>newFileFrom: (in category 'standard file operations') -----
newFileFrom: aDirectory
^(self newFileMenu: aDirectory)
startUpWithCaption: 'Select a File:' translated!
----- Method: StandardFileMenu class>>newFileMenu: (in category 'instance creation') -----
newFileMenu: aDirectory
Smalltalk isMorphic ifFalse: [^ PluggableFileList newFileMenu: aDirectory].
^ super new newFileFrom: aDirectory!
----- Method: StandardFileMenu class>>newFileMenu:withPattern: (in category 'instance creation') -----
newFileMenu: aDirectory withPattern: aPattern
Smalltalk isMorphic ifFalse: [^ PluggableFileList newFileMenu: aDirectory].
^ super new newFileFrom: aDirectory withPattern: aPattern!
----- Method: StandardFileMenu class>>newFileMenu:withPatternList: (in category 'instance creation') -----
newFileMenu: aDirectory withPatternList: aPatternList
Smalltalk isMorphic ifFalse: [^ PluggableFileList newFileMenu: aDirectory].
^ super new newFileFrom: aDirectory withPatternList: aPatternList!
----- Method: StandardFileMenu class>>newFileStream (in category 'standard file operations') -----
newFileStream
^self newFileStreamFrom: (FileDirectory default)!
----- Method: StandardFileMenu class>>newFileStreamFrom: (in category 'standard file operations') -----
newFileStreamFrom: aDirectory
| sfmResult fileStream |
sfmResult := self newFileFrom: aDirectory.
sfmResult ifNil: [^nil].
fileStream := sfmResult directory newFileNamed: sfmResult name.
[fileStream isNil] whileTrue:
[sfmResult := self newFileFrom: aDirectory.
sfmResult ifNil: [^nil].
fileStream := sfmResult directory newFileNamed: sfmResult name].
^fileStream
!
----- Method: StandardFileMenu class>>oldFile (in category 'standard file operations') -----
oldFile
^self oldFileFrom: (FileDirectory default)!
----- Method: StandardFileMenu class>>oldFileFrom: (in category 'standard file operations') -----
oldFileFrom: aDirectory
^(self oldFileMenu: aDirectory)
startUpWithCaption: 'Select a File:' translated!
----- Method: StandardFileMenu class>>oldFileFrom:withPattern: (in category 'standard file operations') -----
oldFileFrom: aDirectory withPattern: aPattern
"
Select an existing file from a selection conforming to aPattern.
"
^(self oldFileMenu: aDirectory withPattern: aPattern)
startUpWithCaption: 'Select a File:' translated!
----- Method: StandardFileMenu class>>oldFileMenu: (in category 'instance creation') -----
oldFileMenu: aDirectory
Smalltalk isMorphic ifFalse: [^ PluggableFileList oldFileMenu: aDirectory].
^ super new oldFileFrom: aDirectory!
----- Method: StandardFileMenu class>>oldFileMenu:withPattern: (in category 'instance creation') -----
oldFileMenu: aDirectory withPattern: aPattern
Smalltalk isMorphic ifFalse: [^PluggableFileList oldFileMenu: aDirectory].
^super new oldFileFrom: aDirectory withPattern: aPattern!
----- Method: StandardFileMenu class>>oldFileMenu:withPatternList: (in category 'instance creation') -----
oldFileMenu: aDirectory withPatternList: aPatternList
Smalltalk isMorphic ifFalse: [^PluggableFileList oldFileMenu: aDirectory].
^super new oldFileFrom: aDirectory withPatternList: aPatternList!
----- Method: StandardFileMenu class>>oldFileStream (in category 'standard file operations') -----
oldFileStream
^self oldFileStreamFrom: (FileDirectory default)
!
----- Method: StandardFileMenu class>>oldFileStreamFrom: (in category 'standard file operations') -----
oldFileStreamFrom: aDirectory
| sfmResult fileStream |
sfmResult := self oldFileFrom: aDirectory.
sfmResult ifNil: [^nil].
fileStream := sfmResult directory oldFileNamed: sfmResult name.
[fileStream isNil] whileTrue:
[sfmResult := self oldFileFrom: aDirectory.
sfmResult ifNil: [^nil].
fileStream := sfmResult directory oldFileNamed: sfmResult name].
^fileStream
!
----- Method: StandardFileMenu>>advance:containingDirectoriesFrom: (in category 'private') -----
advance: anInteger containingDirectoriesFrom: aDirectory
| theDirectory |
theDirectory := aDirectory.
1 to: anInteger do: [:i | theDirectory := theDirectory containingDirectory].
^theDirectory!
----- Method: StandardFileMenu>>confirmExistingFiles: (in category 'basic control sequences') -----
confirmExistingFiles: aResult
|choice|
(aResult directory fileExists: aResult name) ifFalse: [^aResult].
choice := (UIManager default chooseFrom: #('overwrite that file' 'choose another name'
'cancel')
title: aResult name, '
already exists.').
choice = 1 ifTrue: [
aResult directory
deleteFileNamed: aResult name
ifAbsent:
[^self startUpWithCaption:
'Can''t delete ', aResult name, '
Select another file'].
^aResult].
choice = 2 ifTrue: [^self startUpWithCaption: 'Select Another File'].
^nil
!
----- Method: StandardFileMenu>>directoryNamesString: (in category 'menu building') -----
directoryNamesString: aDirectory
"Answer a string concatenating the directory name strings in aDirectory, each string followed by a '[...]' indicator, and followed by a cr."
^ String streamContents:
[:s | aDirectory directoryNames do:
[:dn | s nextPutAll: dn withBlanksTrimmed , ' [...]'; cr]]
!
----- Method: StandardFileMenu>>fileNamesString: (in category 'menu building') -----
fileNamesString: aDirectory
"Answer a string concatenating the file name strings in aDirectory, each string followed by a cr."
^String streamContents:
[:s |
aDirectory fileNames do:
[:fn |
pattern do:[:each | (each match: fn) ifTrue: [
s nextPutAll: fn withBlanksTrimmed; cr]]]]
!
----- Method: StandardFileMenu>>getTypedFileName: (in category 'basic control sequences') -----
getTypedFileName: aResult
| name |
name := UIManager default
request: 'Enter a new file name'
initialAnswer: ''.
name = '' ifTrue: [^self startUpWithCaption: 'Select a File:' translated].
name := aResult directory fullNameFor: name.
^ StandardFileMenuResult
directory: (FileDirectory forFileName: name)
name: (FileDirectory localNameFor: name)
!
----- Method: StandardFileMenu>>makeFileMenuFor: (in category 'menu building') -----
makeFileMenuFor: aDirectory
"Initialize an instance of me to operate on aDirectory"
| theMenu |
pattern ifNil: [pattern := {'*'}].
Cursor wait showWhile:
[self
labels: (self menuLabelsString: aDirectory)
font: Preferences standardMenuFont
lines: (self menuLinesArray: aDirectory).
theMenu := self selections: (self menuSelectionsArray: aDirectory)].
^theMenu!
----- Method: StandardFileMenu>>menuLabelsString: (in category 'menu building') -----
menuLabelsString: aDirectory
"Answer a menu labels object corresponding to aDirectory"
^ String streamContents:
[:s |
canTypeFileName ifTrue:
[s nextPutAll: 'Enter File Name...'; cr].
s nextPutAll: (self pathPartsString: aDirectory).
s nextPutAll: (self directoryNamesString: aDirectory).
s nextPutAll: (self fileNamesString: aDirectory).
s skip: -1]!
----- Method: StandardFileMenu>>menuLinesArray: (in category 'menu building') -----
menuLinesArray: aDirectory
"Answer a menu lines object corresponding to aDirectory"
| typeCount nameCnt dirDepth|
typeCount := canTypeFileName
ifTrue: [1]
ifFalse: [0].
nameCnt := aDirectory directoryNames size.
dirDepth := aDirectory pathParts size.
^Array streamContents: [:s |
canTypeFileName ifTrue: [s nextPut: 1].
s nextPut: dirDepth + typeCount + 1.
s nextPut: dirDepth + nameCnt + typeCount + 1]!
----- Method: StandardFileMenu>>menuSelectionsArray: (in category 'menu building') -----
menuSelectionsArray: aDirectory
"Answer a menu selections object corresponding to aDirectory. The object is an array corresponding to each item, each element itself constituting a two-element array, the first element of which contains a selector to operate on and the second element of which contains the parameters for that selector."
|dirSize|
dirSize := aDirectory pathParts size.
^Array streamContents: [:s |
canTypeFileName ifTrue:
[s nextPut: (StandardFileMenuResult
directory: aDirectory
name: nil)].
s nextPut: (StandardFileMenuResult
directory: (FileDirectory root)
name: '').
aDirectory pathParts withIndexDo:
[:d :i | s nextPut: (StandardFileMenuResult
directory: (self
advance: dirSize - i
containingDirectoriesFrom: aDirectory)
name: '')].
aDirectory directoryNames do:
[:dn | s nextPut: (StandardFileMenuResult
directory: (FileDirectory on: (aDirectory fullNameFor: dn))
name: '')].
aDirectory fileNames do:
[:fn | pattern do: [:pat | (pat match: fn) ifTrue: [
s nextPut: (StandardFileMenuResult
directory: aDirectory
name: fn)]]]]!
----- Method: StandardFileMenu>>newFileFrom: (in category 'private') -----
newFileFrom: aDirectory
canTypeFileName := true.
^self makeFileMenuFor: aDirectory!
----- Method: StandardFileMenu>>newFileFrom:withPattern: (in category 'private') -----
newFileFrom: aDirectory withPattern: aPattern
canTypeFileName := true.
pattern := {aPattern}.
^self makeFileMenuFor: aDirectory!
----- Method: StandardFileMenu>>newFileFrom:withPatternList: (in category 'private') -----
newFileFrom: aDirectory withPatternList: aPatternList
canTypeFileName := true.
pattern := aPatternList.
^self makeFileMenuFor: aDirectory!
----- Method: StandardFileMenu>>oldFileFrom: (in category 'private') -----
oldFileFrom: aDirectory
canTypeFileName := false.
^self makeFileMenuFor: aDirectory!
----- Method: StandardFileMenu>>oldFileFrom:withPattern: (in category 'private') -----
oldFileFrom: aDirectory withPattern: aPattern
canTypeFileName := false.
pattern := {aPattern}.
^self makeFileMenuFor: aDirectory!
----- Method: StandardFileMenu>>oldFileFrom:withPatternList: (in category 'private') -----
oldFileFrom: aDirectory withPatternList: aPatternList
canTypeFileName := false.
pattern := aPatternList.
^self makeFileMenuFor: aDirectory!
----- Method: StandardFileMenu>>pathPartsString: (in category 'menu building') -----
pathPartsString: aDirectory
"Answer a string concatenating the path parts strings in aDirectory, each string followed by a cr."
^String streamContents:
[:s |
s nextPutAll: '[]'; cr.
aDirectory pathParts asArray withIndexDo:
[:part :i |
s next: i put: $ .
s nextPutAll: part withBlanksTrimmed; cr]]!
----- Method: StandardFileMenu>>pattern: (in category 'private') -----
pattern: aPattern
" * for all files, or '*.cs' for changeSets, etc. Just like fileLists"
pattern := {aPattern}!
----- Method: StandardFileMenu>>patternList: (in category 'private') -----
patternList: aPatternList
pattern := aPatternList!
----- Method: StandardFileMenu>>startUpWithCaption:at: (in category 'basic control sequences') -----
startUpWithCaption: aString at: location
|result|
result := super startUpWithCaption: aString at: location.
result ifNil: [^nil].
result isDirectory ifTrue:
[self makeFileMenuFor: result directory.
self computeForm.
^self startUpWithCaption: aString at: location].
result isCommand ifTrue:
[result := self getTypedFileName: result.
result ifNil: [^nil]].
canTypeFileName ifTrue: [^self confirmExistingFiles: result].
^result
!
----- Method: MCCodeTool>>classHierarchy (in category '*60Deprecated-menus') -----
classHierarchy
self deprecated: 'Use #browseClassHierarchy instead'.
self browseClassHierarchy.!
----- Method: HashedCollection>>doWithIndex: (in category '*60Deprecated-enumerating') -----
doWithIndex: elementAndIndexBlock
self flag: #deprecated. "Use the new version with consistent naming."
^ self withIndexDo: elementAndIndexBlock!
----- Method: HashedCollection>>findElementOrNil: (in category '*60Deprecated-compatibility') -----
findElementOrNil: anObject
self deprecated: 'Use ', #scanFor:.
^self scanFor: anObject!
----- Method: HashedCollection>>fullCheck (in category '*60Deprecated-compatibility') -----
fullCheck
"This is a private method, formerly implemented in Set, that is no longer required.
It is here for compatibility with external packages only."
"Keep array at least 1/4 free for decent hash behavior"
self deprecated.
array size * 3 < (tally * 4) ifTrue: [ self grow ]!
----- Method: Browser>>classHierarchy (in category '*60Deprecated-multi-window support') -----
classHierarchy
self deprecated: 'Use #browseClassHierarchy instead'.
self browseClassHierarchy.!
----- Method: DateAndTime class>>millisecondClockValue (in category '*60Deprecated') -----
millisecondClockValue
self deprecated: 'Use Time class>>millisecondClockValue instead'.
^ self clock millisecondClockValue!
----- Method: DateAndTime class>>totalSeconds (in category '*60Deprecated') -----
totalSeconds
self deprecated: 'Use Time class>>totalSeconds instead'.
^ self clock totalSeconds!
----- Method: MenuIcons class>>checkBoxOffColorized: (in category '*60Deprecated') -----
checkBoxOffColorized: aColor
self deprecated: 'Use Form >> #dyed: to dye forms.'.
^ self checkBoxOff dyed: aColor!
----- Method: MenuIcons class>>checkBoxOnColorized: (in category '*60Deprecated') -----
checkBoxOnColorized: aColor
self deprecated: 'Use Form >> #dyed: to dye forms.'.
^ self checkBoxOn dyed: aColor!
----- Method: MenuIcons class>>checkBoxPressedColorized: (in category '*60Deprecated') -----
checkBoxPressedColorized: aColor
self deprecated: 'Use Form >> #dyed: to dye forms.'.
^ self checkBoxPressed dyed: aColor!
----- Method: MenuIcons class>>fullscreenWireframeIconColorized: (in category '*60Deprecated') -----
fullscreenWireframeIconColorized: aColor
self deprecated: 'Use Form >> #dyed: to dye forms.'.
^ self fullscreenWireframeIcon dyed: aColor!
----- Method: MenuIcons class>>radioButtonOffColorized: (in category '*60Deprecated') -----
radioButtonOffColorized: aColor
self deprecated: 'Use Form >> #dyed: to dye forms.'.
^ self radioButtonOff dyed: aColor!
----- Method: MenuIcons class>>radioButtonOnColorized: (in category '*60Deprecated') -----
radioButtonOnColorized: aColor
self deprecated: 'Use Form >> #dyed: to dye forms.'.
^ self radioButtonOn dyed: aColor!
----- Method: MenuIcons class>>radioButtonPressedColorized: (in category '*60Deprecated') -----
radioButtonPressedColorized: aColor
self deprecated: 'Use Form >> #dyed: to dye forms.'.
^ self radioButtonPressed dyed: aColor!
----- Method: MenuIcons class>>squeakLogoIconColorized: (in category '*60Deprecated') -----
squeakLogoIconColorized: aColor
self deprecated: 'Use Form >> #dyed: to dye forms.'.
^ self squeakLogoIcon dyed: aColor!
----- Method: MenuIcons class>>subMenuMarkerColorized: (in category '*60Deprecated') -----
subMenuMarkerColorized: aColor
self deprecated: 'Use Form >> #dyed: to dye forms.'.
^ self subMenuMarker dyed: aColor!
----- Method: PreferenceWizardMorph>>stateUseBiggerFonts (in category '*60Deprecated-actions buttons') -----
stateUseBiggerFonts
self flag: #deprecated. "mt: Soft deprecation for the CI."
^ false!
----- Method: PreferenceWizardMorph>>toggleUseBiggerFonts (in category '*60Deprecated-actions buttons') -----
toggleUseBiggerFonts
self flag: #deprecated. "mt: Soft deprecation for the CI."
!
HTTPDownloadRequest subclass: #PluginHTTPDownloadRequest
instanceVariableNames: 'fileStream'
classVariableNames: ''
poolDictionaries: ''
category: '60Deprecated-NSPlugin-System-Support'!
!PluginHTTPDownloadRequest commentStamp: '<historical>' prior: 0!
HTTPBrowserRequest attempts to fetch the contents through a Webbrowser. This works transparently if Squeak is not running in the browser.!
----- Method: PluginHTTPDownloadRequest>>contentStream (in category 'accessing') -----
contentStream
semaphore wait.
fileStream
ifNotNil: [^ fileStream].
^ content
ifNotNil: [content isString
ifTrue: [self error: 'Error loading ' , self url printString]
ifFalse: [content contentStream]]!
----- Method: PluginHTTPDownloadRequest>>contents (in category 'accessing') -----
contents
| |
semaphore wait.
(content isNil and:[fileStream notNil]) ifTrue:[
" pos := fileStream position."
fileStream position: 0.
content := MIMEDocument content: fileStream upToEnd.
fileStream close.
].
^content!
----- Method: PluginHTTPDownloadRequest>>maxAttempts (in category 'accessing') -----
maxAttempts
"Return the number of attempts to retry before giving up"
^3!
----- Method: PluginHTTPDownloadRequest>>signalAbort (in category 'accessing') -----
signalAbort
fileStream ifNotNil: [
fileStream close].
fileStream := nil.
super signalAbort.!
----- Method: PluginHTTPDownloadRequest>>startRetrieval (in category 'accessing') -----
startRetrieval
| attempts |
attempts := self maxAttempts.
"Note: Only the first request may fail due to not running in a browser"
url first = $/
ifTrue: [url := url copyFrom: 2 to: url size].
fileStream := FileStream requestURLStream: url ifError:[^super startRetrieval].
[fileStream == nil] whileTrue:[
attempts := attempts - 1.
attempts = 0 ifTrue:[^self content:'Error downloading file'].
fileStream := FileStream requestURLStream: url].
semaphore signal.!
QEncodingMimeConverter subclass: #RFC2047MimeConverter
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: '60Deprecated-Collections-Streams'!
----- Method: EllipseMorph>>doesBevels (in category '*60Deprecated-accessing') -----
doesBevels
self deprecated: 'Use border styles such as InsetBorder or RaisedBorder.'.
^ false!
----- Method: SocketStream>>receiveDataIfAvailable (in category '*60Deprecated-private-socket') -----
receiveDataIfAvailable
self deprecated: 'Use #receiveAvailableData instead'.
^ self receiveAvailableData!
----- Method: BorderedMorph>>doesBevels (in category '*60Deprecated-accessing') -----
doesBevels
"To return true means that this object can show bevelled borders, and
therefore can accept, eg, #raised or #inset as valid borderColors.
Must be overridden by subclasses that do not support bevelled borders."
self deprecated: 'Use border styles such as InsetBorder or RaisedBorder.'.
^ false!
----- Method: BorderedMorph>>setBorderWidth:borderColor: (in category '*60Deprecated-private') -----
setBorderWidth: w borderColor: bc
self deprecated: 'mt: Use #borderStyle: or #borderWidth:/Color: directly.'.
self borderWidth: w.
self borderColor: bc.!
----- Method: BorderedMorph>>setColor:borderWidth:borderColor: (in category '*60Deprecated-private') -----
setColor: c borderWidth: w borderColor: bc
self deprecated: 'mt: Use #borderStyle: or #borderWidth:/Color: directly.'.
self color: c.
self borderWidth: w.
self borderColor: bc.!
----- Method: Set>>addNewElement: (in category '*60Deprecated-adding') -----
addNewElement: anObject
"Ensure anObject is part of the receiver. Answer whether its membership was newly acquired."
| index |
self deprecated: 'Use ifAbsentAdd: instead.'.
index := self scanFor: anObject.
^ (array at: index)
ifNil:
[ self
atNewIndex: index
put: anObject asSetElement.
true ]
ifNotNil: [ false ]!
----- Method: StandardToolSet class>>debug:context:label:contents:fullView: (in category '*60Deprecated-debugging') -----
debug: aProcess context: aContext label: aString contents: contents fullView: aBool
self deprecated.
^ self debugProcess: aProcess context: aContext label: aString contents: contents fullView: aBool!
----- Method: StandardToolSet class>>debugContext:label:contents: (in category '*60Deprecated-debugging') -----
debugContext: aContext label: aString contents: contents
self deprecated.
^ self debugProcess: Processor activeProcess context: aContext label: aString contents: contents fullView: false!
----- Method: StandardToolSet class>>debugError: (in category '*60Deprecated-debugging') -----
debugError: anError
self deprecated.
^ self handleError: anError!
----- Method: StandardToolSet class>>inspectorClassOf: (in category '*60Deprecated-inspecting') -----
inspectorClassOf: anObject
self deprecated: 'Use #inspectorClass.'.
^ anObject inspectorClass!
----- Method: StandardToolSet class>>interrupt:label: (in category '*60Deprecated-debugging') -----
interrupt: aProcess label: aString
self deprecated.
aProcess debugWithTitle: aString full: false.!
----- Method: Canvas>>image:at: (in category '*60Deprecated-drawing') -----
image: aForm at: aPoint
"Note: This protocol is deprecated. Use #paintImage: instead."
self deprecated: 'Use #paintImage: or #drawImage: instead'.
self image: aForm
at: aPoint
sourceRect: aForm boundingBox
rule: Form paint.
!
----- Method: Canvas>>image:at:rule: (in category '*60Deprecated-drawing') -----
image: aForm at: aPoint rule: combinationRule
"Note: This protocol is deprecated. Use one of the explicit image drawing messages (#paintImage, #drawImage) instead."
self deprecated: 'Use #paintImage: or #drawImage: instead'.
self image: aForm
at: aPoint
sourceRect: aForm boundingBox
rule: combinationRule.
!
----- Method: Canvas>>imageWithOpaqueWhite:at: (in category '*60Deprecated-drawing') -----
imageWithOpaqueWhite: aForm at: aPoint
"Note: This protocol is deprecated. Use #drawImage: instead"
self deprecated: 'Use #paintImage: or #drawImage: instead'.
self image: aForm
at: aPoint
sourceRect: (0 at 0 extent: aForm extent)
rule: Form over.
!
----- Method: Preferences class>>chooseInsertionPointColor (in category '*60Deprecated-prefs-text') -----
chooseInsertionPointColor
self deprecated: 'See user-interface theme for color information.'.
UserInterfaceTheme current explore.!
----- Method: Preferences class>>chooseKeyboardFocusColor (in category '*60Deprecated-prefs-text') -----
chooseKeyboardFocusColor
self deprecated: 'See user-interface theme for color information.'.
UserInterfaceTheme current explore.!
----- Method: Preferences class>>chooseTextHighlightColor (in category '*60Deprecated-prefs-text') -----
chooseTextHighlightColor
self deprecated: 'See user-interface theme for color information.'.
UserInterfaceTheme current explore.!
----- Method: Preferences class>>initializeTextHighlightingParameters (in category '*60Deprecated-prefs-text') -----
initializeTextHighlightingParameters
"Preferences initializeTextHighlightingParameters"
self deprecated: 'Such parameters are in user-interface themes now.'.!
----- Method: Preferences class>>insertionPointColor (in category '*60Deprecated-prefs-text') -----
insertionPointColor
self deprecated: 'See user-interface theme for color information.'.
^ (UserInterfaceTheme current get: #insertionPointColor for: #Morph) ifNil: [Color red]!
----- Method: Preferences class>>insertionPointColor: (in category '*60Deprecated-prefs-text') -----
insertionPointColor: aColor
self deprecated: 'See user-interface theme for color information.'.
UserInterfaceTheme current
set: #insertionPointColor
for: #Morph
to: aColor.!
----- Method: Preferences class>>keyboardFocusColor (in category '*60Deprecated-prefs-text') -----
keyboardFocusColor
self deprecated: 'See user-interface theme for color information.'.
^ (UserInterfaceTheme current get: #keyboardFocusColor for: #Morph) ifNil: [Color r: 0.6 g: 1 b: 1]!
----- Method: Preferences class>>keyboardFocusColor: (in category '*60Deprecated-prefs-text') -----
keyboardFocusColor: aColor
self deprecated: 'See user-interface theme for color information.'.
UserInterfaceTheme current
set: #keyboardFocusColor
for: #Morph
to: aColor.!
----- Method: Preferences class>>menuBorderColor (in category '*60Deprecated-menu colors') -----
menuBorderColor
self deprecated: 'mt: Use UI themes.'.
^ (UserInterfaceTheme current get: #borderColor for: #MenuMorph) ifNil: [(Color r: 0.2 g: 0.3 b: 0.9)]!
----- Method: Preferences class>>menuBorderWidth (in category '*60Deprecated-menu colors') -----
menuBorderWidth
self deprecated: 'mt: Use UI themes.'.
^ (UserInterfaceTheme current get: #borderWidth for: #MenuMorph) ifNil: [2]!
----- Method: Preferences class>>menuColor (in category '*60Deprecated-menu colors') -----
menuColor
self deprecated: 'mt: Use UI themes.'.
^ (UserInterfaceTheme current get: #color for: #MenuMorph) ifNil: [(Color r: 0.9 g: 0.9 b: 0.9)]!
----- Method: Preferences class>>menuLineColor (in category '*60Deprecated-menu colors') -----
menuLineColor
self deprecated: 'mt: Use UI themes.'.
^ (UserInterfaceTheme current get: #lineColor for: #MenuMorph) ifNil: [(Color r: 0.6 g: 0.7 b: 1)]!
----- Method: Preferences class>>menuSelectionColor (in category '*60Deprecated-menu colors') -----
menuSelectionColor
self deprecated: 'mt: Use UI themes.'.
^ (UserInterfaceTheme current get: #selectionColor for: #MenuItemMorph) ifNil: [(Color r: 0.4 g: 0.5 b: 0.7)]!
----- Method: Preferences class>>menuTitleBorderColor (in category '*60Deprecated-menu colors') -----
menuTitleBorderColor
self deprecated: 'mt: Use UI themes.'.
^ (UserInterfaceTheme current get: #titleBorderColor for: #MenuMorph) ifNil: [(Color r: 0.6 g: 0.7 b: 1)]!
----- Method: Preferences class>>menuTitleBorderWidth (in category '*60Deprecated-menu colors') -----
menuTitleBorderWidth
self deprecated: 'mt: Use UI themes.'.
^ (UserInterfaceTheme current get: #titleBorderWidth for: #MenuMorph) ifNil: [0]!
----- Method: Preferences class>>menuTitleColor (in category '*60Deprecated-menu colors') -----
menuTitleColor
self deprecated: 'mt: Use UI themes.'.
^ (UserInterfaceTheme current get: #titleColor for: #MenuMorph) ifNil: [ Color transparent]!
----- Method: Preferences class>>parameterAt:default: (in category '*60Deprecated-parameters') -----
parameterAt: aKey default: defaultValueBlock
"Deprecated interface; no surviving senders in the released image, but clients probably still use"
self deprecated: 'Use #parameterAt:ifAbsentPut: instead'.
^ self parameterAt: aKey ifAbsentPut: defaultValueBlock!
----- Method: Preferences class>>textHighlightColor (in category '*60Deprecated-prefs-text') -----
textHighlightColor
self deprecated: 'See user-interface theme for color information.'.
^ (UserInterfaceTheme current get: #textHighlightColor for: #Morph) ifNil: [TranslucentColor r: 0.0 g: 0.0 b: 0.8 alpha: 0.2]!
----- Method: Preferences class>>textHighlightColor: (in category '*60Deprecated-prefs-text') -----
textHighlightColor: aColor
self deprecated: 'See user-interface theme for color information.'.
UserInterfaceTheme current
set: #textHighlightColor
for: #Morph
to: aColor.!
----- Method: Preferences class>>windowColorHelp (in category '*60Deprecated-Etoys-Squeakland-window colors') -----
windowColorHelp
self deprecated: 'mt: Use user-interface themes.'.!
----- Method: Preferences class>>windowSpecificationPanel (in category '*60Deprecated-Etoys-Squeakland-window colors') -----
windowSpecificationPanel
self deprecated: 'mt: Use user-interface themes.'.!
----- Method: ChangeSorter class>>allChangeSetNames (in category '*60Deprecated-Tools') -----
allChangeSetNames
self deprecated: 'This method was moved to ChangeSet'.
^ ChangesOrganizer allChangeSetNames!
----- Method: ChangeSorter class>>allChangeSets (in category '*60Deprecated-Tools') -----
allChangeSets
self deprecated: 'This method was moved to ChangeSet'.
^ ChangeSet allChangeSets!
----- Method: ChangeSorter class>>allChangeSetsWithClass:selector: (in category '*60Deprecated-Tools') -----
allChangeSetsWithClass: class selector: selector
self deprecated: 'This method was moved to ChangeSet'.
^ ChangesOrganizer allChangeSetsWithClass: class selector: selector!
----- Method: ChangeSorter class>>assuredChangeSetNamed: (in category '*60Deprecated-Tools') -----
assuredChangeSetNamed: aName
self deprecated: 'This method was moved to ChangeSet'.
^ ChangesOrganizer assuredChangeSetNamed: aName!
----- Method: ChangeSorter class>>basicNewChangeSet: (in category '*60Deprecated-Tools') -----
basicNewChangeSet: newName
self deprecated: 'This method was moved to ChangeSet'.
^ ChangesOrganizer basicNewChangeSet: newName!
----- Method: ChangeSorter class>>belongsInAdditions: (in category '*60Deprecated-Tools') -----
belongsInAdditions: aChangeSet
self deprecated: 'This method was moved to ChangesOrganizer'.
^ ChangesOrganizer belongsInAdditions: aChangeSet!
----- Method: ChangeSorter class>>belongsInAll: (in category '*60Deprecated-Tools') -----
belongsInAll: aChangeSet
self deprecated: 'This method was moved to ChangesOrganizer'.
^ ChangesOrganizer belongsInAll: aChangeSet!
----- Method: ChangeSorter class>>belongsInMyInitials: (in category '*60Deprecated-Tools') -----
belongsInMyInitials: aChangeSet
self deprecated: 'This method was moved to ChangesOrganizer'.
^ ChangesOrganizer belongsInMyInitials: aChangeSet!
----- Method: ChangeSorter class>>belongsInNumbered: (in category '*60Deprecated-Tools') -----
belongsInNumbered: aChangeSet
self deprecated: 'This method was moved to ChangesOrganizer'.
^ ChangesOrganizer belongsInNumbered: aChangeSet!
----- Method: ChangeSorter class>>belongsInProjectChangeSets: (in category '*60Deprecated-Tools') -----
belongsInProjectChangeSets: aChangeSet
self deprecated: 'This method was moved to ChangesOrganizer'.
^ ChangesOrganizer belongsInProjectChangeSets: aChangeSet!
----- Method: ChangeSorter class>>belongsInProjectsInRelease: (in category '*60Deprecated-Tools') -----
belongsInProjectsInRelease: aChangeSet
self deprecated: 'This method was moved to ChangesOrganizer'.
^ ChangesOrganizer belongsInProjectsInRelease: aChangeSet!
----- Method: ChangeSorter class>>belongsInRecentUpdates: (in category '*60Deprecated-Tools') -----
belongsInRecentUpdates: aChangeSet
self deprecated: 'This method was moved to ChangesOrganizer'.
^ ChangesOrganizer belongsInRecentUpdates: aChangeSet!
----- Method: ChangeSorter class>>buildAggregateChangeSet (in category '*60Deprecated-Tools') -----
buildAggregateChangeSet
self deprecated: 'This method was moved to ChangeSet'.
^ ChangesOrganizer buildAggregateChangeSet
!
----- Method: ChangeSorter class>>changeSet:containsClass: (in category '*60Deprecated-Tools') -----
changeSet: aChangeSet containsClass: aClass
self deprecated: 'This method was moved to ChangeSet'.
^ ChangeSet changeSet: aChangeSet containsClass: aClass!
----- Method: ChangeSorter class>>changeSetNamed: (in category '*60Deprecated-Tools') -----
changeSetNamed: aName
self deprecated: 'This method was moved to ChangesOrganizer'.
^ ChangesOrganizer changeSetNamed: aName!
----- Method: ChangeSorter class>>changeSetNamesInReleaseImage (in category '*60Deprecated-Tools') -----
changeSetNamesInReleaseImage
self deprecated: 'This method was moved to ChangesOrganizer'.
^ ChangesOrganizer changeSetNamesInReleaseImage!
----- Method: ChangeSorter class>>changeSetNamesInThreeOh (in category '*60Deprecated-Tools') -----
changeSetNamesInThreeOh
self deprecated: 'This method was moved to ChangesOrganizer'.
^ ChangesOrganizer changeSetNamesInThreeOh!
----- Method: ChangeSorter class>>changeSetsNamedSuchThat: (in category '*60Deprecated-Tools') -----
changeSetsNamedSuchThat: nameBlock
self deprecated: 'This method was moved to ChangeSet'.
^ ChangeSet changeSetsNamedSuchThat: nameBlock!
----- Method: ChangeSorter class>>countOfChangeSetsWithClass:andSelector: (in category '*60Deprecated-Tools') -----
countOfChangeSetsWithClass: aClass andSelector: aSelector
self deprecated: 'This method was moved to ChangeSet'.
^ ChangeSet countOfChangeSetsWithClass: aClass andSelector: aSelector!
----- Method: ChangeSorter class>>deleteChangeSetsNumberedLowerThan: (in category '*60Deprecated-Tools') -----
deleteChangeSetsNumberedLowerThan: anInteger
self deprecated: 'This method was moved to ChangeSet'.
^ ChangeSet deleteChangeSetsNumberedLowerThan: anInteger!
----- Method: ChangeSorter class>>doesAnyChangeSetHaveClass:andSelector: (in category '*60Deprecated-Tools') -----
doesAnyChangeSetHaveClass: aClass andSelector: aSelector
self deprecated: 'This method was moved to ChangeSet'.
^ ChangeSet doesAnyChangeSetHaveClass: aClass andSelector: aSelector!
----- Method: ChangeSorter class>>existingOrNewChangeSetNamed: (in category '*60Deprecated-Tools') -----
existingOrNewChangeSetNamed: aName
self deprecated: 'This method was moved to ChangeSet'.
^ ChangeSet existingOrNewChangeSetNamed: aName!
----- Method: ChangeSorter class>>fileOutChangeSetsNamed: (in category '*60Deprecated-Tools') -----
fileOutChangeSetsNamed: nameList
self deprecated: 'This method was moved to ChangeSet'.
^ ChangeSet fileOutChangeSetsNamed: nameList!
----- Method: ChangeSorter class>>gatherChangeSets (in category '*60Deprecated-Tools') -----
gatherChangeSets
self deprecated: 'This method was moved to ChangeSet'.
^ ChangeSet gatherChangeSets!
----- Method: ChangeSorter class>>highestNumberedChangeSet (in category '*60Deprecated-Tools') -----
highestNumberedChangeSet
self deprecated: 'This method was moved to ChangeSet'.
^ ChangeSet highestNumberedChangeSet
!
----- Method: ChangeSorter class>>mostRecentChangeSetWithChangeForClass:selector: (in category '*60Deprecated-Tools') -----
mostRecentChangeSetWithChangeForClass: class selector: selector
self deprecated: 'This method was moved to ChangeSet'.
^ ChangeSet mostRecentChangeSetWithChangeForClass: class selector: selector!
----- Method: ChangeSorter class>>newChangeSet (in category '*60Deprecated-Tools') -----
newChangeSet
self deprecated: 'This method was moved to ChangeSet'.
^ ChangeSet newChangeSet!
----- Method: ChangeSorter class>>newChangeSet: (in category '*60Deprecated-Tools') -----
newChangeSet: aName
self deprecated: 'This method was moved to ChangeSet'.
^ ChangeSet newChangeSet: aName!
----- Method: ChangeSorter class>>newChangesFromStream:named: (in category '*60Deprecated-Tools') -----
newChangesFromStream: aStream named: aName
self deprecated: 'This method was moved to ChangeSet'.
^ ChangeSet newChangesFromStream: aStream named: aName!
----- Method: ChangeSorter class>>noteChangeSetsInRelease (in category '*60Deprecated-Tools') -----
noteChangeSetsInRelease
self deprecated: 'This method was moved to ChangesOrganizer'.
^ ChangesOrganizer noteChangeSetsInRelease!
----- Method: ChangeSorter class>>promoteToTop: (in category '*60Deprecated-Tools') -----
promoteToTop: aChangeSet
self deprecated: 'This method was moved to ChangeSet'.
^ ChangeSet promoteToTop: aChangeSet!
----- Method: ChangeSorter class>>recentUpdateMarker (in category '*60Deprecated-Tools') -----
recentUpdateMarker
self deprecated: 'This method was moved to ChangesOrganizer'.
^ ChangesOrganizer recentUpdateMarker!
----- Method: ChangeSorter class>>recentUpdateMarker: (in category '*60Deprecated-Tools') -----
recentUpdateMarker: aNumber
self deprecated: 'This method was moved to ChangesOrganizer'.
^ ChangesOrganizer recentUpdateMarker: aNumber!
----- Method: ChangeSorter class>>removeChangeSet: (in category '*60Deprecated-Tools') -----
removeChangeSet: aChangeSet
self deprecated: 'This method was moved to ChangeSet'.
^ ChangeSet removeChangeSet: aChangeSet!
----- Method: ChangeSorter class>>removeChangeSetsNamedSuchThat: (in category '*60Deprecated-Tools') -----
removeChangeSetsNamedSuchThat: nameBlock
self deprecated: 'This method was moved to ChangeSet'.
^ ChangeSet removeChangeSetsNamedSuchThat: nameBlock!
----- Method: ChangeSorter class>>removeEmptyUnnamedChangeSets (in category '*60Deprecated-Tools') -----
removeEmptyUnnamedChangeSets
self deprecated: 'This method was moved to ChangeSet'.
^ ChangeSet removeEmptyUnnamedChangeSets!
----- Method: ChangeSorter class>>reorderChangeSets (in category '*60Deprecated-Tools') -----
reorderChangeSets
self deprecated: 'This method was moved to ChangesOrganizer'.
^ ChangesOrganizer reorderChangeSets!
----- Method: ChangeSorter class>>secondaryChangeSet (in category '*60Deprecated-Tools') -----
secondaryChangeSet
self deprecated: 'This method was moved to ChangeSet'.
^ ChangeSet secondaryChangeSet!
----- Method: TTSampleFontMorph>>doesBevels (in category '*60Deprecated-accessing') -----
doesBevels
self deprecated: 'Use border styles such as InsetBorder or RaisedBorder.'.
^ false!
----- Method: StandardFileStream class>>isRunningAsBrowserPlugin (in category '*60Deprecated-NSPlugin-System-Support') -----
isRunningAsBrowserPlugin
self deprecated: 'NSPlugin no longer supported'.
self new waitBrowserReadyFor: 1000 ifFail: [^false].
^true!
----- Method: StandardFileStream class>>privateCheckForBrowserPrimitives (in category '*60Deprecated-NSPlugin-System-Support') -----
privateCheckForBrowserPrimitives
<primitive:'primitivePluginBrowserReady'>
self deprecated: 'NSPlugin no longer supported'.
^false!
----- Method: StandardFileStream>>defaultBrowserReadyWait (in category '*60Deprecated-NSPlugin-System-Support') -----
defaultBrowserReadyWait
self deprecated: 'NSPlugin no longer supported'.
^5000!
----- Method: StandardFileStream>>post:target:url:ifError: (in category '*60Deprecated-NSPlugin-System-Support') -----
post: data target: target url: url ifError: errorBlock
"Post data to the given URL. The returned file stream contains the reply of the server.
If Squeak is not running in a browser evaluate errorBlock"
self deprecated: 'NSPlugin no longer supported'.
self waitBrowserReadyFor: self defaultBrowserReadyWait ifFail: [^errorBlock value].
Smalltalk newExternalSemaphoreDo: [ :semaphore :index |
| request result |
request := self primURLPost: url target: target data: data semaIndex: index.
request ifNil: [
Smalltalk unregisterExternalObject: semaphore.
^errorBlock value ].
[ semaphore wait. "until something happens"
result := self primURLRequestState: request.
result == nil ] whileTrue.
result ifTrue: [ fileID := self primURLRequestFileHandle: request ].
self primURLRequestDestroy: request.
Smalltalk unregisterExternalObject: semaphore ].
fileID ifNil: [ ^nil ].
self register.
name := url.
rwmode := false.
buffer1 := String new: 1.
self enableReadBuffering!
----- Method: StandardFileStream>>post:url:ifError: (in category '*60Deprecated-NSPlugin-System-Support') -----
post: data url: url ifError: errorBlock
self deprecated: 'NSPlugin no longer supported'.
self post: data target: nil url: url ifError: errorBlock!
----- Method: StandardFileStream>>primBrowserReady (in category '*60Deprecated-NSPlugin-System-Support') -----
primBrowserReady
<primitive:'primitivePluginBrowserReady'>
self deprecated: 'NSPlugin no longer supported'.
^nil!
----- Method: StandardFileStream>>primURLPost:data:semaIndex: (in category '*60Deprecated-NSPlugin-System-Support') -----
primURLPost: url data: contents semaIndex: index
self deprecated: 'NSPlugin no longer supported'.
^self primURLPost: url target: nil data: contents semaIndex: index!
----- Method: StandardFileStream>>primURLPost:target:data:semaIndex: (in category '*60Deprecated-NSPlugin-System-Support') -----
primURLPost: url target: target data: contents semaIndex: index
"Post the data (url might be 'mailto:' etc)"
<primitive:'primitivePluginPostURL'>
self deprecated: 'NSPlugin no longer supported'.
^nil
!
----- Method: StandardFileStream>>primURLRequest:semaIndex: (in category '*60Deprecated-NSPlugin-System-Support') -----
primURLRequest: url semaIndex: index
<primitive:'primitivePluginRequestURLStream'>
self deprecated: 'NSPlugin no longer supported'.
^nil!
----- Method: StandardFileStream>>primURLRequest:target:semaIndex: (in category '*60Deprecated-NSPlugin-System-Support') -----
primURLRequest: url target: target semaIndex: index
"target - String (frame, also ':=top', ':=parent' etc)"
<primitive:'primitivePluginRequestURL'>
self deprecated: 'NSPlugin no longer supported'.
^nil
!
----- Method: StandardFileStream>>primURLRequestDestroy: (in category '*60Deprecated-NSPlugin-System-Support') -----
primURLRequestDestroy: request
<primitive:'primitivePluginDestroyRequest'>
self deprecated: 'NSPlugin no longer supported'.
^nil!
----- Method: StandardFileStream>>primURLRequestFileHandle: (in category '*60Deprecated-NSPlugin-System-Support') -----
primURLRequestFileHandle: request
<primitive: 'primitivePluginRequestFileHandle'>
self deprecated: 'NSPlugin no longer supported'.
^nil!
----- Method: StandardFileStream>>primURLRequestState: (in category '*60Deprecated-NSPlugin-System-Support') -----
primURLRequestState: request
<primitive:'primitivePluginRequestState'>
self deprecated: 'NSPlugin no longer supported'.
^false!
----- Method: StandardFileStream>>requestURL:target: (in category '*60Deprecated-NSPlugin-System-Support') -----
requestURL: url target: target
self deprecated: 'NSPlugin no longer supported'.
^self requestURL: url target: target ifError: [nil]!
----- Method: StandardFileStream>>requestURL:target:ifError: (in category '*60Deprecated-NSPlugin-System-Support') -----
requestURL: url target: target ifError: errorBlock
"Request to go to the target for the given URL.
If Squeak is not running in a browser evaluate errorBlock"
self deprecated: 'NSPlugin no longer supported'.
self waitBrowserReadyFor: self defaultBrowserReadyWait ifFail: [^errorBlock value].
Smalltalk newExternalSemaphoreDo: [ :semaphore :index |
| request result |
request := self primURLRequest: url target: target semaIndex: index.
request ifNil: [
Smalltalk unregisterExternalObject: semaphore.
^errorBlock value ].
[ semaphore wait. "until something happens"
result := self primURLRequestState: request.
result == nil ] whileTrue.
self primURLRequestDestroy: request.
Smalltalk unregisterExternalObject: semaphore ].
fileID ifNil: [ ^nil ].
self register.
name := url.
rwmode := false.
buffer1 := String new: 1.
self enableReadBuffering!
----- Method: StandardFileStream>>requestURLStream: (in category '*60Deprecated-NSPlugin-System-Support') -----
requestURLStream: url
"FileStream requestURLStream:'http://www.squeak.org'"
self deprecated: 'NSPlugin no longer supported'.
^self requestURLStream: url ifError:[nil]!
----- Method: StandardFileStream>>requestURLStream:ifError: (in category '*60Deprecated-NSPlugin-System-Support') -----
requestURLStream: url ifError: errorBlock
"Request a FileStream for the given URL.
If Squeak is not running in a browser evaluate errorBlock"
"FileStream requestURLStream:'http://www.squeak.org'"
self deprecated: 'NSPlugin no longer supported'.
self waitBrowserReadyFor: self defaultBrowserReadyWait ifFail: [^errorBlock value].
Smalltalk newExternalSemaphoreDo: [ :semaphore :index |
| request result |
request := self primURLRequest: url semaIndex: index.
request ifNil: [
Smalltalk unregisterExternalObject: semaphore.
^errorBlock value ].
[ semaphore wait. "until something happens"
result := self primURLRequestState: request.
result == nil ] whileTrue.
result ifTrue: [ fileID := self primURLRequestFileHandle: request ].
self primURLRequestDestroy: request.
Smalltalk unregisterExternalObject: semaphore ].
fileID ifNil: [ ^nil ].
self register.
name := url.
rwmode := false.
buffer1 := String new: 1.
self enableReadBuffering!
----- Method: StandardFileStream>>waitBrowserReadyFor:ifFail: (in category '*60Deprecated-NSPlugin-System-Support') -----
waitBrowserReadyFor: timeout ifFail: errorBlock
| startTime delay okay |
self deprecated: 'NSPlugin no longer supported'.
okay := self primBrowserReady.
okay ifNil:[^errorBlock value].
okay ifTrue: [^true].
startTime := Time millisecondClockValue.
delay := Delay forMilliseconds: 100.
[(Time millisecondsSince: startTime) < timeout]
whileTrue: [
delay wait.
okay := self primBrowserReady.
okay ifNil:[^errorBlock value].
okay ifTrue: [^true]].
^errorBlock value!
----- Method: AdditionalMethodState>>hasLiteralThorough: (in category '*60Deprecated-literals') -----
hasLiteralThorough: literal
self deprecated: 'Use #hasLiteral: instead. It is always thorough.'.
^ self hasLiteral: literal!
----- Method: Project class>>handlePrimitiveError: (in category '*60Deprecated-error recovery') -----
handlePrimitiveError: errorMessage
self deprecated.
Project current primitiveError: errorMessage.!
----- Method: Project>>setThumbnail: (in category '*60Deprecated-accessing') -----
setThumbnail: aForm
self deprecated: 'mt: Use #thumbnail: instead.'.
self thumbnail: aForm.!
----- Method: Project>>setViewSize: (in category '*60Deprecated-accessing') -----
setViewSize: aPoint
self deprecated: 'ct: Use #viewSize: instead'.
^ self viewSize: aPoint!
Notification subclass: #FontSubstitutionDuringLoading
instanceVariableNames: 'familyName pixelSize'
classVariableNames: ''
poolDictionaries: ''
category: '60Deprecated-Etoys-Squeakland-System-Support'!
!FontSubstitutionDuringLoading commentStamp: '<historical>' prior: 0!
signaled by font loading code when reading a DiskProxy that calls for a missing font.!
----- Method: FontSubstitutionDuringLoading class>>forFamilyName:pixelSize: (in category 'instance creation') -----
forFamilyName: aName pixelSize: aSize
^(self new)
familyName: aName;
pixelSize: aSize;
yourself.!
----- Method: FontSubstitutionDuringLoading>>defaultAction (in category 'accessing') -----
defaultAction
familyName ifNil: [ familyName := 'NoName' ].
pixelSize ifNil: [ pixelSize := 12 ].
^((familyName beginsWith: 'Comic')
ifTrue: [ TextStyle named: (Preferences standardEToysFont familyName) ]
ifFalse: [ TextStyle default ]) fontOfSize: pixelSize.!
----- Method: FontSubstitutionDuringLoading>>familyName (in category 'accessing') -----
familyName
"Answer the value of familyName"
^ familyName!
----- Method: FontSubstitutionDuringLoading>>familyName: (in category 'accessing') -----
familyName: anObject
"Set the value of familyName"
familyName := anObject!
----- Method: FontSubstitutionDuringLoading>>pixelSize (in category 'accessing') -----
pixelSize
"Answer the value of pixelSize"
^ pixelSize!
----- Method: FontSubstitutionDuringLoading>>pixelSize: (in category 'accessing') -----
pixelSize: anObject
"Set the value of pixelSize"
pixelSize := anObject!
----- Method: FontSubstitutionDuringLoading>>printOn: (in category 'accessing') -----
printOn: aStream
super printOn: aStream.
aStream nextPut: $(;
nextPutAll: familyName;
nextPut: $-;
print: pixelSize;
nextPut: $).!
Notification subclass: #UndeclaredVariableReference
instanceVariableNames: 'parser varName varStart varEnd'
classVariableNames: ''
poolDictionaries: ''
category: '60Deprecated-Compiler-Support'!
----- Method: UndeclaredVariableReference>>defaultAction (in category 'exceptionDescription') -----
defaultAction
^parser correctVariable: varName interval: (varStart to: varEnd)!
----- Method: UndeclaredVariableReference>>parser (in category 'accessing') -----
parser
^parser!
----- Method: UndeclaredVariableReference>>parser: (in category 'accessing') -----
parser: aParser
parser := aParser!
----- Method: UndeclaredVariableReference>>varEnd (in category 'accessing') -----
varEnd
^varEnd!
----- Method: UndeclaredVariableReference>>varEnd: (in category 'accessing') -----
varEnd: aNumber
varEnd := aNumber!
----- Method: UndeclaredVariableReference>>varName (in category 'accessing') -----
varName
^varName!
----- Method: UndeclaredVariableReference>>varName: (in category 'accessing') -----
varName: aString
varName := aString!
----- Method: UndeclaredVariableReference>>varStart (in category 'accessing') -----
varStart
^varStart!
----- Method: UndeclaredVariableReference>>varStart: (in category 'accessing') -----
varStart: aNumber
varStart := aNumber!
----- Method: FileList2 class>>projectOnlySelectionMethod: (in category '*60Deprecated-Tools') -----
projectOnlySelectionMethod: incomingEntries
self deprecated: 'use Project class>latestProjectVersionsFromFileEntries: instead'.
^Project latestProjectVersionsFromFileEntries: incomingEntries!
----- Method: SMPackage>>maintainer (in category '*60Deprecated-accessing') -----
maintainer
self deprecated: 'Use #owner or #maintainers instead'.
^self owner!
----- Method: SMPackage>>modulePath:moduleVersion:moduleTag:versionComment: (in category '*60Deprecated-deprecated') -----
modulePath: p moduleVersion: v moduleTag: t versionComment: vc
"Deprecated. Only kept for migration from SM 1.0x.
Method used when recreating from storeOn: format."
self deprecated.
self isReleased ifTrue: [self lastRelease note: vc]!
----- Method: PluggableMultiColumnListMorph>>getListRow: (in category '*60Deprecated-accessing') -----
getListRow: row
self deprecated.
^ self getListItem: row!
----- Method: CompiledMethod>>hasLiteralThorough: (in category '*60Deprecated-literals') -----
hasLiteralThorough: literal
self deprecated: 'Use #hasLiteral: instead. It is always thorough.'.
^ self hasLiteral: literal!
----- Method: CompiledMethod>>refersToLiteral: (in category '*60Deprecated-literals') -----
refersToLiteral:aLiteral
self deprecated: 'Use #hasLiteral: instead.'.
^self hasLiteral: aLiteral!
----- Method: Character class>>characterTable (in category '*60Deprecated-constants') -----
characterTable
"Answer the class variable in which unique Characters are stored."
self deprecated: 'All characters are immediate.'.
^self allByteCharacters as: String!
CompiledCodeInspector subclass: #CompiledMethodInspector
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: '60Deprecated-Tools-Inspector'!
!CompiledMethodInspector commentStamp: 'mt 4/6/2020 08:30' prior: 0!
Deprecated since CompiledCodeInspector can inspect both CompiledBlock and CompiledMethod.!
----- Method: Process>>debug: (in category '*60Deprecated-System-debugging') -----
debug: context
self flag: #deprecated.
^ self debug: context title: nil!
----- Method: Process>>debug:title: (in category '*60Deprecated-System-debugging') -----
debug: context title: title
self flag: #deprecated.
^ self debug: context title: title full: true!
----- Method: Process>>debug:title:full: (in category '*60Deprecated-System-debugging') -----
debug: context title: title full: bool
self flag: #deprecated.
^ self
debug: context
title: title
full: bool
contents: nil!
----- Method: Process>>debug:title:full:contents: (in category '*60Deprecated-System-debugging') -----
debug: context title: title full: bool contents: contents
| topCtxt |
self deprecated: 'ct: Use #debugWithTitle:... to debug the process from its top, "ToolSet debugProcess:..." to customize the entry context, or the debugging protocol on Processor to debug the active process.'.
"See also the comment in #debugWithTitle:full:contents: on debugging the active process."
topCtxt := self suspendedContext ifNil: [thisContext].
(topCtxt hasContext: context) ifFalse: [^ self error: 'context not in process' translated].
^ ToolSet debugProcess: self context: context label: title contents: contents fullView: bool!
----- Method: FancyMailComposition>>breakLinesInMessage: (in category '*60Deprecated-private') -----
breakLinesInMessage: message
"reformat long lines in the specified message into shorter ones"
self deprecated: 'This should not be done by the mail composition, by now the MailMessage takes care of it'.
message body mainType = 'text' ifTrue: [
"it's a single-part text message. reformat the text"
| newBodyText |
newBodyText := self breakLines: message bodyText atWidth: 72.
message body: (MIMEDocument contentType: message body contentType content: newBodyText).
^self ].
message body isMultipart ifTrue: [
"multipart message; process the top-level parts. HACK: the parts are modified in place"
message parts do: [ :part |
part body mainType = 'text' ifTrue: [
| newBodyText |
newBodyText := self breakLines: part bodyText atWidth: 72.
part body: (MIMEDocument contentType: part body contentType content: newBodyText) ] ].
message regenerateBodyFromParts. ].!
----- Method: FancyMailComposition>>morphicOpen (in category '*60Deprecated-user interface') -----
morphicOpen
self deprecated.
^ self open!
----- Method: FancyMailComposition>>mvcOpen (in category '*60Deprecated-ST80-Support') -----
mvcOpen
self deprecated.
^ self open!
----- Method: FancyMailComposition>>openInMorphic (in category '*60Deprecated-morphic gui') -----
openInMorphic
self deprecated.
^ self open!
----- Method: SystemNavigation class>>thoroughSenders (in category '*60Deprecated-preferences') -----
thoroughSenders
self deprecated: 'Senders browsing is always thorough. See #allLiterals vs. #literals.'.
^ true!
----- Method: SystemNavigation class>>thoroughSenders: (in category '*60Deprecated-preferences') -----
thoroughSenders: aBoolean
self deprecated: 'Senders browsing is always thorough. See #allLiterals vs. #literals.'.!
----- Method: SystemNavigation>>confirmRemovalOf:on: (in category '*60Deprecated-ui') -----
confirmRemovalOf: aSelector on: aClass
"Determine if it is okay to remove the given selector. Answer 1 if it should be removed, 2 if it should be removed followed by a senders browse, and 3 if it should not be removed."
self deprecated: 'Use #confirmAndRemoveSelector:class: instead.'.
self confirmAndRemoveSelector: aSelector class: aClass.
^ 3 "Nothing useful to do anymore. Might produce UI glitches but better to not carry over the old code any longer"!
----- Method: Morph>>addMorphInFrontOfLayer: (in category '*60Deprecated-WiW support') -----
addMorphInFrontOfLayer: aMorph
self flag: #deprecated. "Use #addMorphFrontInLayer: instead".
^ self privateAddMorph: aMorph atIndex: 1!
----- Method: Morph>>becomeModal (in category '*60Deprecated-user-interface') -----
becomeModal
self deprecated: 'The global becomeModal is no longer supported, use e.g. a dialog window'.
"self currentWorld
ifNotNil: [self currentWorld modalWindow: self]"!
----- Method: Morph>>blueButtonDown: (in category '*60Deprecated-meta-actions') -----
blueButtonDown: anEvent
"Nothing."
self deprecated: 'Use #mouseDown:.'.!
----- Method: Morph>>blueButtonUp: (in category '*60Deprecated-meta-actions') -----
blueButtonUp: anEvent
"Ignored. Theoretically we should never get here since control is transferred to the halo on #blueButtonDown: but subclasses may implement this differently."
self deprecated: 'Use #mouseUp:.'.!
----- Method: Morph>>changeDocumentAnchor (in category '*60Deprecated-text-anchor') -----
changeDocumentAnchor
"Change the anchor from/to document anchoring"
| newType |
newType := self textAnchorProperties anchorLayout == #document
ifTrue: [#inline]
ifFalse: [ #document].
self textAnchorProperties anchorLayout: newType.
owner isTextMorph ifTrue: [
owner
anchorMorph: self
at: self position
type: newType]!
----- Method: Morph>>changeInlineAnchor (in category '*60Deprecated-text-anchor') -----
changeInlineAnchor
"Change the anchor from/to line anchoring"
| newType |
newType := self textAnchorProperties anchorLayout == #inline
ifTrue: [#document]
ifFalse: [#inline].
self textAnchorProperties anchorLayout: newType.
owner isTextMorph ifTrue: [
owner
anchorMorph: self
at: self position
type: newType]!
----- Method: Morph>>changeParagraphAnchor (in category '*60Deprecated-text-anchor') -----
changeParagraphAnchor
"Change the anchor from/to paragraph anchoring"
| newType |
self deprecated: 'paragraph is not supported anymore'.
newType := self textAnchorProperties anchorLayout == #paragraph
ifTrue: [#document]
ifFalse: [#paragraph].
owner isTextMorph ifTrue: [
owner
anchorMorph: self
at: self position
type: newType]!
----- Method: Morph>>degreesOfFlex (in category '*60Deprecated-rotate scale and flex') -----
degreesOfFlex
self deprecated: 'Use #rotationDegrees.'.
^ self rotationDegrees!
----- Method: Morph>>doesBevels (in category '*60Deprecated-accessing') -----
doesBevels
"To return true means that this object can show bevelled borders, and
therefore can accept, eg, #raised or #inset as valid borderColors.
Must be overridden by subclasses that do not support bevelled borders."
self deprecated: 'Use border styles such as InsetBorder or RaisedBorder.'.
^ false!
----- Method: Morph>>dropFiles: (in category '*60Deprecated-event handling') -----
dropFiles: anEvent
"Handle a number of files dropped from the OS."
self flag: #deprecated. "Use #acceptDroppingMorph:event: instead and scan for dragTransferType: #filesAndDirectories.'"!
----- Method: Morph>>fullCopy (in category '*60Deprecated-copying') -----
fullCopy
"Deprecated, but maintained for backward compatibility with existing code (no senders in the base 3.0 image). Calls are revectored to #veryDeepCopy, but note that #veryDeepCopy does not do exactly the same thing that the original #fullCopy did, so beware!!"
self deprecated: 'Use #veryDeepCopy instead'.
^ self veryDeepCopy!
----- Method: Morph>>gridPoint: (in category '*60Deprecated-geometry') -----
gridPoint: ungriddedPoint
self deprecated: 'Use GridLayout as the container''s layout policy instead.'.
^ ungriddedPoint!
----- Method: Morph>>griddedPoint: (in category '*60Deprecated-geometry') -----
griddedPoint: ungriddedPoint
self deprecated: 'Use GridLayout as the container''s layout policy instead.'.
^ ungriddedPoint!
----- Method: Morph>>handleDropFiles: (in category '*60Deprecated-events-processing') -----
handleDropFiles: anEvent
"Handle a drop from the OS. Deprecated protocol. Use #handleDropMorph: instead and scan for dragTransferType: #filesAndDirectories."
anEvent wasHandled ifTrue: [^ self]. "not interested"
(self wantsDropFiles: anEvent) ifFalse: [^ self].
anEvent wasHandled: true.
self deprecated: 'ct: #dropFiles/#wantsDropFiles: protocol is deprecated. Use #acceptDroppingMorph:event:/#wantsDroppedMorph:event: instead and scan for dragTransferType: #filesAndDirectories.'.
self dropFiles: anEvent.!
----- Method: Morph>>handlerForBlueButtonDown: (in category '*60Deprecated-meta-actions') -----
handlerForBlueButtonDown: anEvent
self deprecated: 'Use #handlerForMouseDown:.'.
^ nil!
----- Method: Morph>>handlerForMetaMenu: (in category '*60Deprecated-meta-actions') -----
handlerForMetaMenu: evt
self deprecated: 'Use #handlerForMouseDown: or #wantsMetaMenu or #mouseDownPriority.'.
^ nil!
----- Method: Morph>>hasDocumentAnchorString (in category '*60Deprecated-text-anchor') -----
hasDocumentAnchorString
^ (self textAnchorProperties anchorLayout == #document
ifTrue: ['<on>']
ifFalse: ['<off>'])
, 'Document' translated!
----- Method: Morph>>hasInlineAnchorString (in category '*60Deprecated-text-anchor') -----
hasInlineAnchorString
^ (self textAnchorProperties anchorLayout == #inline
ifTrue: ['<on>']
ifFalse: ['<off>'])
, 'Inline' translated!
----- Method: Morph>>hasParagraphAnchorString (in category '*60Deprecated-text-anchor') -----
hasParagraphAnchorString
self deprecated: 'paragraph is not supported anymore'.
^ (self textAnchorProperties anchorLayout == #paragraph
ifTrue: ['<on>']
ifFalse: ['<off>'])
, 'Paragraph' translated!
----- Method: Morph>>highlightOnlySubmorph: (in category '*60Deprecated-MorphicExtras-accessing') -----
highlightOnlySubmorph: aMorph
"Distinguish only aMorph with border highlighting (2-pixel wide red); make all my other submorphs have one-pixel-black highlighting. This is a rather special-purpose and hard-coded highlighting regime, of course. Later, if someone cared to do it, we could parameterize the widths and colors via properties, or some such."
self deprecated: 'Do not use at all anymore. This was a specialized call for the objects tool which does not work in a general way on arbitrary morphs.'.
self submorphs do:
[:m |
m == aMorph
ifTrue: [m borderWidth: 1; borderColor: Color red. m firstSubmorph color: Color red]
ifFalse: [m borderWidth: 1; borderColor: Color black. m firstSubmorph color: Color black]].
!
----- Method: Morph>>inATwoWayScrollPane (in category '*60Deprecated-initialization') -----
inATwoWayScrollPane
self deprecated.
^ self inAScrollPane!
----- Method: Morph>>morphicLayerNumberWithin: (in category '*60Deprecated-WiW support') -----
morphicLayerNumberWithin: anOwner
self flag: #deprecated. "Use #morphicLayerNumber instead".
^ self morphicLayerNumber!
----- Method: Morph>>relativeTextAnchorPosition (in category '*60Deprecated-text-anchor') -----
relativeTextAnchorPosition
self deprecated: 'Use textAnchorProperties instead'.
^self valueOfProperty: #relativeTextAnchorPosition!
----- Method: Morph>>relativeTextAnchorPosition: (in category '*60Deprecated-text-anchor') -----
relativeTextAnchorPosition: aPoint
self deprecated: 'Use textAnchorProperties instead'.
^self setProperty: #relativeTextAnchorPosition toValue: aPoint!
----- Method: Morph>>textAnchorType (in category '*60Deprecated-text-anchor') -----
textAnchorType
self deprecated: 'Use textAnchorProperties instead'.
^self valueOfProperty: #textAnchorType ifAbsent:[#document]!
----- Method: Morph>>textAnchorType: (in category '*60Deprecated-text-anchor') -----
textAnchorType: aSymbol
self deprecated: 'Use textAnchorProperties instead'.
aSymbol == #document
ifTrue:[^self removeProperty: #textAnchorType]
ifFalse:[^self setProperty: #textAnchorType toValue: aSymbol].!
----- Method: Morph>>toggleDragNDrop (in category '*60Deprecated-dropping/grabbing') -----
toggleDragNDrop
"Toggle this morph's ability to add and remove morphs via drag-n-drop."
self deprecated.
self enableDragNDrop: self dragNDropEnabled not.
!
----- Method: Morph>>wantsDropFiles: (in category '*60Deprecated-event handling') -----
wantsDropFiles: anEvent
"Return true if the receiver wants files dropped from the OS."
self flag: #deprecated. "Use #wantsDroppedMorph:event: instead and scan for dragTransferType: #filesAndDirectories.'"
^ false!
----- Method: UndefinedObject>>suspend (in category '*60Deprecated') -----
suspend
"Kills off processes that didn't terminate properly"
"Display reverse; reverse." "<-- So we can catch the suspend bug"
self deprecated: 'No longer necessary since we fixed the suspend bug. Keep track of your (weak) process objects so they do not turn into nil unexpectedly.'.
Processor terminateActive!
----- Method: SystemWindow>>anyOpenWindowLikeMe (in category '*60Deprecated-open/close') -----
anyOpenWindowLikeMe
self deprecated: 'Use #anyOpenWindowLikeMe: passing a concrete world object.'.
^ self anyOpenWindowLikeMeIn: Project current world!
----- Method: CodeHolder>>defaultAnnotationPaneHeight (in category '*60Deprecated-annotation') -----
defaultAnnotationPaneHeight
"Answer the receiver's preferred default height for new annotation panes."
self deprecated: 'Use ToolBuilder >> #inputFieldHeight or #inputFieldHeightFor:'.
^ 25!
----- Method: CodeHolder>>defaultButtonPaneHeight (in category '*60Deprecated-annotation') -----
defaultButtonPaneHeight
"Answer the user's preferred default height for new button panes."
self deprecated: 'Use ToolBuilder >> #buttonRowHeight'.
^ 25!
----- Method: CodeHolder>>searchPane (in category '*60Deprecated-categories & search pane') -----
searchPane
self deprecated.
^ self searchTextMorph!
----- Method: AbstractEvent class>>comment1 (in category '*60Deprecated-temporary') -----
comment1
"Smalltalk organization removeElement: #ClassForTestingSystemChanges3
Smalltalk garbageCollect
Smalltalk organizati
classify:under:
SystemChangeNotifier uniqueInstance releaseAll
SystemChangeNotifier uniqueInstance noMoreNotificationsFor: aDependent.
aDependent := SystemChangeNotifierTest new.
SystemChangeNotifier uniqueInstance
notifyOfAllSystemChanges: aDependent
using: #event:
SystemChangeNotifier uniqueInstance classAdded: #Foo inCategory: #FooCat
| eventSource dependentObject |
eventSource := EventManager new.
dependentObject := Object new.
register - dependentObject becomes dependent:
eventSource
when: #anEvent send: #error to: dependentObject.
unregister dependentObject:
eventSource removeDependent: dependentObject.
[eventSource triggerEvent: #anEvent]
on: Error
do: [:exc | self halt: 'Should not be!!']."!
----- Method: AbstractEvent class>>comment2 (in category '*60Deprecated-temporary') -----
comment2
"HTTPSocket useProxyServerNamed: 'proxy.telenet.be' port: 8080
TestRunner open
--------------------
We propose two orthogonal groups to categorize each event:
(1) the 'change type':
added, removed, modified, renamed
+ the composite 'changed' (see below for an explanation)
(2) the 'item type':
class, method, instance variable, pool variable, protocol, category
+ the composite 'any' (see below for an explanation).
The list of supported events is the cross product of these two lists (see below for an explicit enumeration of the events).
Depending on the change type, certain information related to the change is always present (for adding, the new things that was added, for removals, what was removed, for renaming, the old and the new name, etc.).
Depending on the item type, information regarding the item is present (for a method, which class it belongs to).
Certain events 'overlap', for example, a method rename triggers a class change. To capture this I impose a hierarchy on the 'item types' (just put some numbers to clearly show the idea. They don't need numbers, really. Items at a certain categories are included by items one category number higher):
level 1 category
level 2 class
level 3 instance variable, pool variable, protocol, method.
Changes propagate according to this tree: any 'added', 'removed' or 'renamed' change type in level X triggers a 'changed' change type in level X - 1. A 'modified' change type does not trigger anything special.
For example, a method additions triggers a class modification. This does not trigger a category modification.
Note that we added 'composite events': wildcards for the 'change type' ('any' - any system additions) and for the 'item type' ('Changed' - all changes related to classes), and one for 'any change systemwide' (systemChanged).
This result is this list of Events:
classAdded
classRemoved
classModified
classRenamed (?)
classChanged (composite)
methodAdded
methodRemoved
methodModified
methodRenamed (?)
methodChanged (composite)
instanceVariableAdded
instanceVariableRemoved
instanceVariableModified
instanceVariableRenamed (?)
instanceVariableChanged (composite)
protocolAdded
protocolRemoved
protocolModified
protocolRenamed (?)
protocolChanged (composite)
poolVariableAdded
poolVariableRemoved
poolVariableModified
poolVariableRenamed (?)
poolChanged (composite)
categoryAdded
categoryRemoved
categoryModified
categeryRenamed (?)
categoryChanged (composite)
anyAdded (composite)
anyRemoved (composite)
anyModified (composite)
anyRenamed (composite)
anyChanged (composite)
To check: can we pass somehow the 'source' of the change (a browser, a file-in, something else) ? Maybe by checking the context, but should not be too expensive either... I found this useful in some of my tools, but it might be too advanced to have in general. Tools that need this can always write code to check it for them. But is not always simple...
Utilities (for the recent methods) and ChangeSet are the two main clients at this moment.
Important: make it very explicit that the event is send synchronously (or asynchronously, would we take that route).
category
class
comment
protocol
method
OR
category
Smalltalk
class
comment
protocol
method
??
Smalltalk category
\ /
class
/ | \
comment | protocol
| /
method
"!
----- Method: AbstractEvent class>>comment3 (in category '*60Deprecated-temporary') -----
comment3
"Things to consider for trapping:
ClassOrganizer>>#changeFromCategorySpecs:
Problem: I want to trap this to send the appropriate bunch of ReCategorization events, but ClassOrganizer instances do not know where they belong to (what class, or what system); it just uses symbols. So I cannot trigger the change, because not enough information is available. This is a conceptual problem: the organization is stand-alone implementation-wise, while conceptually it belongs to a class. The clean solution could be to reroute this message to a class, but this does not work for all of the senders (that would work from the browserm but not for the file-in).
Browser>>#categorizeAllUncategorizedMethods
Problem: should be trapped to send a ReCategorization event. However, this is model code that should not be in the Browser. Clean solution is to move it out of there to the model, and then trap it there (or reroute it to one of the trapped places).
Note: Debugger>>#contents:notifying: recompiles methods when needed, so I trapped it to get updates. However, I need to find a way to write a unit test for this. Haven't gotten around yet for doing this though...
"!
----- Method: AbstractEvent class>>saveChangeNotificationAsSARFileWithNumber: (in category '*60Deprecated-temporary') -----
saveChangeNotificationAsSARFileWithNumber: aNumber
"Use the SARBuilder package to output the SystemChangeNotification
stuff as a SAR file. Put this statement here so that I don't forget it
when moving between images :-)"
"self saveChangeNotificationAsSARFileWithNumber: 6"
| filename changesText readmeText dumper |
self deprecated.
filename := 'SystemchangeNotification'.
dumper := self class environment at: #SARChangeSetDumper ifAbsent: [ ^self ].
changesText :=
'
0.6 Version for Squeak 3.7 (no longer for 3.6!!!!) Changed one hook method to make this version work in Squeak3.7. Download version 5 from http://www.iam.unibe.ch/~wuyts/SystemchangeNotification5.sar if you are working with Squeak 3.6.
0.5 Updated the safeguard mechanism so that clients with halts and errors do not stop all notifications. Added and updated new tests for this. If this interests you have a look at the class WeakActionSequenceTrappingErrors.
0.4 Ported to Squeak 3.6.
0.3 Added the hooks for instance variables (addition, removal and renaming). Refactored the tests.
0.2 Added hooks and tests for method removal and method recategorization.
0.1 First release'.
readmeText :=
'Implements (part of) the system change notification mechanism. Clients that want to receive notifications about system changes should look at the category #public of the class SystemChangeNotifier, and the unit tests.
VERY IMPORTANT: This version is for Squeak 3.7 only. It will not work in Squeak version 3.6. Download and install the last version that worked in Squeak 3.6 (version 5) from the following URL: http://www.iam.unibe.ch/~wuyts/SystemchangeNotification5.sar'.
(dumper
on: Project current changeSet
including: (ChangeSet allChangeSetNames
select: [:ea | 'SystemChangeHooks' match: ea])) changesText: changesText;
readmeText: readmeText;
fileOutAsZipNamed: filename , aNumber printString , '.sar'!
----- Method: CompiledBlock>>allSubLiterals (in category '*60Deprecated-literals') -----
allSubLiterals
self deprecated: 'Use #allLiterals.'.
^ self allLiterals!
Object subclass: #ColorTheme
instanceVariableNames: ''
classVariableNames: 'Current'
poolDictionaries: ''
category: '60Deprecated-System-Support'!
----- Method: ColorTheme class>>apply (in category 'applying') -----
apply
^self new apply!
----- Method: ColorTheme class>>applyTheme: (in category 'applying') -----
applyTheme: aThemeClass
aThemeClass new apply!
----- Method: ColorTheme class>>current (in category 'accessing') -----
current
^ Current
ifNil: [self defaultTheme apply]!
----- Method: ColorTheme class>>current: (in category 'accessing') -----
current: aColorTheme
Current := aColorTheme!
----- Method: ColorTheme class>>defaultTheme (in category 'accessing') -----
defaultTheme
^ self new.!
----- Method: ColorTheme>>apply (in category 'applying') -----
apply
"apply the receiver as the current theme"
BalloonMorph balloonColor: self balloonColor.
Preferences setParameter: #defaultWorldColor to: self defaultWorldColor.
Preferences setParameter: #insertionPointColor to: self insertionPointColor.
Preferences setParameter: #keyboardFocusColor to: self keyboardFocusColor.
Preferences setParameter: #textHighlightColor to: self textHighlightColor.
Preferences setParameter: #menuTitleColor to: self menuTitleColor.
Preferences setParameter: #menuTitleBorderColor to: self menuTitleBorderColor.
Preferences setParameter: #menuTitleBorderWidth to: self menuTitleBorderWidth.
Preferences setParameter: #menuColor to: self menuColor.
Preferences setParameter: #menuBorderColor to: self menuBorderColor.
Preferences setParameter: #menuLineColor to: self menuLineColor.
Preferences setParameter: #menuBorderWidth to: self menuBorderWidth.
Preferences setParameter: #menuSelectionColor to: self menuSelectionColor.
SystemProgressMorph reset.
self class current: self.
!
----- Method: ColorTheme>>balloonColor (in category 'theme') -----
balloonColor
^ TranslucentColor
r: 0.92
g: 0.92
b: 0.706
alpha: 0.75!
----- Method: ColorTheme>>cancelColor (in category 'theme') -----
cancelColor
^ Color lightRed!
----- Method: ColorTheme>>defaultWorldColor (in category 'theme') -----
defaultWorldColor
^ Color blue muchLighter!
----- Method: ColorTheme>>dialog3DTitles (in category 'theme - dialogs') -----
dialog3DTitles
^ true!
----- Method: ColorTheme>>dialogBorderColor (in category 'theme - dialogs') -----
dialogBorderColor
^ Color fromArray: #(0.355 0.516 1.0 )!
----- Method: ColorTheme>>dialogBorderWidth (in category 'theme - dialogs') -----
dialogBorderWidth
^ 4!
----- Method: ColorTheme>>dialogButtonBorderWidth (in category 'theme - dialogs') -----
dialogButtonBorderWidth
^ 0!
----- Method: ColorTheme>>dialogColor (in category 'theme - dialogs') -----
dialogColor
^ Color paleYellow!
----- Method: ColorTheme>>dialogPaneBorderColor (in category 'theme - dialogs') -----
dialogPaneBorderColor
^ Color black
!
----- Method: ColorTheme>>dialogPaneBorderWidth (in category 'theme - dialogs') -----
dialogPaneBorderWidth
^ 0!
----- Method: ColorTheme>>dialogPaneRampOrColor (in category 'theme - dialogs') -----
dialogPaneRampOrColor
^ {0.0 -> (Color r: 0.742 g: 0.871 b: 1.0).
1.0 -> (Color r: 0.516 g: 0.645 b: 1.0)}!
----- Method: ColorTheme>>dialogRampOrColor (in category 'theme - dialogs') -----
dialogRampOrColor
^ {0.0 -> (Color r: 0.516 g: 0.645 b: 1.0).
1.0 -> (Color r: 0.742 g: 0.871 b: 1.0)}!
----- Method: ColorTheme>>dialogTextBoxBorderColor (in category 'theme - dialogs') -----
dialogTextBoxBorderColor
^ Color black!
----- Method: ColorTheme>>dialogTextBoxColor (in category 'theme - dialogs') -----
dialogTextBoxColor
^ Color white!
----- Method: ColorTheme>>disabledColor (in category 'theme') -----
disabledColor
^ Color lightGray!
----- Method: ColorTheme>>dockingBarAutoGradient (in category 'theme - dockingbar') -----
dockingBarAutoGradient
^ true!
----- Method: ColorTheme>>dockingBarColor (in category 'theme - dockingbar') -----
dockingBarColor
^ Color r: 0.6 g: 0.7 b: 1!
----- Method: ColorTheme>>dockingBarGradientRamp (in category 'theme - dockingbar') -----
dockingBarGradientRamp
^ { 0.0 -> Color white.
1.0 -> (Color r: 0.6 g: 0.7 b: 1) }!
----- Method: ColorTheme>>helpColor (in category 'theme') -----
helpColor
^ Color lightGreen!
----- Method: ColorTheme>>insertionPointColor (in category 'theme') -----
insertionPointColor
^ Color red!
----- Method: ColorTheme>>keyboardFocusColor (in category 'theme') -----
keyboardFocusColor
^ Color r: 0.6 g: 1 b: 1!
----- Method: ColorTheme>>menuBorderColor (in category 'theme - menus') -----
menuBorderColor
^ Color r: 0.2 g: 0.3 b: 0.9!
----- Method: ColorTheme>>menuBorderWidth (in category 'theme - menus') -----
menuBorderWidth
^ 2!
----- Method: ColorTheme>>menuColor (in category 'theme - menus') -----
menuColor
^ Color r: 0.85 g: 0.9 b: 1!
----- Method: ColorTheme>>menuLineColor (in category 'theme - menus') -----
menuLineColor
^ Color r: 0.6 g: 0.7 b: 1!
----- Method: ColorTheme>>menuSelectionColor (in category 'theme - menus') -----
menuSelectionColor
^ Color r: 0.2 g: 0.3 b: 0.9!
----- Method: ColorTheme>>menuTitleBorderColor (in category 'theme - menus') -----
menuTitleBorderColor
^ Color r: 0.6 g: 0.7 b: 1!
----- Method: ColorTheme>>menuTitleBorderWidth (in category 'theme - menus') -----
menuTitleBorderWidth
^ 6!
----- Method: ColorTheme>>menuTitleColor (in category 'theme - menus') -----
menuTitleColor
^ Color r: 0.6 g: 0.7 b: 1!
----- Method: ColorTheme>>okColor (in category 'theme') -----
okColor
^ Color lightGreen!
----- Method: ColorTheme>>textHighlightColor (in category 'theme') -----
textHighlightColor
^ Color blue muchLighter alpha: 0.7!
Object subclass: #HTTPClient
instanceVariableNames: ''
classVariableNames: 'BrowserSupportsAPI RunningInBrowser'
poolDictionaries: ''
category: '60Deprecated-System-Support'!
----- Method: HTTPClient class>>browserSupportsAPI (in category 'class initialization') -----
browserSupportsAPI
^BrowserSupportsAPI == true!
----- Method: HTTPClient class>>browserSupportsAPI: (in category 'class initialization') -----
browserSupportsAPI: aBoolean
BrowserSupportsAPI := aBoolean!
----- Method: HTTPClient class>>composeMailTo:subject:body: (in category 'utilities') -----
composeMailTo: address subject: subject body: body
"HTTPClient composeMailTo: 'michael.rueger at squeakland.org' subject: 'test subject' body: 'message' "
| mailTo |
mailTo := WriteStream on: String new.
mailTo nextPutAll: 'mailto:'.
mailTo
nextPutAll: address;
nextPut: $?.
subject isEmptyOrNil
ifFalse: [mailTo nextPutAll: 'subject='; nextPutAll: subject; nextPut: $&].
body isEmptyOrNil
ifFalse: [mailTo nextPutAll: 'body='; nextPutAll: body].
self httpGet: mailTo contents!
----- Method: HTTPClient class>>determineIfRunningInBrowser (in category 'class initialization') -----
determineIfRunningInBrowser
"HTTPClient determineIfRunningInBrowser"
RunningInBrowser := StandardFileStream isRunningAsBrowserPlugin
!
----- Method: HTTPClient class>>exampleMailTo (in category 'examples') -----
exampleMailTo
"HTTPClient exampleMailTo"
HTTPClient mailTo: 'm.rueger at acm.org' message: 'A test message from within Squeak'
!
----- Method: HTTPClient class>>examplePostArgs (in category 'examples') -----
examplePostArgs
"HTTPClient examplePostArgs"
| args result |
args := Dictionary new
at: 'arg1' put: #('val1');
at: 'arg2' put: #('val2');
yourself.
result := HTTPClient httpPostDocument: 'http://www.squeaklet.com/cgi-bin/thrd.pl [^]' args: args.
Transcript show: result content; cr; cr.
!
----- Method: HTTPClient class>>examplePostMultipart (in category 'examples') -----
examplePostMultipart
"HTTPClient examplePostMultipart"
| args result |
args := Dictionary new
at: 'arg1' put: #('val1');
at: 'arg2' put: #('val2');
yourself.
result := HTTPClient httpPostMultipart: 'http://www.squeaklet.com/cgi-bin/thrd.pl' args: args.
Transcript show: result content; cr; cr.
!
----- Method: HTTPClient class>>getDirectoryListing: (in category 'utilities') -----
getDirectoryListing: dirListURL
"HTTPClient getDirectoryListing: 'http://www.squeakalpha.org/uploads' "
| answer ftpEntries |
" answer := self
httpPostDocument: dirListURL
args: Dictionary new."
"Workaround for Mac IE problem"
answer := self httpGetDocument: dirListURL.
answer isString
ifTrue: [^self error: 'Listing failed: ' , answer]
ifFalse: [answer := answer content].
answer first == $<
ifTrue: [self error: 'Listing failed: ' , answer].
ftpEntries := answer findTokens: String crlf.
^ ftpEntries
collect:[:ftpEntry | ServerDirectory parseFTPEntry: ftpEntry]
thenSelect: [:entry | entry notNil]!
----- Method: HTTPClient class>>httpGet: (in category 'post/get') -----
httpGet: url
| document |
document := self httpGetDocument: url.
^(document isString)
ifTrue: [
"strings indicate errors"
document]
ifFalse: [(RWBinaryOrTextStream with: document content) reset]!
----- Method: HTTPClient class>>httpGetDocument: (in category 'post/get') -----
httpGetDocument: url
| stream content |
^self shouldUsePluginAPI
ifTrue: [
stream := FileStream requestURLStream: url ifError: [self error: 'Error in get from ' , url printString].
stream ifNil: [^''].
stream position: 0.
content := stream upToEnd.
stream close.
MIMEDocument content: content]
ifFalse: [HTTPSocket httpGetDocument: url]!
----- Method: HTTPClient class>>httpPostDocument:args: (in category 'post/get') -----
httpPostDocument: url args: argsDict
^self httpPostDocument: url target: nil args: argsDict!
----- Method: HTTPClient class>>httpPostDocument:target:args: (in category 'post/get') -----
httpPostDocument: url target: target args: argsDict
| argString stream content |
^self shouldUsePluginAPI
ifTrue: [
argString := argsDict
ifNotNil: [argString := HTTPSocket argString: argsDict]
ifNil: [''].
stream := FileStream post: argString , ' ' target: target url: url , argString ifError: [self error: 'Error in post to ' , url printString].
stream position: 0.
content := stream upToEnd.
stream close.
MIMEDocument content: content]
ifFalse: [HTTPSocket httpPostDocument: url args: argsDict]!
----- Method: HTTPClient class>>httpPostMultipart:args: (in category 'post/get') -----
httpPostMultipart: url args: argsDict
" do multipart/form-data encoding rather than x-www-urlencoded "
^self shouldUsePluginAPI
ifTrue: [self pluginHttpPostMultipart: url args: argsDict]
ifFalse: [HTTPSocket httpPostMultipart: url args: argsDict accept: nil request: '']!
----- Method: HTTPClient class>>isRunningInBrowser (in category 'testing') -----
isRunningInBrowser
RunningInBrowser isNil
ifTrue: [self determineIfRunningInBrowser].
^RunningInBrowser!
----- Method: HTTPClient class>>isRunningInBrowser: (in category 'testing') -----
isRunningInBrowser: aBoolean
"Override the automatic process.
This should be used with caution.
One way to determine it without using the primitive is to check for parameters typically only encountered when running as a plugin."
RunningInBrowser := aBoolean!
----- Method: HTTPClient class>>mailTo:message: (in category 'utilities') -----
mailTo: address message: aString
HTTPClient shouldUsePluginAPI
ifFalse: [^self error: 'You need to run inside a web browser.'].
FileStream post: aString url: 'mailto:' , address ifError: [self error: 'Can not send mail']!
----- Method: HTTPClient class>>pluginHttpPostMultipart:args: (in category 'private') -----
pluginHttpPostMultipart: url args: argsDict
| mimeBorder argsStream crLf resultStream result |
" do multipart/form-data encoding rather than x-www-urlencoded "
crLf := String crlf.
mimeBorder := '----squeak-', Time millisecondClockValue printString, '-stuff-----'.
"encode the arguments dictionary"
argsStream := WriteStream on: String new.
argsDict associationsDo: [:assoc |
assoc value do: [ :value | | fieldValue |
"print the boundary"
argsStream nextPutAll: '--', mimeBorder, crLf.
" check if it's a non-text field "
argsStream nextPutAll: 'Content-disposition: form-data; name="', assoc key, '"'.
(value isKindOf: MIMEDocument)
ifFalse: [fieldValue := value]
ifTrue: [argsStream nextPutAll: ' filename="', value url pathForFile, '"', crLf, 'Content-Type: ', value contentType.
fieldValue := (value content
ifNil: [(FileStream fileNamed: value url pathForFile) contentsOfEntireFile]
ifNotNil: [value content]) asString].
" Transcript show: 'field=', key, '; value=', fieldValue; cr. "
argsStream nextPutAll: crLf, crLf, fieldValue, crLf.
]].
argsStream nextPutAll: '--', mimeBorder, '--'.
resultStream := FileStream
post:
('ACCEPT: text/html', crLf,
'User-Agent: Squeak 3.1', crLf,
'Content-type: multipart/form-data; boundary=', mimeBorder, crLf,
'Content-length: ', argsStream contents size printString, crLf, crLf,
argsStream contents)
url: url ifError: [^'Error in post ' url asString].
"get the header of the reply"
result := resultStream
ifNil: ['']
ifNotNil: [resultStream upToEnd].
^MIMEDocument content: result!
----- Method: HTTPClient class>>requestURL:target: (in category 'post/get') -----
requestURL: url target: target
^self shouldUsePluginAPI
ifTrue: [FileStream requestURL: url target: target]
ifFalse: [self error: 'Requesting a new URL target is not supported.']!
----- Method: HTTPClient class>>shouldUsePluginAPI (in category 'testing') -----
shouldUsePluginAPI
"HTTPClient shouldUsePluginAPI"
self isRunningInBrowser
ifFalse: [^false].
self browserSupportsAPI
ifFalse: [^false].
"The Mac plugin calls do not work in full screen mode"
^((Smalltalk platformName = 'Mac OS')
and: [DisplayScreen displayIsFullScreen]) not!
----- Method: HTTPClient class>>tellAFriend:url:name: (in category 'MorphicExtras-utilities') -----
tellAFriend: emailAddressOrNil url: urlForLoading name: projectName
| recipient subject body linkToInclude |
recipient := emailAddressOrNil ifNil: ['RECIPIENT.GOESHERE'].
subject := 'New/Updated Squeak project'.
body := 'This is a link to the Squeak project ' , projectName , ': ' , String crlf.
linkToInclude := urlForLoading.
HTTPClient shouldUsePluginAPI
ifTrue: [
self composeMailTo: recipient subject: subject body: body , (linkToInclude copyReplaceAll: '%' with: '%25')]
ifFalse: [FancyMailComposition new
celeste: nil
to: recipient
subject: subject
initialText: body
theLinkToInclude: linkToInclude;
open].!
----- Method: HTTPClient class>>uploadFileNamed:to:user:passwd: (in category 'utilities') -----
uploadFileNamed: aFilename to: baseUrl user: user passwd: passwd
| fileContents remoteFilename |
remoteFilename := (baseUrl endsWith: '/')
ifTrue: [baseUrl , '/' , aFilename]
ifFalse: [baseUrl , aFilename].
fileContents := (StandardFileStream readOnlyFileNamed: aFilename) contentsOfEntireFile.
HTTPSocket httpPut: fileContents to: remoteFilename user: user passwd: passwd!
----- Method: Object class>>windowColorSpecification (in category '*60Deprecated-window color') -----
windowColorSpecification
"Answer a WindowColorSpec object that declares my preference.
This is a backstop for classes that don't otherwise define a preference."
self deprecated: 'Use UserInterfaceTheme instead.'.
^ WindowColorSpec classSymbol: self name
wording: 'Default' translatedNoop brightColor: #white
pastelColor: #white
helpMessage: 'Other windows without color preferences.' translatedNoop!
----- Method: Object>>clone (in category '*60Deprecated-copying') -----
clone
"Answer a shallow copy of the receiver."
self deprecated: 'Use #shallowCopy'.
^self shallowCopy!
----- Method: Object>>exploreAndYourself (in category '*60Deprecated-Tools') -----
exploreAndYourself
self deprecated: 'Use #explore because it does not return the tool window anymore. Only calls via ToolSet do so.'.
self explore!
----- Method: Object>>ifNil:ifNotNilDo: (in category '*60Deprecated-accessing') -----
ifNil: nilBlock ifNotNilDo: aBlock
self flag: #deprecated. "#ifNil:ifNotNil: does the job"
^self ifNil: nilBlock ifNotNil: aBlock!
----- Method: Object>>ifNotNilDo: (in category '*60Deprecated-accessing') -----
ifNotNilDo: aBlock
self flag: #deprecated. "#ifNotNil: does the job"
^self ifNotNil: aBlock
!
----- Method: Object>>ifNotNilDo:ifNil: (in category '*60Deprecated-accessing') -----
ifNotNilDo: aBlock ifNil: nilBlock
self flag: #deprecated. "#ifNotNil:ifNil: does the job"
^self ifNotNil: aBlock ifNil: nilBlock
!
----- Method: Object>>notifyWithLabel: (in category '*60Deprecated-Tools') -----
notifyWithLabel: aString
"Create and schedule a Notifier with aString as the window label as well as the contents of the window, in order to request confirmation before a process can proceed."
self deprecated.
self notify: aString.
"nil notify: 'let us see if this works'"!
Object subclass: #StandardFileMenuResult
instanceVariableNames: 'directory name'
classVariableNames: ''
poolDictionaries: ''
category: '60Deprecated-Tools-Menus'!
!StandardFileMenuResult commentStamp: 'tpr 1/8/2019 13:34' prior: 0!
Deprecated: please don't use this class any more. It is part of the deprecated StandardFileMenu system.
A StandardFileMenuResult is xxxxxxxxx.
Instance Variables
directory: <Object>
name: <Object>
directory
- xxxxx
name
- xxxxx
!
----- Method: StandardFileMenuResult class>>directory:name: (in category 'instance creation') -----
directory: aDirectory name: aString
^super new directory: aDirectory name: aString!
----- Method: StandardFileMenuResult>>directory (in category 'accessing') -----
directory
^directory!
----- Method: StandardFileMenuResult>>directory: (in category 'accessing') -----
directory: aDirectory
^directory := aDirectory!
----- Method: StandardFileMenuResult>>directory:name: (in category 'private') -----
directory: aDirectory name: aString
directory := aDirectory.
name := aString.
^self!
----- Method: StandardFileMenuResult>>isCommand (in category 'testing') -----
isCommand
^name isNil!
----- Method: StandardFileMenuResult>>isDirectory (in category 'testing') -----
isDirectory
^name = ''!
----- Method: StandardFileMenuResult>>name (in category 'accessing') -----
name
^name!
----- Method: StandardFileMenuResult>>name: (in category 'accessing') -----
name: aString
^name := aString!
----- Method: StandardFileMenuResult>>printOn: (in category 'accessing') -----
printOn: aStream
super printOn: aStream.
aStream nextPutAll: ' with directory: '.
directory printOn: aStream.
aStream nextPutAll: ' name: '.
name printOn: aStream
"StandardFileMenu oldFile"!
Object subclass: #TTFileDescription
instanceVariableNames: 'fileName fileOffset familyName subfamilyName copyright ascender descender lineGap unitsPerEm numGlyphs indexToLocOffset indexToLocFormat glyphTableOffset cmapType cmapOffset numHMetrics hmtxTableOffset sTypoAscender sTypoDescender sTypoLineGap sxHeight sCapHeight minCodePoint maxCodePoint'
classVariableNames: 'AllFontsAndFiles FontPaths'
poolDictionaries: ''
category: '60Deprecated-TrueType-Fonts'!
!TTFileDescription commentStamp: 'mt 2/18/2022 15:01' prior: 0!
Original comment from ar 7/29/2009 22:18:
Contrary to TTFontDescritption, this class leaves true type files on disk and only reads the required portions when constructing glyphs. This avoids the need of reading the entire font into memory at the cost of having to hit disk whenever a glyph is requested.
**
In 2022, we combined the two TrueType parsers -- one in TTFileDescription and one in TTFontReader -- into a single TTFontReader. A specialization of TTFontDescription, namely TTRemoteFontDescription, can use TTFontReader to also fetch glyph data on demand.!
----- Method: TTFileDescription class>>allFamilyNamesAndFiles (in category 'font paths') -----
allFamilyNamesAndFiles
"Answer a dictionary of all known family names and their corresponding file names."
AllFontsAndFiles ifNil:[
AllFontsAndFiles := Dictionary new.
Cursor wait showWhile:[self allFontsDo:[:font|
| names |
names := AllFontsAndFiles at: font familyName
ifAbsentPut:[OrderedCollection new].
names add: font fileName]]].
^AllFontsAndFiles !
----- Method: TTFileDescription class>>allFontsAndFiles (in category 'font paths') -----
allFontsAndFiles
"Answer a dictionary of all known family names and their corresponding file names."
AllFontsAndFiles ifNil:[
AllFontsAndFiles := Dictionary new.
Cursor wait showWhile:[self allFontsDo:[:font|
| names |
names := AllFontsAndFiles at: font familyName
ifAbsentPut:[OrderedCollection new].
names add: font fileName]]].
^AllFontsAndFiles !
----- Method: TTFileDescription class>>allFontsDo: (in category 'font paths') -----
allFontsDo: aBlock
"Evaluate aBlock with all the fonts we can find. Use sparingly."
self fontPathsDo:[:path|
self fontFilesIn: path do:[:font|
font familyName
ifNotNil:[aBlock value: font]]]!
----- Method: TTFileDescription class>>findFontFile: (in category 'font paths') -----
findFontFile: fontFileName
"Find the path containing the font with the given name.
If it can't be found, return nil."
self fontPathsDo:[:path|
| fd |
fd := FileDirectory on: path.
([fd fileExists: fontFileName] on: Error do:[false])
ifTrue:[^fd fullNameFor: fontFileName].
].
^nil!
----- Method: TTFileDescription class>>fontFilesIn:do: (in category 'font paths') -----
fontFilesIn: path do: aBlock
"TTFileDescription loadAllFilesIn: 'C:\Windows\Fonts'"
"Load all the TTF files we can find in the given path"
| fd |
fd := FileDirectory on: path.
(fd fileNamesMatching: '*.ttf;*.ttc') do:[:fn|
([self readFontsFrom: fn] on: Error do: [#()]) do: aBlock ]!
----- Method: TTFileDescription class>>fontFromUser (in category 'user interaction') -----
fontFromUser
"TTFileDescription fontFromUser"
^self fontFromUser: TextStyle defaultFont!
----- Method: TTFileDescription class>>fontFromUser: (in category 'user interaction') -----
fontFromUser: priorFont
^self fontFromUser: priorFont allowKeyboard: true!
----- Method: TTFileDescription class>>fontFromUser:allowKeyboard: (in category 'user interaction') -----
fontFromUser: priorFont allowKeyboard: aBoolean
"TTFileDescription fontFromUser"
| fontMenu fontNames builder resultBlock style font widget result |
builder := ToolBuilder default.
fontNames := self allFontsAndFiles keys asArray sort.
fontMenu := builder pluggableMenuSpec new.
fontMenu label: 'Non-portable fonts'.
resultBlock := [:value| result := value].
fontNames do: [:fontName | | active ptMenu item |
active := priorFont familyName sameAs: fontName.
ptMenu := builder pluggableMenuSpec new.
TTCFont pointSizes do: [:pt | | label |
label := pt printString, ' pt'.
item := ptMenu add: label
target: resultBlock
selector: #value:
argumentList: {{fontName. pt}}.
item checked: (active and:[pt = priorFont pointSize]).
].
item := fontMenu add: fontName action: nil.
item subMenu: ptMenu.
item checked: active.
].
widget := builder open: fontMenu.
builder runModal: widget.
result ifNil:[^nil].
style := (TextStyle named: result first) ifNil:[self installFamilyNamed: result first].
style ifNil: [^ self].
font := style fonts detect: [:any | any pointSize = result last] ifNone: [nil].
^ font
!
----- Method: TTFileDescription class>>fontOffsetsInFile: (in category 'instance creation') -----
fontOffsetsInFile: file
"Answer a collection of font offsets in the given file"
| tag version nFonts |
file position: 0.
tag := file next: 4.
tag caseOf: {
['true' asByteArray] -> ["Version 1.0 TTF file"
"http://developer.apple.com/textfonts/TTRefMan/RM06/Chap6.html
The values 'true' (0x74727565) and 0x00010000 are recognized by the Mac OS
as referring to TrueType fonts."
^Array with: 0 "only one font"
].
[#[0 1 0 0]] -> ["Version 1.0 TTF file"
^Array with: 0 "only one font"
].
['ttcf' asByteArray] -> ["TTC file"
version := file next: 4.
(version = #[0 1 0 0] or: [version = #[0 2 0 0]]) ifFalse: [^self error: 'Unsupported TTC version'].
nFonts := file nextNumber: 4.
^(1 to: nFonts) collect: [:i | file nextNumber: 4].
].
} otherwise:[
self error: 'This is not a valid Truetype file'.
].!
----- Method: TTFileDescription class>>fontPathsDo: (in category 'font paths') -----
fontPathsDo: aBlock
"Evaluate aBlock with all of the font paths that should be searched on the current platform"
"Start with the current directory"
aBlock value: FileDirectory default pathName.
"Then subdirectory 'fonts'"
aBlock value: (FileDirectory default directoryNamed: 'fonts') pathName.
"Platform specific directories"
Smalltalk platformName caseOf:{
['Win32'] -> [
"Standard Windows fonts directory"
aBlock value: 'C:\Windows\Fonts'.
].
['Mac OS'] -> [
"Standard system fonts directories"
#('/System/Library/Fonts' '/Library/Fonts') do: [:fontDir |
aBlock value: fontDir].
].
['unix'] -> [ | base |
"Standard fonts are in /usr/share/fonts/*"
base := '/usr/share/fonts'.
(FileDirectory on: base) directoryTreeDo: [ :path |
path last isDirectory ifTrue: [
aBlock value: path last fullName ] ].
].
} otherwise:[].
!
----- Method: TTFileDescription class>>initialize (in category 'class initialization') -----
initialize
"TTFileDescription initialize"
Smalltalk addToShutDownList: self.
FontPaths := Dictionary new.
AllFontsAndFiles := nil.!
----- Method: TTFileDescription class>>installFamilyNamed: (in category 'instance creation') -----
installFamilyNamed: familyName
"Install all the corresponding fonts for this family"
"
TTFileDescription installFamilyNamed: 'Arial'.
TTFileDescription installFamilyNamed: 'Batang'.
"
| fontFiles |
fontFiles := self allFontsAndFiles at: familyName ifAbsent:[#()].
fontFiles do:[:fileName| | ttDesc |
ttDesc := (self readFontsFrom: fileName) detect:[:fnt| fnt familyName = familyName].
TTCFont newTextStyleFromTT: ttDesc.
].
^TextStyle named: familyName!
----- Method: TTFileDescription class>>loadAllFontFiles (in category 'examples') -----
loadAllFontFiles
"Load all the TTF files we can find in all font paths"
"
TTFileDescription loadAllFontFiles.
"
self fontPathsDo:[:path| | fd |
fd := FileDirectory on: path.
(fd fileNamesMatching: '*.ttf;*.ttc') do:[:fn|
(self readFontsFrom: fn) do:[:font|
(1 to: font numGlyphs)
do:[:i| font readGlyphAt: i-1]
displayingProgress: 'Reading ', font name].
] displayingProgress: 'Scanning ', path.
].!
----- Method: TTFileDescription class>>openFontFile:do: (in category 'instance creation') -----
openFontFile: fontFileName do: aBlock
"Open the font with the given font file name"
| fontFilePath file |
fontFilePath := FontPaths at: fontFileName
ifAbsentPut:[self findFontFile: fontFileName].
fontFilePath ifNil:[^nil].
file := [FileStream readOnlyFileNamed: fontFilePath] on: Error do:[:ex|
"We lost the font; someone might have moved it away"
fontFilePath removeKey: fontFileName ifAbsent:[].
^nil
].
^[aBlock value: file binary] ensure:[file close].!
----- Method: TTFileDescription class>>readFontsFrom: (in category 'instance creation') -----
readFontsFrom: aFilename
"Reads and returns all the fonts in the given file"
"
TTFileDescription readFontsFrom: 'batang.ttc'.
"
^self openFontFile: aFilename do:[:file|
(self fontOffsetsInFile: file)
collect:[:offset| self new on: aFilename offset: offset]
thenSelect:[:font| font notNil]].
!
----- Method: TTFileDescription class>>shutDown (in category 'class initialization') -----
shutDown
"Flush my caches"
FontPaths := Dictionary new.
AllFontsAndFiles := nil.!
----- Method: TTFileDescription>>ascender (in category 'accessing') -----
ascender
"Ascender of the font. Relative to unitsPerEm.
Easily confused with the typographic ascender."
^ascender!
----- Method: TTFileDescription>>at: (in category 'accessing') -----
at: charOrCode
"Compatibility with TTFontDescription"
^self glyphAt: charOrCode!
----- Method: TTFileDescription>>cacheGlyphDataDuring: (in category 'glyphs') -----
cacheGlyphDataDuring: aBlock
"We don't have an extra cache."
^ aBlock value!
----- Method: TTFileDescription>>capHeight (in category 'accessing') -----
capHeight
"https://docs.microsoft.com/en-us/typography/opentype/spec/os2#scapheight
This metric specifies the distance between the baseline and the approximate height of uppercase letters measured in FUnits. This value would normally be specified by a type designer but in situations where that is not possible, for example when a legacy font is being converted, the value may be set equal to the top of the unscaled and unhinted glyph bounding box of the glyph encoded at U+0048 (LATIN CAPITAL LETTER H). If no glyph is encoded in this position the field should be set to 0."
^ sCapHeight ifNil: [
| glyph |
glyph := self at: 16r48 "$H".
glyph isFallback
ifTrue: [sCapHeight := 0]
ifFalse: [sCapHeight := glyph bounds bottom "=top ..."] ]!
----- Method: TTFileDescription>>childGlyphAt:in:fromFile: (in category 'glyphs') -----
childGlyphAt: glyphIndex in: glyphCache fromFile: fontFile
"Get the glyph with the given glyph index. Look in cache first, then read from file.
Ensure file is positioned at point where it was when it came here."
^glyphCache at: glyphIndex ifAbsentPut:[ | glyph filePos |
filePos := fontFile position.
glyph := self readGlyphAt: glyphIndex fromFile: fontFile.
fontFile position: filePos.
glyph].!
----- Method: TTFileDescription>>copyright (in category 'accessing') -----
copyright
^ copyright!
----- Method: TTFileDescription>>descender (in category 'accessing') -----
descender
"Descender of the font. Relative to unitsPerEm.
Easily confused with the typographic descender."
^descender!
----- Method: TTFileDescription>>displayAll (in category 'private') -----
displayAll
"Read all the glyphs and display them"
| glyph form scale points x y |
points := 24.
scale := points asFloat / unitsPerEm.
x := y := 0.
Display deferUpdates: true.
1 to: numGlyphs do:[:i|
glyph := self readGlyphAt: i-1.
form := glyph asFormWithScale: scale
ascender: ascender
descender: descender.
Display fillWhite: (x at y extent: form extent).
form displayOn: Display at: x at y rule: 34.
Display forceToScreen: (x at y extent: form extent).
x := x + form width.
x > Display width ifTrue:[y := y + form height. x := 0].
y > Display height ifTrue:[y := 0].
Sensor anyButtonPressed ifTrue:[^Display restore].
].!
----- Method: TTFileDescription>>externalLeading (in category 'rendering') -----
externalLeading
"https://freetype.org/freetype2/docs/glyphs/glyphs-3.html"
^ lineGap!
----- Method: TTFileDescription>>fallbackGlyph (in category 'glyphs') -----
fallbackGlyph
"Answer the fallback glyph, the first in the loca table "
| glyph |
self withFileDo:[:fontFile|
glyph := self readGlyphAt: 0 fromFile: fontFile.
self updateGlyphMetrics: glyph fromFile: fontFile.
].
^glyph!
----- Method: TTFileDescription>>familyName (in category 'accessing') -----
familyName
"The family name for the font"
^familyName!
----- Method: TTFileDescription>>fileName (in category 'accessing') -----
fileName
"The name of the Truetype file"
^fileName!
----- Method: TTFileDescription>>fileOffset (in category 'accessing') -----
fileOffset
^fileOffset!
----- Method: TTFileDescription>>findTable:in: (in category 'ttf tables') -----
findTable: tag in: fontFile
"Position the fontFile at the beginning of the table with the given tag.
Answer true if we found the table, false otherwise."
| maxTables chksum offset length table |
fontFile position: fileOffset.
fontFile skip: 4. "version"
maxTables := fontFile nextNumber: 2.
fontFile skip: 6.
1 to: maxTables do:[:i|
table := (fontFile next: 4) asString.
chksum := fontFile nextNumber: 4.
offset := fontFile nextNumber: 4.
length := fontFile nextNumber: 4.
table = tag ifTrue:[
fontFile position: offset.
^true].
].
chksum. length. "fake usage"
^false!
----- Method: TTFileDescription>>fontHeight (in category 'accessing') -----
fontHeight
^ascender - descender!
----- Method: TTFileDescription>>getGlyphFlagsFrom:size: (in category 'glyphs') -----
getGlyphFlagsFrom: fontFile size: nPts
"Read in the flags for this glyph. The outer loop gathers the flags that
are actually contained in the table. If the repeat bit is set in a flag
then the next byte is read from the table; this is the number of times
to repeat the last flag. The inner loop does this, incrementing the
outer loops index each time."
| flags index repCount flagBits |
flags := ByteArray new: nPts.
index := 1.
[index <= nPts] whileTrue:[
flagBits := fontFile next.
flags at: index put: flagBits.
(flagBits bitAnd: 8) = 8 ifTrue:[
repCount := fontFile next.
repCount timesRepeat:[
index := index + 1.
flags at: index put: flagBits]].
index := index + 1].
^flags!
----- Method: TTFileDescription>>glyphAt: (in category 'glyphs') -----
glyphAt: charOrCode
"Answer the glyph with the given code point"
| codePoint glyph |
codePoint := charOrCode asCharacter charCode.
self withFileDo:[:fontFile| | glyphIndex |
glyphIndex := self readCmapTableAt: codePoint fromFile: fontFile.
glyph := self readGlyphAt: glyphIndex fromFile: fontFile.
self updateGlyphMetrics: glyph fromFile: fontFile.
].
^glyph!
----- Method: TTFileDescription>>hasGlyphForCode: (in category 'testing') -----
hasGlyphForCode: aCharacterCode
^ (self at: aCharacterCode) isFallback not!
----- Method: TTFileDescription>>internalLeading (in category 'rendering') -----
internalLeading
"https://freetype.org/freetype2/docs/glyphs/glyphs-3.html"
^ ascender - descender - unitsPerEm!
----- Method: TTFileDescription>>isProtected (in category 'testing') -----
isProtected
^ false!
----- Method: TTFileDescription>>isRegular (in category 'testing') -----
isRegular
"Answer true if I am a Regular/Roman font (i.e. not bold, etc.)"
^ (TTCFont indexOfSubfamilyName: (self subfamilyName)) = 0.
!
----- Method: TTFileDescription>>isRemoteFont (in category 'testing') -----
isRemoteFont
"Answer whether the receiver get's its data from an external file."
^ true!
----- Method: TTFileDescription>>isSymbolFont (in category 'testing') -----
isSymbolFont
^ false!
----- Method: TTFileDescription>>lineGap (in category 'accessing') -----
lineGap
"Leading of the font. Relative to unitsPerEm.
Easily confused with the typographic linegap."
^lineGap!
----- Method: TTFileDescription>>maxCodePoint (in category 'accessing') -----
maxCodePoint
^ maxCodePoint ifNil: [maxCodePoint := ((self size - 1 to: 0 by: -1)
detect: [:ea | (self at: ea) isFallback not] ifNone: [0])]!
----- Method: TTFileDescription>>minCodePoint (in category 'accessing') -----
minCodePoint
^ minCodePoint ifNil: [minCodePoint := (0 to: self size - 1)
detect: [:ea | (self at: ea) isFallback not] ifNone: [1]]!
----- Method: TTFileDescription>>name (in category 'accessing') -----
name
"For compatibility with TTFontDescription"
^familyName copyWithout: Character space!
----- Method: TTFileDescription>>numGlyphs (in category 'accessing') -----
numGlyphs
"The number of glyphs represented in this font"
^numGlyphs!
----- Method: TTFileDescription>>on: (in category 'initialize') -----
on: aFileName
"Initialize the receiver from a file name"
fileName := aFileName.
self withFileDo:[:fontFile|
(self findTable: 'head' in: fontFile)
ifFalse:[^self error: 'File does not have a header table'].
self processFontHeaderTable: fontFile.
(self findTable: 'maxp' in: fontFile)
ifFalse:[^self error: 'File does not have a profile table'].
self processMaximumProfileTable: fontFile.
(self findTable: 'name' in: fontFile)
ifFalse:[^self error: 'File does not have a naming table'].
self processNamingTable: fontFile.
(self findTable: 'hhea' in: fontFile)
ifFalse:[^self error: 'File does not have a horizontal header table'].
self processHorizontalHeaderTable: fontFile.
(self findTable: 'hmtx' in: fontFile)
ifFalse:[^self error: 'File does not have a horizontal header table'].
hmtxTableOffset := fontFile position.
(self findTable: 'loca' in: fontFile)
ifFalse:[^self error: 'File does not have a naming table'].
indexToLocOffset := fontFile position.
(self findTable: 'glyf' in: fontFile)
ifFalse:[^self error: 'File does not have a naming table'].
glyphTableOffset := fontFile position.
(self findTable: 'cmap' in: fontFile)
ifFalse:[^self error: 'File does not have a header table'].
self processCharacterMappingTable: fontFile.
].!
----- Method: TTFileDescription>>on:offset: (in category 'initialize') -----
on: aFileName offset: fontOffset
"Initialize the receiver from a file name"
fileName := aFileName.
fileOffset := fontOffset.
self withFileDo:[:fontFile|
"Some TTC fonts may actually be collection of PostScript-Based OpenType fonts"
(self findTable: 'CFF ' in: fontFile)
ifTrue: [^ nil]
ifFalse: [fontFile position: fileOffset "reset"].
"Some bitmap fonts are called .ttf; skip anything that doesn't have a header"
(self findTable: 'head' in: fontFile) ifFalse:[^nil].
self processFontHeaderTable: fontFile.
(self findTable: 'maxp' in: fontFile)
ifFalse:[^self error: 'File does not have a profile table'].
self processMaximumProfileTable: fontFile.
(self findTable: 'name' in: fontFile)
ifFalse:[^self error: 'File does not have a naming table'].
self processNamingTable: fontFile.
(self findTable: 'hhea' in: fontFile)
ifFalse:[^self error: 'File does not have a horizontal header table'].
self processHorizontalHeaderTable: fontFile.
(self findTable: 'OS/2' in: fontFile)
ifTrue:[self processOS2Table: fontFile].
(self findTable: 'hmtx' in: fontFile)
ifFalse:[^self error: 'File does not have a horizontal header table'].
hmtxTableOffset := fontFile position.
(self findTable: 'loca' in: fontFile)
ifFalse:[^self error: 'File does not have a naming table'].
indexToLocOffset := fontFile position.
(self findTable: 'glyf' in: fontFile)
ifFalse:[^self error: 'File does not have a naming table'].
glyphTableOffset := fontFile position.
(self findTable: 'cmap' in: fontFile)
ifFalse:[^self error: 'File does not have a header table'].
self processCharacterMappingTable: fontFile.
].!
----- Method: TTFileDescription>>printOn: (in category 'printing') -----
printOn: aStream
super printOn: aStream.
aStream nextPutAll: '('; print: fileName; nextPutAll: ')'.!
----- Method: TTFileDescription>>processCharacterMappingTable: (in category 'ttf tables') -----
processCharacterMappingTable: fontFile
"Read the font's character to glyph index mapping table."
| initialOffset nSubTables pID sID offset |
initialOffset := fontFile position.
fontFile skip: 2. "Skip table version"
nSubTables := fontFile nextNumber: 2.
1 to: nSubTables do:[:i|
pID := fontFile nextNumber: 2.
sID := fontFile nextNumber: 2.
offset := fontFile nextNumber: 4.
"Check if this is either a Unicode (0), Macintosh (1),
or a Windows (3) encoded table"
(#(0 1 3) includes: pID) ifTrue:[
cmapType := pID.
cmapOffset := initialOffset + offset.
cmapType = 0 ifTrue:[^self]. "found Unicode table; use it"
].
].!
----- Method: TTFileDescription>>processCompositeGlyph:contours:from: (in category 'glyphs') -----
processCompositeGlyph: glyph contours: nContours from: fontFile
"Read a composite glyph from the font data. The glyph passed into this method contains some state variables that must be copied into the resulting composite glyph."
| flags glyphIndex hasInstr ofsX ofsY iLen a11 a12 a21 a22 m glyphCache |
glyphCache := Dictionary new.
a11 := a22 := 16r4000. "1.0 in F2Dot14"
a21 := a12 := 0. "0.0 in F2Dot14"
"Copy state"
hasInstr := false.
[ flags := fontFile nextNumber: 2.
glyphIndex := fontFile nextNumber: 2.
(flags bitAnd: 1) = 1 ifTrue:[
ofsX := self short: (fontFile nextNumber: 2).
ofsY := self short: (fontFile nextNumber: 2).
] ifFalse:[
(ofsX := fontFile next) > 127 ifTrue:[ofsX := ofsX - 256].
(ofsY := fontFile next) > 127 ifTrue:[ofsY := ofsY - 256].
].
((flags bitAnd: 2) = 2) ifFalse:[
| i1 i2 p1 p2 |
(flags bitAnd: 1) = 1 ifTrue: [
i1 := ofsX + 65536 \\ 65536.
i2 := ofsY + 65536 \\ 65536]
ifFalse: [
i1 := ofsX + 256 \\ 256.
i2 := ofsY + 256 \\ 256].
p1 := glyph referenceVertexAt: i1+1.
p2 := (self childGlyphAt: glyphIndex in: glyphCache fromFile: fontFile) referenceVertexAt: i2+1.
ofsX := p1 x - p2 x.
ofsY := p1 y - p2 y.
].
(flags bitAnd: 8) = 8 ifTrue:[
a11 := a22 := self short: (fontFile nextNumber: 2)].
(flags bitAnd: 64) = 64 ifTrue:[
a11 := self short: (fontFile nextNumber: 2).
a22 := self short: (fontFile nextNumber: 2).
].
(flags bitAnd: 128) = 128 ifTrue:[
"2x2 transformation"
a11 := self short: (fontFile nextNumber: 2).
a21 := self short: (fontFile nextNumber: 2).
a12 := self short: (fontFile nextNumber: 2).
a22 := self short: (fontFile nextNumber: 2).
].
m := MatrixTransform2x3 new.
"Convert entries from F2Dot14 to float"
m a11: (a11 asFloat / 16r4000).
m a12: (a12 asFloat / 16r4000).
m a21: (a21 asFloat / 16r4000).
m a22: (a22 asFloat / 16r4000).
m a13: ofsX.
m a23: ofsY.
glyph addGlyph: (self childGlyphAt: glyphIndex in: glyphCache fromFile: fontFile) transformation: m.
hasInstr := hasInstr or:[ (flags bitAnd: 256) = 256].
"Continue as long as the MORE:=COMPONENTS bit is set"
(flags bitAnd: 32) = 32] whileTrue.
hasInstr ifTrue:[
iLen := fontFile nextNumber: 2.
fontFile skip: iLen].!
----- Method: TTFileDescription>>processFontHeaderTable: (in category 'ttf tables') -----
processFontHeaderTable: fontFile
"Value Data Type Description
unitsPerEm USHORT Granularity of the font's em square.
xMax USHORT Maximum X-coordinate for the entire font.
xMin USHORT Minimum X-coordinate for the entire font.
yMax USHORT Maximum Y-coordinate for the entire font.
yMin USHORT Minimum Y-coordinate for the entire font.
indexToLocFormat SHORT Used when processing the Index To Loc Table."
fontFile skip: 4. "Skip table version number"
fontFile skip: 4. "Skip font revision number"
fontFile skip: 4. "Skip check sum adjustment"
fontFile skip: 4. "Skip magic number"
fontFile skip: 2. "Skip flags"
unitsPerEm := fontFile nextNumber: 2.
fontFile skip: 8. "Skip creation date"
fontFile skip: 8. "Skip modification date"
"Skip min/max values of all glyphs"
fontFile skip: 2.
fontFile skip: 2.
fontFile skip: 2.
fontFile skip: 2.
fontFile skip: 2. "Skip mac style"
fontFile skip: 2. "Skip lowest rec PPEM"
fontFile skip: 2. "Skip font direction hint"
indexToLocFormat := fontFile nextNumber: 2.
!
----- Method: TTFileDescription>>processHorizontalHeaderTable: (in category 'ttf tables') -----
processHorizontalHeaderTable: fontFile
"
ascender SHORT Typographic ascent.
descender SHORT Typographic descent.
lineGap SHORT Typographic lineGap.
numberOfHMetrics USHORT Number hMetric entries in the HTMX
Table; may be smaller than the total
number of glyphs.
"
fontFile skip: 4. "Skip table version"
ascender := self short: (fontFile nextNumber: 2).
descender := self short: (fontFile nextNumber: 2).
lineGap := self short: (fontFile nextNumber: 2).
fontFile skip: 2. "Skip advanceWidthMax"
fontFile skip: 2. "Skip minLeftSideBearing"
fontFile skip: 2. "Skip minRightSideBearing"
fontFile skip: 2. "Skip xMaxExtent"
fontFile skip: 2. "Skip caretSlopeRise"
fontFile skip: 2. "Skip caretSlopeRun"
fontFile skip: 10. "Skip 5 reserved shorts"
fontFile skip: 2. "Skip metricDataFormat"
numHMetrics := fontFile nextNumber: 2.
^numHMetrics!
----- Method: TTFileDescription>>processMaximumProfileTable: (in category 'ttf tables') -----
processMaximumProfileTable: fontFile
"
numGlyphs USHORT The number of glyphs in the font.
"
fontFile skip: 4. "Skip Table version number"
numGlyphs := fontFile nextNumber: 2.!
----- Method: TTFileDescription>>processNamingTable: (in category 'ttf tables') -----
processNamingTable: fontFile
"copyright CHARPTR The font's copyright notice.
familyName CHARPTR The font's family name.
subfamilyName CHARPTR The font's subfamily name.
uniqueName CHARPTR A unique identifier for this font.
fullName CHARPTR The font's full name (a combination of
familyName and subfamilyName).
versionName CHARPTR The font's version string.
"
| nRecords initialOffset storageOffset format |
initialOffset := fontFile position.
format := fontFile nextNumber: 2.
format = 0 ifFalse: [self error: 'Cannot handle format 1 naming tables'].
"Get the number of name records"
nRecords := fontFile nextNumber: 2.
"Offset from the beginning of this table"
storageOffset := (fontFile nextNumber: 2) + initialOffset.
1 to: nRecords do:[:i| | pID sID lID nID length offset string |
fontFile position: initialOffset + 6 + ((i-1) * 12).
pID := fontFile nextNumber: 2.
sID := fontFile nextNumber: 2.
lID := fontFile nextNumber: 2.
nID := fontFile nextNumber: 2.
length := fontFile nextNumber: 2.
offset := fontFile nextNumber: 2.
"Read only Macintosh or Microsoft strings"
(pID = 1 or:[pID = 3 and:[sID = 1]]) ifTrue:[
"MS uses Unicode all others single byte"
"multiBytes := pID = 3."
fontFile position: storageOffset+offset.
string := (fontFile next: length) asString.
pID = 3 ifTrue:[ | keep |
keep := true.
string := string select:[:ch| keep := keep not].
].
"Select only English names, prefer Macintosh"
((pID = 1 and: [lID = 0]) or: [pID = 3 and: [lID = 16r0409]]) ifTrue: [
nID caseOf: {
[0] -> [(pID = 1 or:[copyright == nil]) ifTrue:[copyright := string]].
[1] -> [(pID = 1 or:[familyName == nil]) ifTrue:[familyName := string]].
[2] -> [(pID = 1 or:[subfamilyName == nil]) ifTrue:[subfamilyName := string]].
"[3] -> [(pID = 1 or:[uniqueName == nil]) ifTrue:[uniqueName := string]]."
"[4] -> [(pID = 1 or:[fullName == nil]) ifTrue:[fullName := string]]."
"[5] -> [(pID = 1 or:[versionName == nil]) ifTrue:[versionName := string]]."
"[6] -> [(pID = 1 or:[postscriptName == ni]) ifTrue:[postscriptName := string]]."
"[7] -> [(pID = 1 or:[trademark == nil]) ifTrue:[trademark := string]]."
} otherwise:["ignore"].
]
].
].
!
----- Method: TTFileDescription>>processOS2Table: (in category 'ttf tables') -----
processOS2Table: fontFile
"
USHORT version 0x0004
SHORT xAvgCharWidth
USHORT usWeightClass
USHORT usWidthClass
USHORT fsType
SHORT ySubscriptXSize
SHORT ySubscriptYSize
SHORT ySubscriptXOffset
SHORT ySubscriptYOffset
SHORT ySuperscriptXSize
SHORT ySuperscriptYSize
SHORT ySuperscriptXOffset
SHORT ySuperscriptYOffset
SHORT yStrikeoutSize
SHORT yStrikeoutPosition
SHORT sFamilyClass
BYTE panose[10]
ULONG ulUnicodeRange1 Bits 0-31
ULONG ulUnicodeRange2 Bits 32-63
ULONG ulUnicodeRange3 Bits 64-95
ULONG ulUnicodeRange4 Bits 96-127
CHAR achVendID[4]
USHORT fsSelection
USHORT usFirstCharIndex
USHORT usLastCharIndex
SHORT sTypoAscender
SHORT sTypoDescender
SHORT sTypoLineGap
USHORT usWinAscent
USHORT usWinDescent
ULONG ulCodePageRange1 Bits 0-31
ULONG ulCodePageRange2 Bits 32-63
SHORT sxHeight
SHORT sCapHeight
USHORT usDefaultChar
USHORT usBreakChar
USHORT usMaxContext "
| version fsSelection minAscii maxAscii |
version := self short: (fontFile nextNumber: 2). "table version"
version = 0 ifTrue:[^self].
fontFile skip: 60.
fsSelection := fontFile nextNumber: 2.
minAscii := fontFile nextNumber: 2.
maxAscii := fontFile nextNumber: 2.
sTypoAscender := self short: (fontFile nextNumber: 2).
sTypoDescender := self short: (fontFile nextNumber: 2).
sTypoLineGap := self short: (fontFile nextNumber: 2).
!
----- Method: TTFileDescription>>processSimpleGlyph:contours:from: (in category 'glyphs') -----
processSimpleGlyph: glyph contours: nContours from: fontFile
"Construct a simple glyph frm the font file"
| endPts nPts iLength flags |
endPts := Array new: nContours.
1 to: nContours do:[:i| endPts at: i put: (fontFile nextNumber: 2)].
glyph initializeContours: nContours with: endPts.
nContours = 0 ifTrue:[^self].
nPts := endPts last + 1.
iLength := fontFile nextNumber: 2. "instruction length"
fontFile skip: iLength.
flags := self getGlyphFlagsFrom: fontFile size: nPts.
self readGlyphXCoords: fontFile glyph: glyph nContours: nContours flags: flags endPoints: endPts.
self readGlyphYCoords: fontFile glyph: glyph nContours: nContours flags: flags endPoints: endPts.!
----- Method: TTFileDescription>>readCmapTableAt:fromFile: (in category 'glyphs') -----
readCmapTableAt: codePoint fromFile: fontFile
| cmapFmt length firstCode entryCount segCount segIndex startCode idDelta idRangeOffset offset |
fontFile position: cmapOffset.
cmapFmt := fontFile nextNumber: 2.
length := fontFile nextNumber: 2.
fontFile skip: 2. "skip version"
cmapFmt = 0 ifTrue:["byte encoded table"
codePoint > 255 ifTrue:[^0].
length := length - 6. "should be always 256"
length <= 0 ifTrue: [^0]. "but sometimes, this table is empty"
fontFile skip: codePoint. "move to correct byte offset in table"
^fontFile next].
cmapFmt = 4 ifTrue:[ "segment mapping to deltavalues"
codePoint > 16rFFFF ifTrue:[^0].
segCount := (fontFile nextNumber: 2) // 2.
fontFile skip: 6. "skip searchRange, entrySelector, rangeShift"
segIndex := (0 to: segCount-1)
detect:[:i| | endCode | (endCode := (fontFile nextNumber: 2)) >= codePoint].
fontFile position: cmapOffset + 16 + (segCount*2) + (segIndex*2).
startCode := fontFile nextNumber: 2.
startCode <= codePoint ifFalse:[^0]. "not in segment range"
fontFile position: cmapOffset + 16 + (segCount*4) + (segIndex*2).
idDelta := fontFile nextNumber: 2.
fontFile position: cmapOffset + 16 + (segCount*6) + (segIndex*2).
idRangeOffset := fontFile nextNumber: 2.
idRangeOffset = 0 ifTrue:[^(idDelta + codePoint) bitAnd: 16rFFFF].
offset := (fontFile position - 2) + idRangeOffset + ((codePoint - startCode) * 2).
fontFile position: offset.
^fontFile nextNumber: 2.
].
cmapFmt = 6 ifTrue:[ "trimmed table"
firstCode := fontFile nextNumber: 2.
entryCount := fontFile nextNumber: 2.
(codePoint between: firstCode and: firstCode+entryCount) ifFalse:[^0].
fontFile skip: (codePoint-firstCode) * 2.
^fontFile nextNumber: 2].
^0!
----- Method: TTFileDescription>>readGlyphAt: (in category 'glyphs') -----
readGlyphAt: glyphIndex
| glyph |
self withFileDo:[:fontFile|
glyph := self readGlyphAt: glyphIndex fromFile: fontFile.
self updateGlyphMetrics: glyph fromFile: fontFile.
].
^glyph!
----- Method: TTFileDescription>>readGlyphAt:fromFile: (in category 'glyphs') -----
readGlyphAt: glyphIndex fromFile: fontFile
"Answer the glyph with the given glyph index"
| glyphOffset nextOffset glyphLength glyph nContours left top right bottom |
indexToLocFormat = 0 ifTrue:["Format0: offset/2 is stored"
fontFile position: indexToLocOffset+(glyphIndex * 2).
glyphOffset := (fontFile nextNumber: 2) * 2.
nextOffset := (fontFile nextNumber: 2) * 2.
] ifFalse:["Format1: store actual offset"
fontFile position: indexToLocOffset+(glyphIndex * 4).
glyphOffset := fontFile nextNumber: 4.
nextOffset := fontFile nextNumber: 4.
].
glyphLength := nextOffset - glyphOffset.
glyphLength = 0 ifTrue:[^TTGlyph new glyphIndex: glyphIndex].
fontFile position: glyphTableOffset+glyphOffset.
nContours := self short: (fontFile nextNumber: 2).
left := self short: (fontFile nextNumber: 2).
top := self short: (fontFile nextNumber: 2).
right := self short: (fontFile nextNumber: 2).
bottom := self short: (fontFile nextNumber: 2).
nContours >= 0 ifTrue:[
glyph := TTGlyph new glyphIndex: glyphIndex.
self processSimpleGlyph: glyph contours: nContours from: fontFile.
] ifFalse:[
glyph := TTCompositeGlyph new glyphIndex: glyphIndex.
self processCompositeGlyph: glyph contours: nContours from: fontFile.
].
glyph buildAllContours.
glyph bounds: (left at top corner: right at bottom).
^glyph
!
----- Method: TTFileDescription>>readGlyphXCoords:glyph:nContours:flags:endPoints: (in category 'glyphs') -----
readGlyphXCoords: fontFile glyph: glyph nContours: nContours flags: flags endPoints: endPts
"Read the x coordinates for the given glyph from the font file."
| startPoint endPoint flagBits xValue contour ttPoint |
startPoint := 1.
1 to: nContours do:[:i|
contour := glyph contours at: i.
"Get the end point"
endPoint := (endPts at: i) + 1.
"Store number of points"
startPoint to: endPoint do:[:j|
ttPoint := contour points at: (j - startPoint + 1).
flagBits := flags at: j.
"If bit zero in the flag is set then this point is an on-curve
point, if not, then it is an off-curve point."
(flagBits bitAnd: 1) = 1
ifTrue:[ ttPoint type: #OnCurve]
ifFalse:[ttPoint type: #OffCurve].
"First we check to see if bit one is set. This would indicate that
the corresponding coordinate data in the table is 1 byte long.
If the bit is not set, then the coordinate data is 2 bytes long."
(flagBits bitAnd: 2) = 2 ifTrue:[ "one byte"
xValue := fontFile next.
xValue := (flagBits bitAnd: 16)=16 ifTrue:[xValue] ifFalse:[xValue negated].
ttPoint x: xValue.
] ifFalse:[ "two byte"
"If bit four is set, then this coordinate is the same as the
last one, so the relative offset (of zero) is stored. If bit
is not set, then read in two bytes and store it as a signed value."
(flagBits bitAnd: 16) = 16 ifTrue:[ ttPoint x: 0 ]
ifFalse:[
xValue := self short: (fontFile nextNumber: 2).
ttPoint x: xValue]]].
startPoint := endPoint + 1]!
----- Method: TTFileDescription>>readGlyphYCoords:glyph:nContours:flags:endPoints: (in category 'glyphs') -----
readGlyphYCoords: fontFile glyph: glyph nContours: nContours flags: flags endPoints: endPts
"Read the y coordinates for the given glyph from the font file."
| startPoint endPoint flagBits yValue contour ttPoint |
startPoint := 1.
1 to: nContours do:[:i|
contour := glyph contours at: i.
"Get the end point"
endPoint := (endPts at: i) + 1.
"Store number of points"
startPoint to: endPoint do:[:j|
ttPoint := contour points at: (j - startPoint + 1).
flagBits := flags at: j.
"Check if this value one or two byte encoded"
(flagBits bitAnd: 4) = 4 ifTrue:[ "one byte"
yValue := fontFile next.
yValue := (flagBits bitAnd: 32)=32 ifTrue:[yValue] ifFalse:[yValue negated].
ttPoint y: yValue.
] ifFalse:[ "two byte"
(flagBits bitAnd: 32) = 32 ifTrue:[ ttPoint y: 0 ]
ifFalse:[
yValue := self short: (fontFile nextNumber: 2).
ttPoint y: yValue]]].
startPoint := endPoint + 1]!
----- Method: TTFileDescription>>renderGlyph:height:extraScale:fgColor:bgColor:depth: (in category 'rendering') -----
renderGlyph: code height: fontHeight extraScale: extraScale fgColor: fgColor bgColor: bgColor depth: depth
"Render the glyph with the given code point at the specified pixel height."
^ self
renderGlyph: code height: fontHeight extraScale: extraScale
fgColor: fgColor bgColor: bgColor depth: depth
lineGlyph: nil lineGlyphWidth: 0 emphasis: 0!
----- Method: TTFileDescription>>renderGlyph:height:extraScale:fgColor:bgColor:depth:lineGlyph:lineGlyphWidth:emphasis: (in category 'rendering') -----
renderGlyph: code height: fontHeight extraScale: extraScale fgColor: fgColor bgColor: bgColor depth: depth lineGlyph: lineGlyphOrNil lineGlyphWidth: lWidth emphasis: emphasis
"Render the glyph with the given code point at the specified pixel height. Underline it with lineGlyph."
| form pixelScale offset |
pixelScale := fontHeight asFloat / self fontHeight.
offset := 0 @ ( ((self ascender - (self ascender * extraScale)) * pixelScale) truncated ).
form := (self at: code)
asFormWithScale: pixelScale * extraScale
ascender: self ascender
descender: self descender
fgColor: fgColor bgColor: bgColor depth: depth
replaceColor: false
lineGlyph: lineGlyphOrNil lineGlyphWidth: lWidth
emphasis: emphasis.
form offset: form offset + offset.
^ form!
----- Method: TTFileDescription>>renderGlyph:height:fgColor:bgColor:depth: (in category 'rendering') -----
renderGlyph: code height: fontHeight fgColor: fgColor bgColor: bgColor depth: depth
"Render the glyph with the given code point at the specified pixel height."
self flag: #deprecated.
^ self
renderGlyph: code height: fontHeight extraScale: 1.0
fgColor: fgColor bgColor: bgColor depth: depth
lineGlyph: nil lineGlyphWidth: 0 emphasis: 0!
----- Method: TTFileDescription>>renderGlyph:height:fgColor:bgColor:depth:lineGlyph:lineGlyphWidth:emphasis: (in category 'rendering') -----
renderGlyph: code height: fontHeight fgColor: fgColor bgColor: bgColor depth: depth lineGlyph: lineGlyphOrNil lineGlyphWidth: lWidth emphasis: emphasis
"Render the glyph with the given code point at the specified pixel height. Underline it with lineGlyph."
self flag: #deprecated.
^ self
renderGlyph: code height: fontHeight extraScale: 1.0
fgColor: fgColor bgColor: bgColor depth: depth
lineGlyph: lineGlyphOrNil lineGlyphWidth: lWidth emphasis: emphasis!
----- Method: TTFileDescription>>sampleText (in category 'accessing') -----
sampleText
^ ''!
----- Method: TTFileDescription>>short: (in category 'private') -----
short: aNumber
(aNumber bitAnd: 16r8000) = 0
ifTrue: [^aNumber]
ifFalse: [^-1 - (aNumber bitXor: 16rFFFF)]!
----- Method: TTFileDescription>>size (in category 'accessing') -----
size
"Compatibility with TTFontDescription"
^16rFFFF!
----- Method: TTFileDescription>>subfamilyName (in category 'accessing') -----
subfamilyName
"The subfamily name for the font"
^subfamilyName!
----- Method: TTFileDescription>>typographicAscender (in category 'accessing') -----
typographicAscender
"Microsoft defines this as the 'true typographic metrics' of the font."
^sTypoAscender ifNil:[ascender]!
----- Method: TTFileDescription>>typographicDescender (in category 'accessing') -----
typographicDescender
"Microsoft defines this as the 'true typographic metrics' of the font."
^sTypoDescender ifNil:[descender]!
----- Method: TTFileDescription>>typographicFontHeight (in category 'accessing') -----
typographicFontHeight
"cope for the fact that typographicAscender and
typographicDescender may not be available and
0-height fonts are a bit useless"
| tfh |
tfh := self typographicAscender - self typographicDescender.
^ tfh = 0 ifTrue: [self fontHeight] ifFalse: [tfh]!
----- Method: TTFileDescription>>typographicLineGap (in category 'accessing') -----
typographicLineGap
"Microsoft defines this as the 'true typographic metrics' of the font."
^sTypoLineGap ifNil:[lineGap]!
----- Method: TTFileDescription>>unitsPerEm (in category 'accessing') -----
unitsPerEm
^unitsPerEm!
----- Method: TTFileDescription>>updateGlyphMetrics:fromFile: (in category 'glyphs') -----
updateGlyphMetrics: glyph fromFile: fontFile
"Update the horizontal metrics for the given glyph"
| glyphIndex |
glyphIndex := glyph glyphIndex.
glyphIndex <= numHMetrics ifTrue:[
fontFile position: hmtxTableOffset + (glyphIndex*4).
glyph advanceWidth: (fontFile nextNumber: 2).
glyph leftSideBearing: (self short: (fontFile nextNumber: 2)).
] ifFalse:[
fontFile position: hmtxTableOffset + ((numHMetrics-1) *4).
glyph advanceWidth: (fontFile nextNumber: 2).
fontFile position: hmtxTableOffset + (numHMetrics * 4) + ((glyphIndex-numHMetrics)*2).
glyph leftSideBearing: (self short: (fontFile nextNumber: 2)).
].
glyph updateRightSideBearing.!
----- Method: TTFileDescription>>withFileDo: (in category 'initialize') -----
withFileDo: aBlock
"Open the font file for the duration of aBlock"
^self class openFontFile: fileName do: aBlock.!
----- Method: TTFileDescription>>xHeight (in category 'accessing') -----
xHeight
"https://docs.microsoft.com/en-us/typography/opentype/spec/os2#sxheight
This metric specifies the distance between the baseline and the approximate height of non-ascending lowercase letters measured in FUnits. This value would normally be specified by a type designer but in situations where that is not possible, for example when a legacy font is being converted, the value may be set equal to the top of the unscaled and unhinted glyph bounding box of the glyph encoded at U+0078 (LATIN SMALL LETTER X). If no glyph is encoded in this position the field should be set to 0."
^ sxHeight ifNil: [
| glyph |
glyph := self at: 16r78 "$x".
glyph isFallback
ifTrue: [sxHeight := 0]
ifFalse: [sxHeight := glyph bounds bottom "=top ..."] ]!
Object subclass: #WindowColorSpec
instanceVariableNames: 'classSymbol wording brightColor pastelColor normalColor helpMessage'
classVariableNames: ''
poolDictionaries: ''
category: '60Deprecated-System-Support'!
----- Method: WindowColorSpec class>>classSymbol:wording:brightColor:pastelColor:helpMessage: (in category 'instance creation') -----
classSymbol: sym wording: wrd brightColor: brCol pastelColor: paCol helpMessage: hlpMsg
"Answer a new instance of the receiver with the given slots filled in"
^ self new classSymbol: sym wording: wrd brightColor: brCol pastelColor: paCol helpMessage: hlpMsg!
----- Method: WindowColorSpec class>>classSymbol:wording:brightColor:pastelColor:normalColor:helpMessage: (in category 'instance creation') -----
classSymbol: sym wording: wrd brightColor: brCol pastelColor: paCol normalColor: noCol helpMessage: hlpMsg
^ self new classSymbol: sym wording: wrd brightColor: brCol pastelColor: paCol normalColor: noCol helpMessage: hlpMsg!
----- Method: WindowColorSpec>>brightColor (in category 'access') -----
brightColor
"Answer the brightColor"
^ brightColor!
----- Method: WindowColorSpec>>classSymbol (in category 'access') -----
classSymbol
"Answer the classSymbol"
^ classSymbol!
----- Method: WindowColorSpec>>classSymbol:wording:brightColor:pastelColor:helpMessage: (in category 'initialization') -----
classSymbol: sym wording: wrd brightColor: brCol pastelColor: paCol helpMessage: hlpMsg
"Initialize the receiver's instance variables"
self
classSymbol: sym
wording: wrd
brightColor: brCol
pastelColor: paCol
normalColor: (Color colorFrom: brCol) duller
helpMessage: hlpMsg!
----- Method: WindowColorSpec>>classSymbol:wording:brightColor:pastelColor:normalColor:helpMessage: (in category 'initialization') -----
classSymbol: sym wording: wrd brightColor: brCol pastelColor: paCol normalColor: noCol helpMessage: hlpMsg
"Initialize the receiver's instance variables"
classSymbol := sym.
wording := wrd.
brightColor := brCol.
pastelColor := paCol.
normalColor := noCol.
helpMessage := hlpMsg!
----- Method: WindowColorSpec>>helpMessage (in category 'access') -----
helpMessage
"Answer the helpMessage"
^ helpMessage!
----- Method: WindowColorSpec>>normalColor (in category 'access') -----
normalColor
^ normalColor!
----- Method: WindowColorSpec>>pastelColor (in category 'access') -----
pastelColor
"Answer the pastelColor"
^ pastelColor!
----- Method: WindowColorSpec>>printOn: (in category 'printing') -----
printOn: aStream
"Print the receiver on a stream"
super printOn: aStream.
classSymbol printOn: aStream.
aStream nextPutAll: ' bright: ', brightColor printString, ' pastel: ', pastelColor printString, ' normal: ', normalColor printString!
----- Method: WindowColorSpec>>wording (in category 'access') -----
wording
"Answer the wording"
^ wording!
----- Method: CompositeTransform>>offset (in category '*60Deprecated-accessing') -----
offset
self deprecated: 'Use #localPointToGlobal: instead. Behavior of #offset can vary between transform types.'.
^ (self localPointToGlobal: 0 at 0) negated!
----- Method: Behavior>>forgetDoIts (in category '*60Deprecated-initialize-release') -----
forgetDoIts
"See http://forum.world.st/About-forgetDoIts-td3607521.html."
self deprecated: 'do-it methods are not installed in method dictionaries anymore. See ImageSegment >> #forgetDoItsInClass:'.!
----- Method: Behavior>>thoroughWhichSelectorsReferTo:special:byte: (in category '*60Deprecated-testing method dictionary') -----
thoroughWhichSelectorsReferTo: literal special: specialFlag byte: specialByte
"Answer a set of selectors whose methods access the argument as a
literal. Dives into the compact literal notation, making it slow but
thorough "
self deprecated: 'Use whichSelectorsReferTo:thorough: instead'.
^self whichSelectorsReferTo: literal special: specialFlag byte: specialByte thorough: true!
----- Method: Behavior>>whichSelectorsReferTo:special:byte: (in category '*60Deprecated-testing method dictionary') -----
whichSelectorsReferTo: literal special: specialFlag byte: specialByte
"Answer a set of selectors whose methods access the argument as a literal."
self deprecated: 'Use whichSelectorsReferTo: instead'.
^self whichSelectorsReferTo: literal special: specialFlag byte: specialByte thorough: false!
----- Method: Behavior>>whichSelectorsReferTo:special:byte:thorough: (in category '*60Deprecated-testing method dictionary') -----
whichSelectorsReferTo: literal special: specialFlag byte: specialByte thorough: thorough
self deprecated: 'Use #whichSelectorsReferTo: instead'.
^ self whichSelectorsReferTo: literal!
----- Method: Behavior>>whichSelectorsReferTo:thorough: (in category '*60Deprecated-testing method dictionary') -----
whichSelectorsReferTo: aLiteral thorough: thorough
self deprecated: 'Literal test is thorough by default. Use #whichSelectorsReferTo: instead.'.
^ self whichSelectorsReferTo: aLiteral!
----- Method: ObjectExplorer>>classHierarchy (in category '*60Deprecated-Tools') -----
classHierarchy
self deprecated: 'Use #browseClassHierarchy instead'.
self browseClassHierarchy.!
----- Method: RaisedBorder>>colorsAtCorners (in category '*60Deprecated-accessing') -----
colorsAtCorners
| c c14 c23 |
self deprecated: 'See #topLeftColor and #bottomRightColor.'.
c := self color.
c14 := c lighter. c23 := c darker.
^Array with: c14 with: c23 with: c23 with: c14!
----- Method: SequenceableCollection>>collectWithIndex: (in category '*60Deprecated-enumerating') -----
collectWithIndex: elementAndIndexBlock
self flag: #deprecated. "Use the new version with consistent naming."
^ self withIndexCollect: elementAndIndexBlock!
----- Method: SequenceableCollection>>doWithIndex: (in category '*60Deprecated-enumerating') -----
doWithIndex: elementAndIndexBlock
self flag: #deprecated. "Use the new version with consistent naming."
^ self withIndexDo: elementAndIndexBlock!
----- Method: Context>>blockCopy: (in category '*60Deprecated-controlling') -----
blockCopy: numArgs
"Primitive. Distinguish a block of code from its enclosing method by
creating a new BlockContext for that block. The compiler inserts into all
methods that contain blocks the bytecodes to send the message
blockCopy:. Do not use blockCopy: in code that you write!! Only the
compiler can decide to send the message blockCopy:. Fail if numArgs is
not a SmallInteger. Optional. No Lookup. See Object documentation
whatIsAPrimitive."
<primitive: 80>
^ (BlockContext newForMethod: self method)
home: self home
startpc: pc + 2
nargs: numArgs!
Context variableSubclass: #ContextPart
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: '60Deprecated-Kernel-Methods'!
ContextPart variableSubclass: #BlockContext
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: '60Deprecated-Kernel-Methods'!
ContextPart variableSubclass: #MethodContext
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: '60Deprecated-Kernel-Methods'!
----- Method: AutoStart class>>checkForPluginUpdate (in category '*60Deprecated') -----
checkForPluginUpdate
| pluginVersion updateURL |
self deprecated.
HTTPClient isRunningInBrowser
ifFalse: [^false].
pluginVersion := Smalltalk namedArguments
at: (Smalltalk platformName copyWithout: Character space) asUppercase
ifAbsent: [^false].
updateURL := Smalltalk namedArguments
at: 'UPDATE_URL'
ifAbsent: [^false].
^SystemVersion check: pluginVersion andRequestPluginUpdate: updateURL!
----- Method: AutoStart class>>checkForUpdates (in category '*60Deprecated') -----
checkForUpdates
| availableUpdate updateServer |
self deprecated: 'Running in Browser no longer supported'.
HTTPClient isRunningInBrowser ifFalse: [ ^ self processUpdates ].
availableUpdate := (Smalltalk namedArguments
at: 'UPDATE'
ifAbsent: [ '' ]) asInteger.
availableUpdate ifNil: [ ^ false ].
updateServer := Smalltalk namedArguments
at: 'UPDATESERVER'
ifAbsent:
[ Smalltalk namedArguments
at: 'UPDATE_SERVER'
ifAbsent: [ 'Squeakland' ] ].
UpdateStreamDownloader default setUpdateServer: updateServer.
^ SystemVersion checkAndApplyUpdates: availableUpdate!
CollectionInspector subclass: #OrderedCollectionInspector
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: '60Deprecated-Tools-Inspector'!
!OrderedCollectionInspector commentStamp: 'mt 4/6/2020 08:30' prior: 0!
I am an Inspector that is specialized for inspecting OrderedCollections. Deprecated since regular CollectionInspector can add and remove elements.!
----- Method: DummyUIManager>>fontFromUser: (in category '*60Deprecated') -----
fontFromUser: priorFont
self deprecated: 'Use "StrikeFont fromUser" instead.'.
self error: 'No user response possible'!
----- Method: DummyUIManager>>openPluggableFileList:label:in: (in category '*60Deprecated') -----
openPluggableFileList: aPluggableFileList label: aString in: aWorld
self deprecated: 'PluggableFileList is being deprecated'.
^nil!
----- Method: DummyUIManager>>openPluggableFileListLabel:in: (in category '*60Deprecated') -----
openPluggableFileListLabel: aString in: aWorld
self deprecated: 'PluggableFileList is being deprecated'.
^nil!
----- Method: FileStream class>>httpPostDocument:args: (in category '*60Deprecated-NSPlugin-System-Support') -----
httpPostDocument: url args: argsDict
| argString |
self deprecated: 'Browser plugin based http requests are not supported anymore.'.
argString := argsDict
ifNotNil: [argString := HTTPSocket argString: argsDict]
ifNil: [''].
^self post: argString url: url , argString ifError: [self halt]!
----- Method: FileStream class>>httpPostMultipart:args: (in category '*60Deprecated-NSPlugin-System-Support') -----
httpPostMultipart: url args: argsDict
| mimeBorder argsStream crLf resultStream result |
" do multipart/form-data encoding rather than x-www-urlencoded "
self deprecated: 'NSPlugin no longer supported'.
crLf := String crlf.
mimeBorder := '----squeak-', Time millisecondClockValue printString, '-stuff-----'.
"encode the arguments dictionary"
argsStream := WriteStream on: String new.
argsDict associationsDo: [:assoc |
assoc value do: [ :value | | fieldValue |
"print the boundary"
argsStream nextPutAll: '--', mimeBorder, crLf.
" check if it's a non-text field "
argsStream nextPutAll: 'Content-disposition: form-data; name="', assoc key, '"'.
(value isKindOf: MIMEDocument)
ifFalse: [fieldValue := value]
ifTrue: [argsStream nextPutAll: ' filename="', value url pathForFile, '"', crLf, 'Content-Type: ', value contentType.
fieldValue := (value content
ifNil: [(FileStream fileNamed: value url pathForFile) contentsOfEntireFile]
ifNotNil: [value content]) asString].
" Transcript show: 'field=', key, '; value=', fieldValue; cr. "
argsStream nextPutAll: crLf, crLf, fieldValue, crLf.
]].
argsStream nextPutAll: '--', mimeBorder, '--'.
resultStream := self
post:
('Content-type: multipart/form-data; boundary=', mimeBorder, crLf,
'Content-length: ', argsStream contents size printString, crLf, crLf,
argsStream contents)
url: url ifError: [^'Error in post ' url asString].
"get the header of the reply"
result := resultStream upToEnd.
^MIMEDocument content: result!
----- Method: FileStream class>>post:target:url:ifError: (in category '*60Deprecated-NSPlugin-System-Support') -----
post: data target: target url: url ifError: errorBlock
self deprecated: 'NSPlugin no longer supported'.
^self concreteStream new post: data target: target url: url ifError: errorBlock!
----- Method: FileStream class>>post:url:ifError: (in category '*60Deprecated-NSPlugin-System-Support') -----
post: data url: url ifError: errorBlock
self deprecated: 'NSPlugin no longer supported'.
^self post: data target: nil url: url ifError: errorBlock!
----- Method: FileStream class>>requestURL:target: (in category '*60Deprecated-NSPlugin-System-Support') -----
requestURL: url target: target
"FileStream requestURL:'http://isgwww.cs.uni-magdeburg.de/~raab' target: ':=blank' "
self deprecated: 'NSPlugin no longer supported'.
^self concreteStream new requestURL: url target: target!
----- Method: FileStream class>>requestURLStream: (in category '*60Deprecated-NSPlugin-System-Support') -----
requestURLStream: url
"FileStream requestURLStream:'http://isgwww.cs.uni-magdeburg.de/~raab'"
self deprecated: 'NSPlugin no longer supported'.
^self concreteStream new requestURLStream: url!
----- Method: FileStream class>>requestURLStream:ifError: (in category '*60Deprecated-NSPlugin-System-Support') -----
requestURLStream: url ifError: errorBlock
"FileStream requestURLStream:'http://isgwww.cs.uni-magdeburg.de/~raab'"
self deprecated: 'NSPlugin no longer supported'.
^self concreteStream new requestURLStream: url ifError: errorBlock!
----- Method: PluggableFileList class>>newFileMenu: (in category '*60Deprecated-Tools-Menus-StandardFileMenu') -----
newFileMenu: aDirectory
"For compatibility with StandardFileMenu for now, answer a StandardFileMenuResult"
^(self getFilePathNameDialogWithExistenceCheck)
resultBlock: self sfmResultBlock;
directory: aDirectory;
yourself!
----- Method: PluggableFileList class>>oldFileMenu: (in category '*60Deprecated-Tools-Menus-StandardFileMenu') -----
oldFileMenu: aDirectory
"For compatibility with StandardFileMenu for now, answer a StandardFileMenuResult"
^(self getFilePathNameDialog)
resultBlock: self sfmResultBlock;
directory: aDirectory;
yourself!
----- Method: PluggableFileList class>>sfmResultBlock (in category '*60Deprecated-Tools-Menus-resultBlocks') -----
sfmResultBlock
^[:theDirectory :theFileName |
StandardFileMenuResult directory: theDirectory name: theFileName]!
----- Method: Inspector class>>openOn:withEvalPane: (in category '*60Deprecated-instance creation') -----
openOn: anObject withEvalPane: withEval
"Create and schedule an instance of me on the model, anInspector. "
self deprecated.
^ ToolBuilder open: (self inspect: anObject) label: anObject defaultLabelForInspector!
----- Method: Inspector class>>openOn:withEvalPane:withLabel: (in category '*60Deprecated-instance creation') -----
openOn: anObject withEvalPane: withEval withLabel: label
self deprecated.
^ToolBuilder open: (self inspect: anObject) label: label!
----- Method: Inspector>>classHierarchy (in category '*60Deprecated-menu') -----
classHierarchy
self deprecated.
^ self browseClassHierarchy!
----- Method: Inspector>>exploreObject (in category '*60Deprecated-toolbuilder') -----
exploreObject
self deprecated.
self replaceInspectorWithExplorer.!
----- Method: Inspector>>selectedSlotName (in category '*60Deprecated-selecting') -----
selectedSlotName
self deprecated: 'Use #selectedFieldName instead.'.
^ self selectedFieldName!
----- Method: CustomHelp class>>accept:title:contents: (in category '*60Deprecated-editing') -----
accept: aSelector title: title contents: text
"Accept edited text. Compile it into a HelpTopic"
self deprecated: 'mt: Use ClassBasedHelpTopic >> #accept:for:. Edit such topics via HelpBrowser'.
(ClassBasedHelpTopic new helpClass: self)
accept: text for: aSelector.!
----- Method: BorderStyle>>colorsAtCorners (in category '*60Deprecated-accessing') -----
colorsAtCorners
self deprecated: 'See #topLeftColor and #bottomRightColor.'.
^Array new: 4 withAll: self color!
----- Method: BorderStyle>>dotOfSize:forDirection: (in category '*60Deprecated-accessing') -----
dotOfSize: diameter forDirection: aDirection
self deprecated: 'See Form for such convenience functions.'.
^ Form dotOfSize: diameter color: self color!
----- Method: BorderStyle>>widthForRounding (in category '*60Deprecated-accessing') -----
widthForRounding
self deprecated: 'See BalloonCanvas for drawing rounded corners.'.
^self width!
----- Method: SUnitExtensionsTest>>shouldFixTest (in category '*60Deprecated-real tests') -----
shouldFixTest
self shouldFix: [ Error signal: 'any kind of error' ]
!
----- Method: SUnitExtensionsTest>>testShouldFix (in category '*60Deprecated-tests') -----
testShouldFix
| testCase testResult |
testCase := self class selector: #shouldFixTest.
testResult := Deprecation suppressDuring: [testCase run].
self assert: (testResult passed includes: testCase).
self assert: testResult passed size=1.
self assert: testResult failures isEmpty.
self assert: testResult errors isEmpty.
!
DropEvent subclass: #DropFilesEvent
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: '60Deprecated-Morphic-Events'!
!DropFilesEvent commentStamp: 'ct 10/15/2020 18:15' prior: 0!
THIS CLASS IS DEPRECATED!! The #dropFiles/#wantsDropFiles: protocol has been replaced. Use #acceptDroppingMorph:event:/#wantsDroppedMorph:event: instead and scan for dragTransferType: #filesAndDirectories.!
----- Method: DropFilesEvent>>sentTo: (in category 'dispatching') -----
sentTo: anObject
"Dispatch the receiver into anObject"
self type == #dropFilesEvent ifTrue:[^anObject handleDropFiles: self].!
----- Method: DropFilesEvent>>type (in category 'accessing') -----
type
^#dropFilesEvent!
----- Method: TransformMorph>>localVisibleSubmorphBounds (in category '*60Deprecated-geometry') -----
localVisibleSubmorphBounds
"self deprecated."
^ self localSubmorphBounds!
----- Method: CompiledCode>>messagesDo: (in category '*60Deprecated-scanning') -----
messagesDo: workBlock
self deprecated: 'ct: Use #selectorsDo:.'.
^ self selectorsDo: workBlock!
----- Method: CompiledCode>>messagesDo:encoderClass:visitedSet: (in category '*60Deprecated-private') -----
messagesDo: aBlock encoderClass: encoderClass visitedSet: visitedSet
self deprecated: 'Use #messagesDo:.'.
self messagesDo: aBlock.!
----- Method: CompiledCode>>printSignatureOn: (in category '*60Deprecated-printing') -----
printSignatureOn: aStream
self deprecated: 'Use #printReferenceOn:.'.
^ self printReferenceOn: aStream!
----- Method: CompiledCode>>refersTo:bytecodeScanner:thorough: (in category '*60Deprecated-literals') -----
refersTo: literal bytecodeScanner: scanBlockOrNil thorough: thorough
self deprecated: 'Use #hasLiteral:.'.
^ self hasLiteral: literal!
----- Method: CompiledCode>>refersTo:primaryBytecodeScanner:secondaryBytecodeScanner:thorough: (in category '*60Deprecated-literals') -----
refersTo: literal primaryBytecodeScanner: primaryScanBlockOrNil secondaryBytecodeScanner: secondaryScanBlockOrNil thorough: thorough
self deprecated: 'Use #hasLiteral:.'.
^ self hasLiteral: literal!
----- Method: CompiledCode>>sendsMessage: (in category '*60Deprecated-testing') -----
sendsMessage: selector
self deprecated: 'ct: Use #sendsSelector:.'.
^ self sendsSelector: selector!
----- Method: TestCase>>openDebuggerOnFailingTestMethod (in category '*60Deprecated-running') -----
openDebuggerOnFailingTestMethod
self deprecated: 'ct: Use #debugAsFailure'.
"SUnit has halted one step in front of the failing test method. Step over the 'self halt' and
send into 'self perform: testSelector' to see the failure from the beginning"
self
halt;
performTest!
----- Method: TestCase>>runCaseAsFailure: (in category '*60Deprecated-running') -----
runCaseAsFailure: aSemaphore
self deprecated: 'ct: Use #runCaseWithoutTimeout and #ensure:'.
^ [self runCaseWithoutTimeout]
ensure: [aSemaphore signal]!
----- Method: TestCase>>shouldFix: (in category '*60Deprecated-asserting - extensions') -----
shouldFix: aBlock
self deprecated: 'Handling exceptions of all kind is disrecommended. To test for errors, send #shouldRaiseError: instead. You can also send #should:raise: to test against specific exception classes such as Warning or NotFound. See also the class comments on Exception and Error.'.
^self should: aBlock raise: Exception!
----- Method: Debugger class>>context: (in category '*60Deprecated-opening') -----
context: aContext
self deprecated.
^ self
openOn: Processor activeProcess
context: aContext
label: 'Debug'
contents: nil
fullView: false!
----- Method: Debugger class>>openContext:label:contents: (in category '*60Deprecated-opening') -----
openContext: aContext label: aString contents: contentsStringOrNil
self deprecated.
^ self
openOn: Processor activeProcess
context: aContext
label: aString
contents: contentsStringOrNil
fullView: false
!
----- Method: Debugger class>>openInterrupt:onProcess: (in category '*60Deprecated-opening') -----
openInterrupt: aString onProcess: aProcess
self deprecated.
^ aProcess debugWithTitle: aString full: false!
----- Method: Debugger>>abandon: (in category '*60Deprecated-context stack menu') -----
abandon: aTopView
self deprecated.
self abandon.!
----- Method: Debugger>>classHierarchy (in category '*60Deprecated-toolbuilder') -----
classHierarchy
self deprecated: 'Use #browseClassHierarchy instead'.
self browseClassHierarchy.!
----- Method: Debugger>>interruptedProcessIsActive (in category '*60Deprecated-testing') -----
interruptedProcessIsActive
self deprecated: 'ct: Use #interruptedProcessIsReady'.
^interruptedProcess isTerminated not!
----- Method: Debugger>>lowSpaceChoices (in category '*60Deprecated-private') -----
lowSpaceChoices
self deprecated.
^ Smalltalk lowSpaceChoices!
----- Method: Debugger>>proceed: (in category '*60Deprecated-context stack menu') -----
proceed: aTopView
self deprecated: 'If you want to close a view, put it into an #ensure: block around this call.'.
self proceed.!
----- Method: Debugger>>receiverInspectorObject:context: (in category '*60Deprecated-accessing') -----
receiverInspectorObject: obj context: ctxt
"set context before object so it can refer to context when building field list"
self deprecated: 'Talk to #receiverInspector directly.'.
receiverInspector context: ctxt.
receiverInspector inspect: obj.
!
----- Method: DockingBarItemMorph>>updateLayoutInDockingBar (in category '*60Deprecated-private') -----
updateLayoutInDockingBar
self deprecated: 'Owner will update its items if required. See DockingBarMorph >> #updateLayoutProperties.'.
owner addedMorph: self.!
----- Method: PasteUpMorph>>isOpenForDragNDropString (in category '*60Deprecated-menu & halo') -----
isOpenForDragNDropString
"Answer the string to be shown in a menu to represent the
open-to-drag-n-drop status"
self deprecated.
^ (self dragNDropEnabled
ifTrue: ['<on>']
ifFalse: ['<off>'])
, 'open to drag & drop' translated!
----- Method: PasteUpMorph>>modalWindow: (in category '*60Deprecated-accessing') -----
modalWindow: aMorph
self deprecated: 'The global becomeModal is no longer supported, use e.g. a dialog window'.
"(self valueOfProperty: #modalWindow)
ifNotNil: [:morph | morph doCancel].
self setProperty: #modalWindow toValue: aMorph.
aMorph
ifNotNil: [self
when: #aboutToLeaveWorld
send: #removeModalWindow
to: self]"!
----- Method: PasteUpMorph>>removeModalWindow (in category '*60Deprecated-accessing') -----
removeModalWindow
self deprecated: 'The global becomeModal is no longer supported, use e.g. a dialog window'.
"self modalWindow: nil"!
----- Method: Deprecation class>>maybeSignalDeprecationFor:message:explanation: (in category '*60Deprecated-utilities') -----
maybeSignalDeprecationFor: context message: messageString explanation: explanationString
self flag: #deprecated.
^ self
signalForContext: context
message: messageString
explanation: explanationString!
----- Method: NewParagraph>>lineIndexForCharacter: (in category '*60Deprecated-private') -----
lineIndexForCharacter: characterIndex
self deprecated: 'Use #lineIndexOfCharacterIndex: instead'.
^self lineIndexOfCharacterIndex: characterIndex !
LazyListMorph subclass: #MulticolumnLazyListMorph
instanceVariableNames: 'columnWidths'
classVariableNames: ''
poolDictionaries: ''
category: '60Deprecated-Morphic-Widgets'!
!MulticolumnLazyListMorph commentStamp: '<historical>' prior: 0!
A variant of LazyListMorph that can display multi-column lists.!
----- Method: MulticolumnLazyListMorph>>display:atRow:on: (in category 'drawing') -----
display: items atRow: row on: canvas
"display the specified item, which is on the specified row; for Multicolumn
lists, items will be a list of strings"
| drawBounds |
drawBounds := (self drawBoundsForRow: row) translateBy: (self hMargin @ 0).
drawBounds := drawBounds intersect: self bounds.
items
with: (1 to: items size)
do: [:item :index |
"move the bounds to the right at each step"
index > 1
ifTrue: [drawBounds := drawBounds left: drawBounds left + 6
+ (columnWidths at: index - 1)].
item isText
ifTrue: [canvas
drawString: item
in: drawBounds
font: (font
emphasized: (item emphasisAt: 1))
color: (self colorForRow: row)]
ifFalse: [canvas
drawString: item
in: drawBounds
font: font
color: (self colorForRow: row)]]!
----- Method: MulticolumnLazyListMorph>>drawOn: (in category 'drawing') -----
drawOn: aCanvas
self getListSize = 0 ifTrue:[ ^self ].
self setColumnWidthsFor: aCanvas.
super drawOn: aCanvas!
----- Method: MulticolumnLazyListMorph>>getListItem: (in category 'list access') -----
getListItem: index
^listSource getListItem: index!
----- Method: MulticolumnLazyListMorph>>listChanged (in category 'list management') -----
listChanged
columnWidths := nil.
super listChanged!
----- Method: MulticolumnLazyListMorph>>setColumnWidthsFor: (in category 'drawing') -----
setColumnWidthsFor: aCanvas
| row topRow bottomRow |
"set columnWidths for drawing on the specified canvas"
columnWidths ifNil: [
columnWidths := (self item: 1) collect: [ :ignored | 0 ]. ].
topRow := (self topVisibleRowForCanvas: aCanvas) max: 1.
bottomRow := (self bottomVisibleRowForCanvas: aCanvas) max: 1.
topRow > bottomRow ifTrue: [ ^ self ].
topRow to: bottomRow do: [ :rowIndex |
row := self item: rowIndex.
columnWidths := columnWidths with: row collect: [ :currentWidth :item |
| widthOfItem |
widthOfItem := (font widthOfStringOrText: item).
widthOfItem > currentWidth
ifTrue: [ self changed. widthOfItem ]
ifFalse: [ currentWidth ] ] ]!
----- Method: MulticolumnLazyListMorph>>widthToDisplayItem: (in category 'scroll range') -----
widthToDisplayItem: item
| widths |
widths := item collect: [ :each | super widthToDisplayItem: each ].
^widths sum + (10 * (widths size - 1)) "add in space between the columns"
!
----- Method: MenuMorph>>filterListWith: (in category '*60Deprecated-keyboard control') -----
filterListWith: char
| matchString |
self deprecated: 'ct: Use #handleFiltering: instead'.
matchString := self matchString copyWith: char.
matchString := matchString copyWithout: Character backspace.
self matchString: matchString!
----- Method: MenuMorph>>unfilterOrEscape: (in category '*60Deprecated-keyboard control') -----
unfilterOrEscape: evt
self deprecated: 'Use #handleEscStroke: instead'.
self matchString ifNil: [
self removeMatchString].
"If a stand-alone menu, just delete it"
popUpOwner ifNil: [^self delete].
"If a sub-menu, then deselect, and return focus to outer menu"
self selectSuperMenu: evt.!
UndeclaredVariableNotification subclass: #UndeclaredVariableWarning
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: '60Deprecated-Compiler-Support'!
----- Method: UndeclaredVariableWarning class>>handles: (in category 'exceptionSelector') -----
handles: exception
^ UndeclaredVariableNotification handles: exception!
----- Method: DictionaryInspector>>refreshView (in category '*60Deprecated-menu commands') -----
refreshView
self deprecated: 'Use #update instead.'.
^ self update!
----- Method: DictionaryInspector>>selectionReferences (in category '*60Deprecated-menu commands') -----
selectionReferences
self deprecated: 'Use #usersOfSelectedBinding.'.
self usersOfSelectedBinding.!
----- Method: FileList class>>allRegisteredServices (in category '*60Deprecated-Tools-file reader registration') -----
allRegisteredServices
| col |
self deprecated: 'FileList is not responsible for file reader registration anymore. Use FileServices instead.'.
col := OrderedCollection new.
self registeredFileReaderClasses do: [:each | col addAll: (each services)].
^ col!
----- Method: FileList class>>detectService:ifNone: (in category '*60Deprecated-Tools-file reader registration') -----
detectService: aBlock ifNone: anotherBlock
"self detectService: [:each | each selector = #fileIn:] ifNone: [nil]"
self deprecated: 'FileList is not responsible for file reader registration anymore. Use FileServices instead.'.
^ self allRegisteredServices
detect: aBlock
ifNone: anotherBlock!
----- Method: FileList class>>isReaderNamedRegistered: (in category '*60Deprecated-Tools-file reader registration') -----
isReaderNamedRegistered: aSymbol
"return if a given reader class has been registered. Note that this is on purpose that the argument is
a symbol and not a class"
self deprecated: 'FileList is not responsible for file reader registration anymore. Use FileServices instead.'.
^ (self registeredFileReaderClasses collect: [:each | each name]) includes: aSymbol
!
----- Method: FileList class>>itemsForDirectory: (in category '*60Deprecated-Tools-file reader registration') -----
itemsForDirectory: aFileDirectory
"Answer a list of services appropriate when no file is selected."
| services |
self deprecated: 'FileList is not responsible for file reader registration anymore. Use FileServices instead.'.
services := OrderedCollection new.
self registeredFileReaderClasses do: [:reader |
reader ifNotNil: [services addAll: (reader fileReaderServicesForDirectory: aFileDirectory) ]].
^ services!
----- Method: FileList class>>itemsForFile: (in category '*60Deprecated-Tools-file reader registration') -----
itemsForFile: fullName
"Answer a list of services appropriate for a file of the given full name"
| services suffix |
self deprecated: 'FileList is not responsible for file reader registration anymore. Use FileServices instead.'.
suffix := self suffixOf: fullName.
services := OrderedCollection new.
self registeredFileReaderClasses do: [:reader |
reader ifNotNil: [services addAll: (reader fileReaderServicesForFile: fullName suffix: suffix)]].
^ services!
----- Method: FileList class>>registerFileReader: (in category '*60Deprecated-Tools-file reader registration') -----
registerFileReader: aProviderClass
"register the given class as providing services for reading files"
| registeredReaders |
self deprecated: 'FileList is not responsible for file reader registration anymore. Use FileServices instead.'.
registeredReaders := self registeredFileReaderClasses.
(registeredReaders includes: aProviderClass)
ifFalse: [ registeredReaders addLast: aProviderClass ]!
----- Method: FileList class>>registeredFileReaderClasses (in category '*60Deprecated-Tools-file reader registration') -----
registeredFileReaderClasses
self deprecated: 'FileList is not responsible for file reader registration anymore. Use FileServices instead.'.
FileReaderRegistry := nil. "wipe it out"
^FileServices registeredFileReaderClasses
!
----- Method: FileList class>>suffixOf: (in category '*60Deprecated-Tools-file reader registration') -----
suffixOf: aName
"Answer the file extension of the given file"
self deprecated: 'FileList is not responsible for file reader registration anymore. Use FileServices instead.'.
^ aName
ifNil:
['']
ifNotNil:
[(FileDirectory extensionFor: aName) asLowercase]!
----- Method: FileList class>>unregisterFileReader: (in category '*60Deprecated-Tools-file reader registration') -----
unregisterFileReader: aProviderClass
"unregister the given class as providing services for reading files"
self deprecated: 'FileList is not responsible for file reader registration anymore. Use FileServices instead.'.
self registeredFileReaderClasses remove: aProviderClass ifAbsent: [nil]!
----- Method: DirectoryEntry class>>name:creationTime:modificationTime:isDirectory:fileSize: (in category '*60Deprecated-Files-Directories') -----
name: name0 creationTime: creationTime modificationTime: modificationTime isDirectory: isDirectory fileSize: fileSize
| type |
self deprecated: 'Please use ', #directory:name:creationTime:modificationTime:fileSize:.
type := isDirectory
ifTrue: [ DirectoryEntryDirectory ]
ifFalse: [ DirectoryEntryFile ].
^ type
directory: nil
name: name0
creationTime: creationTime
modificationTime: modificationTime
fileSize: fileSize!
----- Method: StringHolder>>classHierarchy (in category '*60Deprecated-Tools') -----
classHierarchy
self deprecated: 'Use #browseClassHierarchy instead'.
self browseClassHierarchy.!
----- Method: StringHolder>>someTextPaneWithSelector: (in category '*60Deprecated-Tools') -----
someTextPaneWithSelector: aSymbol
self deprecated.
^ self anyTextPaneWithSelector: aSymbol!
HelpTopic subclass: #CodeStyledHelpTopic
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: '60Deprecated-HelpSystem-Core-Model'!
!CodeStyledHelpTopic commentStamp: 'tpr 6/19/2018 19:27' prior: 0!
A CodeStyledHelpTopic is a simple way to make sure a help topic gets styled for code in a help browser. Once the help browser is able to code-style individual chunks instead of having to brute-force entire pages we can remove this class and simplify thngs!
----- Method: CodeStyledHelpTopic>>usesCodeStyling (in category 'testing') -----
usesCodeStyling
"do I need a styled (ie with Shout) browser page?"
^true!
More information about the Squeak-dev
mailing list
|