[Pkg] The Trunk: Kernel-bf.890.mcz

commits at source.squeak.org commits at source.squeak.org
Mon Dec 8 00:48:21 UTC 2014


Bert Freudenberg uploaded a new version of Kernel to project The Trunk:
http://source.squeak.org/trunk/Kernel-bf.890.mcz

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

Name: Kernel-bf.890
Author: bf
Time: 8 December 2014, 1:47:26.425 am
UUID: 578f262a-c72b-4a4f-b9ce-813aeb77728b
Ancestors: Kernel-eem.889

Restore timestamps lost in assignment conversion.

=============== Diff against Kernel-eem.889 ===============

Item was changed:
  ----- Method: Behavior class>>canZapMethodDictionary (in category 'testing') -----
  canZapMethodDictionary
  	"Return false since zapping the method dictionary of Behavior class or its subclasses will cause the system to fail."
  	^false!

Item was changed:
  ----- Method: Behavior>>>> (in category 'accessing method dictionary') -----
  >> selector 
  	"Answer the compiled method associated with the argument, selector (a 
  	Symbol), a message selector in the receiver's method dictionary. If the 
  	selector is not in the dictionary, create an error notification."
  
  	^self compiledMethodAt: selector
  !

Item was changed:
  ----- Method: Behavior>>addSelector:withMethod: (in category 'adding/removing methods') -----
  addSelector: selector withMethod: compiledMethod 
  	^ self addSelector: selector withMethod: compiledMethod notifying: nil!

Item was changed:
  ----- Method: Behavior>>bindingOf: (in category 'testing method dictionary') -----
  bindingOf: varName
  	"Answer the binding of some variable resolved in the scope of the receiver"
  	^superclass bindingOf: varName!

Item was changed:
  ----- Method: Behavior>>canZapMethodDictionary (in category 'testing') -----
  canZapMethodDictionary
  	"Return true if it is safe to zap the method dictionary on #obsolete"
  	^true!

Item was changed:
  ----- Method: Behavior>>compiledMethodAt: (in category 'accessing method dictionary') -----
  compiledMethodAt: selector 
  	"Answer the compiled method associated with the argument, selector (a 
  	Symbol), a message selector in the receiver's method dictionary. If the 
  	selector is not in the dictionary, create an error notification."
  
  	^ self methodDict at: selector!

Item was changed:
  ----- Method: Behavior>>copyOfMethodDictionary (in category 'copying') -----
  copyOfMethodDictionary
  	"Return a copy of the receiver's method dictionary"
  
  	^ self methodDict copy!

Item was changed:
  ----- Method: Behavior>>emptyMethodDictionary (in category 'initialize-release') -----
  emptyMethodDictionary
  
  	^ MethodDictionary new!

Item was changed:
  ----- Method: Behavior>>formalHeaderPartsFor: (in category 'accessing method dictionary') -----
  "popeye" formalHeaderPartsFor: "olive oil" aSelector
  	"RELAX!!  The warning you may have just seen about possibly having a bad source file does not apply here, because this method *intends* to have its source code start with a comment.
  	This method returns a collection giving the parts in the formal declaration for aSelector.  This parse is in support of schemes in which adjutant properties of a method can be declared via special comments secreted in the formal header
  	The result will have
       	3 elements for a simple, argumentless selector.
  		5 elements for a single-argument selector
  		9 elements for a two-argument selector
  		13 elements for a three-argument, selector
  		etc...
  
  	The syntactic elements are:
  
  		1		comment preceding initial selector fragment
  
  		2		first selector fragment
  		3		comment following first selector fragment  (nil if selector has no arguments)
  
          ----------------------  (ends here for, e.g., #copy)
  
  		4		first formal argument
  		5		comment following first formal argument (nil if selector has only one argument)
  
          ----------------------  (ends here for, e.g., #copyFrom:)
  
  		6		second keyword
  		7		comment following second keyword
  		8		second formal argument
  		9		comment following second formal argument (nil if selector has only two arguments)
  
           ----------------------  (ends here for, e.g., #copyFrom:to:)
  
  	Any nil element signifies an absent comment.
  	NOTE: The comment following the final formal argument is *not* successfully retrieved by this method in its current form, though it can be obtained, if needed, by other means (e.g. calling #firstPrecodeCommentFor:).  Thus, the *final* element in the structure returned by this method is always going to be nil."
  
  	^ Scanner new scanMessageParts: (self methodHeaderFor: aSelector)
  
  "
  	Behavior class formalHeaderPartsFor: #formalHeaderPartsFor:
  "
  
  
  	!

Item was changed:
  ----- Method: Behavior>>fullyImplementsVocabulary: (in category 'testing method dictionary') -----
  fullyImplementsVocabulary: aVocabulary
  	"Answer whether instances of the receiver respond to all the messages in aVocabulary"
  
  	(aVocabulary encompassesAPriori: self) ifTrue: [^ true].
  	aVocabulary allSelectorsInVocabulary do:
  		[:aSelector | (self canUnderstand: aSelector) ifFalse: [^ false]].
  	^ true!

Item was changed:
  ----- Method: Behavior>>hasMethods (in category 'testing method dictionary') -----
  hasMethods
  	"Answer whether the receiver has any methods in its method dictionary."
  
  	^ self methodDict size > 0!

Item was changed:
  ----- Method: Behavior>>includesSelector: (in category 'testing method dictionary') -----
  includesSelector: aSymbol 
  	"Answer whether the message whose selector is the argument is in the 
  	method dictionary of the receiver's class."
  
  	^ self methodDict includesKey: aSymbol!

Item was changed:
  ----- Method: Behavior>>isMeta (in category 'testing') -----
  isMeta
  	^ false!

Item was changed:
  ----- Method: Behavior>>longPrintOn: (in category 'printing') -----
  longPrintOn: aStream
  	"Append to the argument, aStream, the names and values of all of the receiver's instance variables.  But, not useful for a class with a method dictionary."
  
  	aStream nextPutAll: '<<too complex to show>>'; cr.!

Item was changed:
  ----- Method: Behavior>>methodDictionary (in category 'accessing method dictionary') -----
  methodDictionary
  	"Convenience"
  	^self methodDict!

Item was changed:
  ----- Method: Behavior>>methodsDo: (in category 'accessing method dictionary') -----
  methodsDo: aBlock
  	"Evaluate aBlock for all the compiled methods in my method dictionary."
  
  	^ self methodDict valuesDo: aBlock!

Item was changed:
  ----- Method: Behavior>>recompile: (in category 'compiling') -----
  recompile: selector
  	"Compile the method associated with selector in the receiver's method dictionary."
  	^self recompile: selector from: self!

Item was changed:
  ----- Method: Behavior>>removeSelectorSilently: (in category 'adding/removing methods') -----
  removeSelectorSilently: selector 
  	"Remove selector without sending system change notifications"
  
  	^ SystemChangeNotifier uniqueInstance doSilently: [self removeSelector: selector].!

Item was changed:
  ----- Method: Behavior>>selectorsDo: (in category 'accessing method dictionary') -----
  selectorsDo: selectorBlock
  	"Evaluate selectorBlock for all the message selectors in my method dictionary."
  
  	^ self methodDict keysDo: selectorBlock!

Item was changed:
  ----- Method: Behavior>>sourceCodeAt: (in category 'accessing method dictionary') -----
  sourceCodeAt: selector
  
  	^ (self methodDict at: selector) getSourceFor: selector in: self!

Item was changed:
  ----- Method: Behavior>>sourceCodeAt:ifAbsent: (in category 'accessing method dictionary') -----
  sourceCodeAt: selector ifAbsent: aBlock
  
  	^ (self methodDict at: selector ifAbsent: [^ aBlock value]) getSourceFor: selector in: self!

Item was changed:
  ----- Method: Behavior>>sourceMethodAt:ifAbsent: (in category 'accessing method dictionary') -----
  sourceMethodAt: selector ifAbsent: aBlock
  	"Answer the paragraph corresponding to the source code for the 
  	argument."
  
  	^ (self sourceCodeAt: selector ifAbsent: [^ aBlock value]) asText makeSelectorBoldIn: self!

Item was changed:
  ----- Method: Behavior>>standardMethodHeaderFor: (in category 'accessing method dictionary') -----
  standardMethodHeaderFor: aSelector
  	| args |
  	args := (1 to: aSelector numArgs)	collect:[:i| 'arg', i printString].
  	args size = 0 ifTrue:[^aSelector asString].
  	args size = 1 ifTrue:[^aSelector,' arg1'].
  	^String streamContents:[:s|
  		(aSelector findTokens:':') with: args do:[:tok :arg|
  			s nextPutAll: tok; nextPutAll:': '; nextPutAll: arg; nextPutAll:' '.
  		].
  	].
  !

Item was changed:
  ----- Method: Behavior>>superclass:methodDictionary:format: (in category 'initialize-release') -----
  superclass: aClass methodDictionary: mDict format: fmt
  	"Basic initialization of the receiver.
  	Must only be sent to a new instance; else we would need Object flushCache."
  	superclass := aClass.
  	format := fmt.
  	methodDict := mDict.!

Item was changed:
  ----- Method: BlockClosure>>assert (in category 'exceptions') -----
  assert
  	self assert: self!

Item was changed:
  ----- Method: BlockClosure>>doWhileFalse: (in category 'controlling') -----
  doWhileFalse: conditionBlock
  	"Evaluate the receiver once, then again as long the value of conditionBlock is false."
   
  	| result |
  	[result := self value.
  	conditionBlock value] whileFalse.
  
  	^ result!

Item was changed:
  ----- Method: BlockClosure>>doWhileTrue: (in category 'controlling') -----
  doWhileTrue: conditionBlock
  	"Evaluate the receiver once, then again as long the value of conditionBlock is true."
   
  	| result |
  	[result := self value.
  	conditionBlock value] whileTrue.
  
  	^ result!

Item was changed:
  ----- Method: BlockClosure>>repeat (in category 'controlling') -----
  repeat
  	"Evaluate the receiver repeatedly, ending only if the block explicitly returns."
  
  	[self value. true] whileTrue!

Item was changed:
  ----- Method: BlockClosure>>repeatWithGCIf: (in category 'controlling') -----
  repeatWithGCIf: testBlock
  	| ans |
  	"run the receiver, and if testBlock returns true, garbage collect and run the receiver again"
  	ans := self value.
  	(testBlock value: ans) ifTrue: [ Smalltalk garbageCollect. ans := self value ].
  	^ans!

Item was changed:
  ----- Method: BlockClosure>>timeToRun (in category 'evaluating') -----
  timeToRun
  	"Answer the number of milliseconds taken to execute this block."
  
  	^ Time millisecondsToRun: self
  !

Item was changed:
  ----- Method: BlockClosure>>whileFalse (in category 'controlling') -----
  whileFalse
  	"Ordinarily compiled in-line, and therefore not overridable.
  	This is in case the message is sent to other than a literal block.
  	Evaluate the receiver, as long as its value is false."
   
  	^ [self value] whileFalse: []!

Item was changed:
  ----- Method: BlockClosure>>whileFalse: (in category 'controlling') -----
  whileFalse: aBlock 
  	"Ordinarily compiled in-line, and therefore not overridable.
  	This is in case the message is sent to other than a literal block.
  	Evaluate the argument, aBlock, as long as the value of the receiver is false."
  
  	^ [self value] whileFalse: [aBlock value]!

Item was changed:
  ----- Method: BlockClosure>>whileTrue (in category 'controlling') -----
  whileTrue
  	"Ordinarily compiled in-line, and therefore not overridable.
  	This is in case the message is sent to other than a literal block.
  	Evaluate the receiver, as long as its value is true."
   
  	^ [self value] whileTrue: []!

Item was changed:
  ----- Method: BlockClosure>>whileTrue: (in category 'controlling') -----
  whileTrue: aBlock 
  	"Ordinarily compiled in-line, and therefore not overridable.
  	This is in case the message is sent to other than a literal block.
  	Evaluate the argument, aBlock, as long as the value of the receiver is true."
  
  	^ [self value] whileTrue: [aBlock value]!

Item was changed:
  ----- Method: Class>>deactivate (in category 'initialize-release') -----
  deactivate
  	"A remnant from the 3.3a modules work, retained . Does nothing, but may be overridden in Metaclasses."!

Item was changed:
  ----- Method: Class>>fileOut (in category 'fileIn/Out') -----
  fileOut
  	"Create a file whose name is the name of the receiver with '.st' as the 
  	extension, and file a description of the receiver onto it."
  	^ self fileOutAsHtml: false!

Item was changed:
  ----- Method: Class>>fileOutAsHtml: (in category 'fileIn/Out') -----
  fileOutAsHtml: useHtml
  	"File a description of the receiver onto a new file whose base name is the name of the receiver."
  
  	| internalStream |
  	internalStream := WriteStream on: (String new: 100).
  	internalStream header; timeStamp.
  
  	self sharedPools size > 0 ifTrue: [
  		self shouldFileOutPools
  			ifTrue: [self fileOutSharedPoolsOn: internalStream]].
  	self fileOutOn: internalStream moveSource: false toFile: 0.
  	internalStream trailer.
  
  	FileStream writeSourceCodeFrom: internalStream baseName: self name isSt: true useHtml: useHtml.
  !

Item was changed:
  ----- Method: Class>>fileOutInitializerOn: (in category 'fileIn/Out') -----
  fileOutInitializerOn: aStream
  	^self class fileOutInitializerOn: aStream!

Item was changed:
  ----- Method: Class>>fileOutOn:moveSource:toFile: (in category 'fileIn/Out') -----
  fileOutOn: aFileStream moveSource: moveSource toFile: fileIndex 
  	"File a description of the receiver on aFileStream. If the boolean argument,
  	moveSource, is true, then set the trailing bytes to the position of aFileStream and
  	to fileIndex in order to indicate where to find the source code."
  	^self fileOutOn: aFileStream moveSource: moveSource toFile: fileIndex initializing: true!

Item was changed:
  ----- Method: Class>>fileOutSharedPoolsOn: (in category 'fileIn/Out') -----
  fileOutSharedPoolsOn: aFileStream
  	"file out the shared pools of this class after prompting the user about each pool"
  	| poolsToFileOut |
  	poolsToFileOut := self sharedPools select: 
  		[:aPool | (self shouldFileOutPool: (self environment keyAtIdentityValue: aPool))].
  	poolsToFileOut do: [:aPool | self fileOutPool: aPool onFileStream: aFileStream].
  	!

Item was changed:
  ----- Method: Class>>removeFromChanges (in category 'fileIn/Out') -----
  removeFromChanges
  	"References to the receiver, a class, and its metaclass should no longer be included in the system ChangeSet.
  	7/18/96 sw: call removeClassAndMetaClassChanges:"
  
  	ChangeSet current removeClassAndMetaClassChanges: self!

Item was changed:
  ----- Method: Class>>removeFromSystem (in category 'initialize-release') -----
  removeFromSystem
  	"Forget the receiver from the Smalltalk global dictionary. Any existing 
  	instances will refer to an obsolete version of the receiver."
  	self removeFromSystem: true.!

Item was changed:
  ----- Method: Class>>removeFromSystem: (in category 'initialize-release') -----
  removeFromSystem: logged
  	"Forget the receiver from the Smalltalk global dictionary. Any existing 
  	instances will refer to an obsolete version of the receiver."
  	
  	"keep the class name and category for triggering the system change message. If we wait to long, then we get obsolete information which is not what we want."
  
  	"tell class to deactivate and unload itself-- two separate events in the module system"
  	self deactivate; unload.
  	self superclass ifNotNil:
  		["If we have no superclass there's nothing to be remembered"
  		self superclass addObsoleteSubclass: self].
  	self environment forgetClass: self logged: logged.
  	self obsolete.!

Item was changed:
  ----- Method: Class>>removeFromSystemUnlogged (in category 'initialize-release') -----
  removeFromSystemUnlogged
  	"Forget the receiver from the Smalltalk global dictionary. Any existing instances will refer to an obsolete version of the receiver.  Do not log the removal either to the current change set nor to the system changes log"
  	^self removeFromSystem: false!

Item was changed:
  ----- Method: Class>>storeDataOn: (in category 'fileIn/Out') -----
  storeDataOn: aDataStream
  	"I don't get stored.  Use a DiskProxy"
  
  	(aDataStream insideASegment and: [self isSystemDefined not]) ifTrue: [
  		^ super storeDataOn: aDataStream].	"do trace me"
  	self error: 'use a DiskProxy to store a Class'!

Item was changed:
  ----- Method: Class>>superclass:methodDict:format:name:organization:instVarNames:classPool:sharedPools: (in category 'initialize-release') -----
  superclass: sup methodDict: md format: ft name: nm organization: org instVarNames: nilOrArray classPool: pool sharedPools: poolSet 
  	"Answer an instance of me, a new class, using the arguments of the 
  	message as the needed information.
  	Must only be sent to a new instance; else we would need Object flushCache."
  
  	superclass := sup.
  	methodDict := md.
  	format := ft.
  	name := nm.
  	instanceVariables := nilOrArray.
  	classPool := pool.
  	sharedPools := poolSet.
  	self organization: org.!

Item was changed:
  ----- Method: Class>>unload (in category 'initialize-release') -----
  unload
  	"Sent when a the class is removed.  Does nothing, but may be overridden by (class-side) subclasses."
  !

Item was changed:
  ----- Method: ClassDescription>>addSelector:withMethod:notifying: (in category 'accessing method dictionary') -----
  addSelector: selector withMethod: compiledMethod notifying: requestor
  	| priorMethodOrNil |
  	priorMethodOrNil := self compiledMethodAt: selector ifAbsent: [nil].
  	self addSelectorSilently: selector withMethod: compiledMethod.
  	priorMethodOrNil isNil
  		ifTrue: [SystemChangeNotifier uniqueInstance methodAdded: compiledMethod selector: selector inClass: self requestor: requestor]
  		ifFalse: [SystemChangeNotifier uniqueInstance methodChangedFrom: priorMethodOrNil to: compiledMethod selector: selector inClass: self requestor: requestor].!

Item was changed:
  ----- Method: ClassDescription>>allInstVarNamesEverywhere (in category 'instance variables') -----
  allInstVarNamesEverywhere
  	"Answer the set of inst var names used by the receiver, all superclasses, and all subclasses"
  
  	| aList |
  	aList := OrderedCollection new.
  	(self allSuperclasses , self withAllSubclasses asOrderedCollection) do:
  		[:cls | aList addAll: cls instVarNames].
  	^ aList asSet
  
  	"BorderedMorph allInstVarNamesEverywhere"!

Item was changed:
  ----- Method: ClassDescription>>checkForInstVarsOK: (in category 'instance variables') -----
  checkForInstVarsOK: instVarString
  	"Return true if instVarString does no include any names used in a subclass"
  	| instVarArray |
  	instVarArray := Scanner new scanFieldNames: instVarString.
  	self allSubclasses do:
  		[:cl | cl instVarNames do:
  			[:n | (instVarArray includes: n)
  				ifTrue: [self error: n , ' is already used in ' , cl name.
  						^ false]]].
  	^ true!

Item was changed:
  ----- Method: ClassDescription>>classComment: (in category 'fileIn/Out') -----
  classComment: aString
  	"Store the comment, aString or Text or RemoteString, associated with the class we are orgainzing.  Empty string gets stored only if had a non-empty one before."
  	^ self classComment: aString stamp: '<historical>'!

Item was changed:
  ----- Method: ClassDescription>>classComment:stamp: (in category 'fileIn/Out') -----
  classComment: aString stamp: aStamp
  	"Store the comment, aString or Text or RemoteString, associated with the class we are organizing.  Empty string gets stored only if had a non-empty one before."
  
  	| ptr header file oldCommentRemoteStr |
  	(aString isKindOf: RemoteString) ifTrue:
  		[SystemChangeNotifier uniqueInstance classCommented: self.
  		^ self organization classComment: aString stamp: aStamp].
  
  	oldCommentRemoteStr := self organization commentRemoteStr.
  	(aString size = 0) & (oldCommentRemoteStr == nil) ifTrue: [^ self organization classComment: nil].
  		"never had a class comment, no need to write empty string out"
  
  	ptr := oldCommentRemoteStr ifNil: [0] ifNotNil: [oldCommentRemoteStr sourcePointer].
  	SourceFiles ifNotNil: [(file := SourceFiles at: 2) ifNotNil:
  		[file setToEnd; cr; nextPut: $!!.	"directly"
  		"Should be saying (file command: 'H3') for HTML, but ignoring it here"
  		header := String streamContents: [:strm | strm nextPutAll: self name;
  			nextPutAll: ' commentStamp: '.
  			aStamp storeOn: strm.
  			strm nextPutAll: ' prior: '; nextPutAll: ptr printString].
  		file nextChunkPut: header]].
  	self organization classComment: (RemoteString newString: aString onFileNumber: 2) stamp: aStamp.
  	SystemChangeNotifier uniqueInstance classCommented: self.
  !

Item was changed:
  ----- Method: ClassDescription>>commentFollows (in category 'fileIn/Out') -----
  commentFollows 
  	"Answer a ClassCommentReader who will scan in the comment."
  
  	^ ClassCommentReader new setClass: self category: #Comment
  
  	"False commentFollows inspect"!

Item was changed:
  ----- Method: ClassDescription>>commentStamp:prior: (in category 'fileIn/Out') -----
  commentStamp: changeStamp prior: indexAndOffset
  	"Prior source link ignored when filing in."
  
  	^ ClassCommentReader new setClass: self
  				category: #Comment
  				changeStamp: changeStamp!

Item was changed:
  ----- Method: ClassDescription>>compile:classified:notifying: (in category 'compiling') -----
  compile: text classified: category notifying: requestor
  	| stamp |
  	stamp := self acceptsLoggingOfCompilation ifTrue: [Utilities changeStamp] ifFalse: [nil].
  	^ self compile: text classified: category
  		withStamp: stamp notifying: requestor!

Item was changed:
  ----- Method: ClassDescription>>compile:classified:withStamp:notifying: (in category 'compiling') -----
  compile: text classified: category withStamp: changeStamp notifying: requestor
  	^ self compile: text classified: category withStamp: changeStamp notifying: requestor logSource: self acceptsLoggingOfCompilation!

Item was changed:
  ----- Method: ClassDescription>>compileSilently:classified: (in category 'compiling') -----
  compileSilently: code classified: category
  	"Compile the code and classify the resulting method in the given category, leaving no trail in the system log, nor in any change set, nor in the 'recent submissions' list. This should only be used when you know for sure that the compilation will succeed."
  
  	^ self compileSilently: code classified: category notifying: nil.!

Item was changed:
  ----- Method: ClassDescription>>compileSilently:classified:notifying: (in category 'compiling') -----
  compileSilently: code classified: category notifying: requestor
  	"Compile the code and classify the resulting method in the given category, leaving no trail in the system log, nor in any change set, nor in the 'recent submissions' list. This should only be used when you know for sure that the compilation will succeed."
  
  	^ SystemChangeNotifier uniqueInstance 
  		doSilently: [self compile: code classified: category withStamp: nil notifying: requestor logSource: false].!

Item was changed:
  ----- Method: ClassDescription>>copy:from:classified: (in category 'copying') -----
  copy: sel from: class classified: cat 
  	"Install the method associated with the first arugment, sel, a message 
  	selector, found in the method dictionary of the second argument, class, 
  	as one of the receiver's methods. Classify the message under the third 
  	argument, cat."
  
  	| code category |
  	"Useful when modifying an existing class"
  	code := class sourceMethodAt: sel.
  	code == nil
  		ifFalse: 
  			[cat == nil
  				ifTrue: [category := class organization categoryOfElement: sel]
  				ifFalse: [category := cat].
  			(self methodDict includesKey: sel)
  				ifTrue: [code asString = (self sourceMethodAt: sel) asString 
  							ifFalse: [self error: self name 
  										, ' ' 
  										, sel 
  										, ' will be redefined if you proceed.']].
  			self compile: code classified: category]!

Item was changed:
  ----- Method: ClassDescription>>doneCompiling (in category 'compiling') -----
  doneCompiling
  	"A ClassBuilder has finished the compilation of the receiver.
  	This message is a notification for a class that needs to do some
  	cleanup / reinitialization after it has been recompiled."!

Item was changed:
  ----- Method: ClassDescription>>fileOutCategory: (in category 'fileIn/Out') -----
  fileOutCategory: catName 
  	^ self fileOutCategory: catName asHtml: false!

Item was changed:
  ----- Method: ClassDescription>>fileOutCategory:asHtml: (in category 'fileIn/Out') -----
  fileOutCategory: catName asHtml: useHtml
  	"FileOut the named category, possibly in Html format."
  	| internalStream |
  	internalStream := WriteStream on: (String new: 1000).
  	internalStream header; timeStamp.
  	self fileOutCategory: catName on: internalStream moveSource: false toFile: 0.
  	internalStream trailer.
  
  	FileStream writeSourceCodeFrom: internalStream baseName: (self name , '-' , catName) isSt: true useHtml: useHtml.!

Item was changed:
  ----- Method: ClassDescription>>fileOutMethod: (in category 'fileIn/Out') -----
  fileOutMethod: selector
  	"Write source code of a single method on a file.  Make up a name for the file."
  	self fileOutMethod: selector asHtml: false!

Item was changed:
  ----- Method: ClassDescription>>fileOutMethod:asHtml: (in category 'fileIn/Out') -----
  fileOutMethod: selector asHtml: useHtml
  	"Write source code of a single method on a file in .st or .html format"
  
  	| internalStream |
  	(selector == #Comment) ifTrue: [^ self inform: 'Sorry, cannot file out class comment in isolation.'].
  	(self includesSelector: selector) ifFalse: [^ self error: 'Selector ', selector asString, ' not found'].
  	internalStream := WriteStream on: (String new: 1000).
  	internalStream header; timeStamp.
  	self printMethodChunk: selector withPreamble: true
  		on: internalStream moveSource: false toFile: 0.
  
  	FileStream writeSourceCodeFrom: internalStream baseName: (self name , '-' , (selector copyReplaceAll: ':' with: '')) isSt: true useHtml: useHtml.
  !

Item was changed:
  ----- Method: ClassDescription>>fileOutOn:moveSource:toFile: (in category 'fileIn/Out') -----
  fileOutOn: aFileStream moveSource: moveSource toFile: fileIndex
  	"File a description of the receiver on aFileStream. If the boolean 
  	argument, moveSource, is true, then set the trailing bytes to the position 
  	of aFileStream and to fileIndex in order to indicate where to find the 
  	source code."
  
  	aFileStream command: 'H3'.
  		aFileStream nextChunkPut: self definition.
  		aFileStream command: '/H3'.
  
  	self organization
  		putCommentOnFile: aFileStream
  		numbered: fileIndex
  		moveSource: moveSource
  		forClass: self.
  	self organization categories do: 
  		[:heading |
  		self fileOutCategory: heading
  			on: aFileStream
  			moveSource: moveSource
  			toFile: fileIndex]!

Item was changed:
  ----- Method: ClassDescription>>fileOutOrganizationOn: (in category 'fileIn/Out') -----
  fileOutOrganizationOn: aFileStream
  	"File a description of the receiver's organization on aFileStream."
  
  	aFileStream cr; nextPut: $!!.
  	aFileStream nextChunkPut: self name, ' reorganize'; cr.
  	aFileStream nextChunkPut: self organization printString; cr!

Item was changed:
  ----- Method: ClassDescription>>forgetDoIts (in category 'initialize-release') -----
  forgetDoIts
  	"get rid of old DoIt methods and bogus entries in the ClassOrganizer."
  	SystemChangeNotifier uniqueInstance doSilently: [
  		self organization
  			removeElement: #DoIt;
  			removeElement: #DoItIn:.
  	].
  	super forgetDoIts.!

Item was changed:
  ----- Method: ClassDescription>>instanceVariablesString (in category 'printing') -----
  instanceVariablesString
  	"Answer a string of my instance variable names separated by spaces."
  
  	^String streamContents: [ :stream |
  		self instVarNames 
  			do: [ :each | stream nextPutAll: each ]
  			separatedBy: [ stream space ] ]!

Item was changed:
  ----- Method: ClassDescription>>methods (in category 'fileIn/Out') -----
  methods
  	"Answer a ClassCategoryReader for compiling messages that are not classified, as in fileouts made with Smalltalk/V"
  
  	^ ClassCategoryReader new setClass: self category: ClassOrganizer default!

Item was changed:
  ----- Method: ClassDescription>>methodsFor: (in category 'fileIn/Out') -----
  methodsFor: categoryName 
  	"Answer a ClassCategoryReader for compiling the messages in the category, categoryName, of the receiver."
  
  	^ ClassCategoryReader new setClass: self category: categoryName asSymbol
  
  	"(False methodsFor: 'logical operations') inspect"!

Item was changed:
  ----- Method: ClassDescription>>methodsFor:stamp: (in category 'fileIn/Out') -----
  methodsFor: categoryName stamp: changeStamp 
  	^ self methodsFor: categoryName stamp: (Utilities fixStamp: changeStamp) prior: 0!

Item was changed:
  ----- Method: ClassDescription>>methodsFor:stamp:prior: (in category 'fileIn/Out') -----
  methodsFor: categoryName stamp: changeStamp prior: indexAndOffset
  	"Prior source link ignored when filing in."
  	^ ClassCategoryReader new setClass: self
  				category: categoryName asSymbol
  				changeStamp: changeStamp
  
  "Most importantly, return the new ClassCategoryReader, so a fileIn will let it seize control.  So method will be placed in the proper category.  See the transfer of control where ReadWriteStream fileIn calls scanFrom:"!

Item was changed:
  ----- Method: ClassDescription>>moveInstVarNamed:to:after: (in category 'compiling') -----
  moveInstVarNamed: instVarName to: anotherClass after: prevInstVarName
  	"Move the given instance variable to another class."
  	self == anotherClass ifFalse:[
  		self notify:'Warning:' asText allBold,' moving ', instVarName printString,' from ', self name,' to ', anotherClass name,' will not be recorded in the change set correctly.
  Proceed to do it anyways.'].
  	^(ClassBuilder new)
  		moveInstVarNamed: instVarName 
  		from: self 
  		to: anotherClass 
  		after: prevInstVarName!

Item was changed:
  ----- Method: ClassDescription>>noteCompilationOf:meta: (in category 'compiling') -----
  noteCompilationOf: aSelector meta: isMeta
  	"A hook allowing some classes to react to recompilation of certain selectors"!

Item was changed:
  ----- Method: ClassDescription>>organization: (in category 'organization') -----
  organization: aClassOrg
  	"Install an instance of ClassOrganizer that represents the organization of the messages of the receiver."
  
  	aClassOrg ifNotNil: [aClassOrg setSubject: self].
  	organization := aClassOrg!

Item was changed:
  ----- Method: ClassDescription>>printCategoryChunk:on: (in category 'fileIn/Out') -----
  printCategoryChunk: categoryName on: aFileStream
  	^ self printCategoryChunk: categoryName withStamp: '' on: aFileStream!

Item was changed:
  ----- Method: ClassDescription>>printCategoryChunk:on:priorMethod: (in category 'fileIn/Out') -----
  printCategoryChunk: category on: aFileStream priorMethod: priorMethod
  	^ self printCategoryChunk: category on: aFileStream
  		withStamp: Utilities changeStamp priorMethod: priorMethod!

Item was changed:
  ----- Method: ClassDescription>>printCategoryChunk:on:withStamp:priorMethod: (in category 'fileIn/Out') -----
  printCategoryChunk: category on: aFileStream withStamp: changeStamp priorMethod: priorMethod 
  	"Print a method category preamble.  This must have a category name.
  	It may have an author/date stamp, and it may have a prior source link.
  	If it has a prior source link, it MUST have a stamp, even if it is empty."
  
  "The current design is that changeStamps and prior source links are preserved in the changes file.  All fileOuts include changeStamps.  Condensing sources, however, eliminates all stamps (and links, natch)."
  
  	aFileStream cr; command: 'H3'; nextPut: $!!.
  	aFileStream nextChunkPut: (String streamContents:
  		[:strm |
  		strm nextPutAll: self name; nextPutAll: ' methodsFor: '; print: category asString.
  		(changeStamp ~~ nil and:
  			[changeStamp size > 0 or: [priorMethod ~~ nil]]) ifTrue:
  			[strm nextPutAll: ' stamp: '; print: changeStamp].
  		priorMethod ~~ nil ifTrue:
  			[strm nextPutAll: ' prior: '; print: priorMethod sourcePointer]]).
  	aFileStream command: '/H3'.!

Item was changed:
  ----- Method: ClassDescription>>printCategoryChunk:withStamp:on: (in category 'fileIn/Out') -----
  printCategoryChunk: categoryName withStamp: changeStamp on: aFileStream
  	^ self printCategoryChunk: categoryName on: aFileStream withStamp: changeStamp
  		priorMethod: nil!

Item was changed:
  ----- Method: ClassDescription>>printSubclassesOn:level: (in category 'accessing class hierarchy') -----
  printSubclassesOn: aStream level: level 
  	"As part of the algorithm for printing a description of the receiver, print the
  	subclass on the file stream, aStream, indenting level times."
  
  	| subclassNames |
  	aStream crtab: level.
  	aStream nextPutAll: self name.
  	aStream space; print: self instVarNames.
  	self == Class
  		ifTrue: 
  			[aStream crtab: level + 1; nextPutAll: '[ ... all the Metaclasses ... ]'.
  			^self].
  	subclassNames := self subclasses asSortedCollection:[:c1 :c2| c1 name <= c2 name].
  	"Print subclasses in alphabetical order"
  	subclassNames do:
  		[:subclass | subclass printSubclassesOn: aStream level: level + 1]!

Item was changed:
  ----- Method: ClassDescription>>renameInstVar:to: (in category 'instance variables') -----
  renameInstVar: oldName to: newName
  
  	(self confirm: 'WARNING: Renaming of instance variables
  is subject to substitution ambiguities.
  Do you still wish to attempt it?') ifFalse: [self halt].
  	"...In other words, this does a dumb text search-and-replace,
  	which might improperly alter, eg, a literal string.  As long as
  	the oldName is unique, everything should work jes' fine. - di"
  
  	^ self renameSilentlyInstVar: oldName to: newName!

Item was changed:
  ----- Method: ClassDescription>>reorganize (in category 'organization') -----
  reorganize
  	"During fileIn, !!Rectangle reorganize!! allows Rectangle to seize control and treat the next chunk as its organization.  See the transfer of control where ReadWriteStream fileIn calls scanFrom:"
  
  	^self organization!

Item was changed:
  ----- Method: ClassDescription>>sharedPoolsString (in category 'printing') -----
  sharedPoolsString
  	"Answer a string of my shared pool names separated by spaces."
  
  	^String streamContents: [ :stream |
  		self sharedPools 
  			do: [ :each |
  				stream nextPutAll: (self environment 
  					keyAtIdentityValue: each 
  					ifAbsent: [ 'private' ]) ]
  			separatedBy: [ stream space ] ]!

Item was changed:
  ----- Method: ClassDescription>>subclasses (in category 'accessing class hierarchy') -----
  subclasses
  	^ Array new!

Item was changed:
  ----- Method: ClassDescription>>subclassesDo: (in category 'accessing class hierarchy') -----
  subclassesDo: aBlock
  	"Evaluate the argument, aBlock, for each of the receiver's immediate subclasses."
  	^self subclasses do: aBlock!

Item was changed:
  ----- Method: ClassDescription>>superclass:methodDictionary:format: (in category 'initialize-release') -----
  superclass: aClass methodDictionary: mDict format: fmt
  	"Basic initialization of the receiver"
  	super superclass: aClass methodDictionary: mDict format: fmt.
  	instanceVariables := nil.
  	self organization: nil.!

Item was changed:
  ----- Method: ClassDescription>>wantsChangeSetLogging (in category 'compiling') -----
  wantsChangeSetLogging
  	"Answer whether code submitted for the receiver should be remembered by the changeSet mechanism.  7/12/96 sw"
  
  	^ true!

Item was changed:
  ----- Method: ClassDescription>>wantsRecompilationProgressReported (in category 'compiling') -----
  wantsRecompilationProgressReported
  	"Answer whether the receiver would like progress of its recompilation reported interactively to the user."
  
  	^ true!

Item was changed:
  ----- Method: ClassDescription>>whichCategoryIncludesSelector: (in category 'organization') -----
  whichCategoryIncludesSelector: aSelector 
  	"Answer the category of the argument, aSelector, in the organization of 
  	the receiver, or answer nil if the receiver does not inlcude this selector."
  
  	(self includesSelector: aSelector)
  		ifTrue: [^ self organization categoryOfElement: aSelector]
  		ifFalse: [^nil]!

Item was changed:
  ----- Method: CompiledMethod class>>primitive:numArgs:numTemps:stackSize:literals:bytecodes:trailer: (in category 'instance creation') -----
  primitive: primNum numArgs: numArgs numTemps: numTemps stackSize: stackSize literals: literals bytecodes: bytecodes trailer: trailerBytes
  	"Create method with given attributes.  numTemps includes numArgs.  stackSize does not include numTemps."
  
  	| compiledMethod |
  	compiledMethod := self
  		newBytes: bytecodes size
  		trailerBytes: trailerBytes 
  		nArgs: numArgs
  		nTemps: numTemps
  		nStack: stackSize
  		nLits: literals size
  		primitive: primNum.
  	(WriteStream with: compiledMethod)
  		position: compiledMethod initialPC - 1;
  		nextPutAll: bytecodes.
  	literals withIndexDo: [:obj :i | compiledMethod literalAt: i put: obj].
  	^ compiledMethod!

Item was changed:
  ----- Method: Date>>printOn: (in category 'printing') -----
  printOn: aStream
  
  	self printOn: aStream format: #(1 2 3 $  3 1 )
  !

Item was changed:
  ----- Method: Date>>storeOn: (in category 'printing') -----
  storeOn: aStream
  
  	aStream print: self printString; nextPutAll: ' asDate'
  !

Item was changed:
  ----- Method: EventSensor>>peekButtons (in category 'accessing') -----
  peekButtons
  	self fetchMoreEvents.
  	^mouseButtons!

Item was changed:
  ----- Method: EventSensor>>peekPosition (in category 'accessing') -----
  peekPosition
  	self fetchMoreEvents.
  	^mousePosition!

Item was changed:
  ----- Method: EventSensor>>primKbdNext (in category 'private') -----
  primKbdNext
  	"Allows for use of old Sensor protocol to get at the keyboard,
  	as when running kbdTest or the InterpreterSimulator in Morphic"
  	| evtBuf |
  	self fetchMoreEvents.
  	keyboardBuffer isEmpty ifFalse:[^ keyboardBuffer next].
  	eventQueue ifNotNil:
  		[evtBuf := eventQueue nextOrNilSuchThat: [:buf | self isKbdEvent: buf].
  		self flushNonKbdEvents].
  	^ evtBuf ifNotNil: [evtBuf at: 3]
  !

Item was changed:
  ----- Method: EventSensor>>primKbdPeek (in category 'private') -----
  primKbdPeek
  	"Allows for use of old Sensor protocol to get at the keyboard,
  	as when running kbdTest or the InterpreterSimulator in Morphic"
  	| char |
  	self fetchMoreEvents.
  	keyboardBuffer isEmpty ifFalse: [^ keyboardBuffer peek].
  	char := nil.
  	eventQueue ifNotNil:
  		[eventQueue nextOrNilSuchThat:  "NOTE: must not return out of this block, so loop to end"
  			[:buf | (self isKbdEvent: buf) ifTrue: [char ifNil: [char := buf at: 3]].
  			false  "NOTE: block value must be false so Queue won't advance"]].
  	^ char!

Item was changed:
  ----- Method: EventSensor>>primMouseButtons (in category 'private') -----
  primMouseButtons
  	self fetchMoreEvents.
  	self flushNonKbdEvents.
  	^ mouseButtons!

Item was changed:
  ----- Method: EventSensor>>primMousePt (in category 'private') -----
  primMousePt
  	self fetchMoreEvents.
  	self flushNonKbdEvents.
  	^ mousePosition!

Item was changed:
  ----- Method: Metaclass>>fileOutOn:moveSource:toFile:initializing: (in category 'fileIn/Out') -----
  fileOutOn: aFileStream moveSource: moveSource toFile: fileIndex initializing: aBool
  	super fileOutOn: aFileStream
  		moveSource: moveSource
  		toFile: fileIndex.
  	(aBool and:[moveSource not and: [self methodDict includesKey: #initialize]]) ifTrue: 
  		[aFileStream cr.
  		aFileStream cr.
  		aFileStream nextChunkPut: thisClass name , ' initialize'.
  		aFileStream cr]!

Item was changed:
  ----- Method: Object>>addModelYellowButtonMenuItemsTo:forMorph:hand: (in category 'graph model') -----
  addModelYellowButtonMenuItemsTo: aCustomMenu forMorph: aMorph hand: aHandMorph 
  	"The receiver serves as the model for aMorph; a menu is being constructed for the morph, and here the receiver is able to add its own items"
  	Preferences cmdGesturesEnabled ifTrue: [ "build mode"
  		aCustomMenu add: 'inspect model' translated target: self action: #inspect.
  	].
  
  	^aCustomMenu
  !

Item was changed:
  ----- Method: Object>>halt (in category 'error handling') -----
  halt
  	"This is the typical message to use for inserting breakpoints during 
  	debugging. It behaves like halt:, but does not call on halt: in order to 
  	avoid putting this message on the stack. Halt is especially useful when 
  	the breakpoint message is an arbitrary one."
  
  	Halt signal!

Item was changed:
  ----- Method: Time class>>dateAndTimeFromSeconds: (in category 'smalltalk-80') -----
  dateAndTimeFromSeconds: secondCount
  
  	^ Array
  		with: (Date fromSeconds: secondCount)
  		with: (Time fromSeconds: secondCount \\ 86400)!

Item was changed:
  ----- Method: Time class>>millisecondsSince: (in category 'squeak protocol') -----
  millisecondsSince: lastTime
  	"Answer the elapsed time since last recorded in milliseconds.
  	Compensate for rollover."
  
  	^self milliseconds: self millisecondClockValue since: lastTime
  !

Item was changed:
  ----- Method: Time>>hhmm24 (in category 'printing') -----
  hhmm24
  	"Return a string of the form 1123 (for 11:23 am), 2154 (for 9:54 pm), of exactly 4 digits"
  
  	^(String streamContents: 
  		[ :aStream | self print24: true showSeconds: false on: aStream ])
  			copyWithout: $:
  !

Item was changed:
  ----- Method: Time>>print24 (in category 'printing') -----
  print24
  	"Return as 8-digit string 'hh:mm:ss', with leading zeros if needed"
  
  	^String streamContents:
  		[ :aStream | self print24: true on: aStream ]
  !

Item was changed:
  ----- Method: Time>>print24:on: (in category 'printing') -----
  print24: hr24 on: aStream 
  	"Format is 'hh:mm:ss' or 'h:mm:ss am' "
  
  	self print24: hr24 showSeconds: true on: aStream!

Item was changed:
  ----- Method: Time>>printMinutes (in category 'printing') -----
  printMinutes
  	"Return as string 'hh:mm pm'  "
  
  	^String streamContents:
  		[ :aStream | self print24: false showSeconds: false on: aStream ]!

Item was changed:
  ----- Method: Time>>storeOn: (in category 'printing') -----
  storeOn: aStream
  
  	aStream print: self printString; nextPutAll: ' asTime'
  !



More information about the Packages mailing list