Anonymous avatar Anonymous committed 01d1faf

#374: Update to SmalltalkLexer by Nils Winter.

Comments (0)

Files changed (3)

pygments/lexers/other.py

     """
     For `Smalltalk <http://www.smalltalk.org/>`_ syntax.
     Contributed by Stefan Matthias Aust.
+    Rewritten by Nils Winter.
 
     *New in Pygments 0.10.*
     """
 
     tokens = {
         'root' : [
+            (r'(<)(\w+:)(.*?)(>)', bygroups(Text, Keyword, Text, Text)),
+            include('squeak fileout'),
+            include('whitespaces'),
+            include('method definition'),
+            (r'(\|)([\w\s]*)(\|)', bygroups(Operator, Name.Variable, Operator)),
+            include('objects'),
+            (r'\^|\:=|\_', Operator),
+            # temporaries
+            (r'[\]({}.;!]', Text),
+            
+        ],
+        'method definition' : [
+            # Not perfect can't allow whitespaces at the beginning and the
+            # without breaking everything
+            (r'([a-zA-Z]+\w*:)(\s*)(\w+)', bygroups(Name.Function, Text, Name.Variable)),
+            (r'^(\b[a-zA-Z]+\w*\b)(\s*)$', bygroups(Name.Function, Text)),
+            (r'^([-+*/\\~<>=|&!?,@%]+)(\s*)(\w+)(\s*)$', bygroups(Name.Function, Text, Name.Variable, Text)),
+        ],
+        'blockvariables' : [
+            include('whitespaces'),
+            (r'(:)(\s*)([A-Za-z\w]+)', bygroups(Operator, Text, Name.Variable)),
+            (r'\|', Operator, '#pop'),
+            (r'', Text, '#pop'), # else pop
+        ],
+        'literals' : [
+            (r'\'[^\']*\'', String, 'afterobject'),
+            (r'\$.', String.Char, 'afterobject'),
+            (r'#\(', String.Symbol, 'parenth'),
+            (r'\)', Text, 'afterobject'),
+            (r'(\d+r)?-?\d+(\.\d+)?(e-?\d+)?', Number, 'afterobject'),
+        ],
+        '_parenth_helper' : [
+            include('whitespaces'),
+            (r'[-+*/\\~<>=|&#!?,@%\w+:]+', String.Symbol),
+            # literals
+            (r'\'[^\']*\'', String),
+            (r'\$.', String.Char),
+            (r'(\d+r)?-?\d+(\.\d+)?(e-?\d+)?', Number),
+            (r'#*\(', String.Symbol, 'inner_parenth'),
+        ],
+        'parenth' : [
+            # This state is a bit tricky since 
+            # we can't just pop this state
+            (r'\)', String.Symbol, ('root','afterobject')),
+            include('_parenth_helper'),
+        ],
+        'inner_parenth': [
+            (r'\)', String.Symbol, '#pop'),
+            include('_parenth_helper'),
+        ],
+        'whitespaces' : [
+            # skip whitespace and comments
+            (r'\s+', Text),
+            (r'"[^"]*"', Comment),
+        ],
+        'objects' : [
+            (r'\[', Text, 'blockvariables'),
+            (r'\]', Text, 'afterobject'),
+            (r'\b(self|super|true|false|nil|thisContext)\b', Name.Builtin.Pseudo, 'afterobject'),
+            (r'\b[A-Z]\w*(?!:)\b', Name.Class, 'afterobject'),
+            (r'\b[a-z]\w*(?!:)\b', Name.Variable, 'afterobject'),
+            (r'#("[^"]*"|[-+*/\\~<>=|&!?,@%]+|[\w:]+)', String.Symbol, 'afterobject'),
+            include('literals'),
+        ],
+        'afterobject' : [
+            (r'! !$', Keyword , '#pop'), # squeak chunk delimeter
+            include('whitespaces'),
+            (r'\b(ifTrue:|ifFalse:|whileTrue:|whileFalse:|timesRepeat:)', Name.Builtin, '#pop'),
+            (r'\b(new\b(?!:))', Name.Builtin),
+            (r'\:=|\_', Operator, '#pop'),
+            (r'\b[a-zA-Z]+\w*:', Name.Function, '#pop'),
+            (r'\b[a-zA-Z]+\w*', Name.Function),
+            (r'\w+:?|[-+*/\\~<>=|&!?,@%]+', Name.Function, '#pop'),
+            (r'\.', Punctuation, '#pop'),
+            (r';', Punctuation),
+            (r'[\])}]', Text),
+            (r'[\[({]', Text, '#pop'),
+        ],
+        'squeak fileout' : [
             # Squeak fileout format (optional)
             (r'^"[^"]*"!', Keyword),
             (r"^'[^']*'!", Keyword),
                 bygroups(Name.Class, Keyword, String, Keyword)),
             (r'(!\n)(\].*)(! !)$', bygroups(Keyword, Text, Keyword)),
             (r'! !$', Keyword),
-            # skip whitespace and comments
-            (r'\s+', Text),
-            (r'"[^"]*"', Comment),
-            # method patterns
-            (r'^(\w+)(\s*:\s*)(\w+\s*)', bygroups(Name.Function, Punctuation,
-                                                  Name.Variable), 'pattern'),
-            (r'^([-+*/\\~<>=|&!?,@%]+\s*)(\w+)', bygroups(Name.Function, Name.Variable)),
-            (r'^(\w+)', Name.Function),
-            # literals
-            (r'\'[^\']*\'', String),
-            (r'\$.', String.Char),
-            (r'#\(', String.Symbol, 'parenth'),
-            (r'(\d+r)?-?\d+(\.\d+)?(e-?\d+)?', Number),
-            (r'#("[^"]*"|[-+*/\\~<>=|&!?,@%]+|[\w:]+)', String.Symbol),
-            # blocks variables
-            (r'(\[\s*)((?::\w+\s*)+)(\|)', bygroups(Text, Name.Variable, Text)),
-            # temporaries
-            (r'(\|)([\w\s]*)(\|)', bygroups(Operator, Name.Variable, Operator)),
-            # names
-            (r'\b(ifTrue:|ifFalse:|whileTrue:|whileFalse:|timesRepeat:)', Name.Builtin),
-            (r'\b(self|super)\b', Name.Builtin.Pseudo),
-            (r'\b[A-Z]\w*:', Name),
-            (r'\b[A-Z]\w*\b', Name), #Name.Class),
-            (r'\w+:?|[-+*/\\~<>=|&!?,@%]+', Name), #Name.Function),
-            # syntax
-            (r'\^|:=', Operator),
-            (r'[\[\](){}.;]', Text),
-        ],
-        'parenth' : [
-            (r'\)', String.Symbol, '#pop'),
-            include('root'),
-        ],
-        'pattern' : [
-            (r'(\w+)(\s*:\s*)(\w+\s*)', bygroups(Name.Function, Punctuation,
-                                                 Name.Variable)),
-            (r'', Text, '#pop'),
         ],
     }
 
-
 class TcshLexer(RegexLexer):
     """
     Lexer for tcsh scripts.

tests/examplefiles/Object.st

+!ProtoObject subclass: #Object
+	instanceVariableNames: ''
+	classVariableNames: 'DependentsFields'
+	poolDictionaries: ''
+	category: 'Kernel-Objects'!
+
+!Object methodsFor: '*39Deprecated' stamp: 'gk 2/24/2004 08:49'!
+beep
+	"Deprecated."
+	
+	self deprecated: 'Use Beeper class>>beep instead.'.
+	Beeper beep! !
+
+!Object methodsFor: '*39Deprecated' stamp: 'gk 2/24/2004 08:50'!
+beepPrimitive
+	"Deprecated. Beep in the absence of sound support."
+	
+	self deprecated: 'Use Beeper class>>beep or Beeper class>>beepPrimitive instead.'.
+	Beeper beepPrimitive! !
+
+!Object methodsFor: '*39Deprecated' stamp: 'md 12/12/2003 17:02'!
+beep: soundName
+	"Make the given sound, unless the making of sound is disabled in Preferences."
+
+	self deprecated: 'Use SampledSound>>playSoundNamed: instead.'.
+	Preferences soundsEnabled
+		ifTrue: [self playSoundNamed: soundName]
+! !
+
+!Object methodsFor: '*39Deprecated' stamp: 'sd 11/19/2004 16:57'!
+contentsGetz: x
+	self deprecated: 'there is no method named contents in object and in addition only one sender in a method not called'. 
+	self contents: x! !
+
+!Object methodsFor: '*39Deprecated' stamp: 'sd 11/13/2003 21:10'!
+deprecatedExplanation: aString
+     "This method is OBSOLETE.  Use #deprecated: instead."
+	self deprecated: 'Use Object>>deprecated: instead of deprecatedExplanation:.'.
+
+	Preferences showDeprecationWarnings ifTrue:
+		[Deprecation signal: ('{1} has been deprecated. {2}' translated format: {thisContext sender printString. aString})]! !
+
+!Object methodsFor: '*39Deprecated' stamp: 'sd 11/13/2003 21:11'!
+deprecated: aBlock explanation: aString 
+	 "This method is OBSOLETE.  Use #deprecated:block: instead."
+	self deprecated: 'Use Object>>deprecated:block: instead of deprecated:explanation:.'.
+
+	Preferences showDeprecationWarnings ifTrue:
+		[Deprecation
+			signal: ('{1} has been deprecated. {2}' translated format: {thisContext sender printString. aString})].
+	^ aBlock value.
+! !
+
+!Object methodsFor: '*39Deprecated' stamp: 'md 12/12/2003 16:25'!
+doIfNotNil: aBlock
+	self deprecated: 'use ifNotNilDo:'.
+	^ self ifNotNilDo: aBlock
+! !
+
+!Object methodsFor: '*39Deprecated' stamp: 'md 11/27/2004 12:20'!
+ifKindOf: aClass thenDo: aBlock
+	self deprecated: 'Deprecated. Just use #isKindOf:'.
+	^ (self isKindOf: aClass) ifTrue: [aBlock value: self]! !
+
+!Object methodsFor: '*39Deprecated' stamp: 'gk 2/23/2004 20:51'!
+playSoundNamed: soundName
+	"Deprecated.
+	Play the sound with the given name."
+
+	self deprecated: 'Use "SoundService default playSoundNamed: aName" instead.'.
+	SoundService default playSoundNamed: soundName! !
+
+
+!Object methodsFor: '*Aida' stamp: 'JM 4/22/2007 15:23'!
+aidaCanBeLocked
+	"can we get an exclusive lock on that object (not already locked)?"
+	^false! !
+
+!Object methodsFor: '*Aida' stamp: 'JM 4/22/2007 15:23'!
+aidaDontCache
+	"don't cache web content in a browser. Appropriate header is added to http response"
+	^false! !
+
+!Object methodsFor: '*Aida' stamp: 'JM 4/22/2007 15:24'!
+aidaIsLocked
+	"is object locked exclusively?"
+	^false! !
+
+!Object methodsFor: '*Aida' stamp: 'JM 4/22/2007 15:24'!
+aidaLock
+	"get an exclusive lock on that object. Until unlocked, noon else can get that lock. Return false if already locked, true if successfull"
+	^false! !
+
+!Object methodsFor: '*Aida' stamp: 'JM 4/22/2007 15:24'!
+aidaUnlock
+	"release an exclusive lock if any"
+	^true! !
+
+!Object methodsFor: '*Aida' stamp: 'JM 4/22/2007 15:24'!
+app
+	"fastest and most convinient way to find a web app for that object"
+	^self webAppFor: self firstSessionFromStack! !
+
+!Object methodsFor: '*Aida' stamp: 'JM 4/22/2007 15:25'!
+contentType
+
+	"Janko Mivsek, apr98"
+	"return 'text/html' as content type for web pages"
+
+	^'text/html'! !
+
+!Object methodsFor: '*Aida' stamp: 'JM 4/22/2007 15:25'!
+deepSearchOfClass: aClassName
+	"finf all objects of that class down in object hierarchy"
+	| objectDictionary class |
+	objectDictionary := IdentityDictionary new.
+	self deepCopyNotIn: objectDictionary.
+	class := aClassName asSymbol.
+	^objectDictionary keys select: [:each | each class name = class].! !
+
+!Object methodsFor: '*Aida' stamp: 'JM 4/22/2007 15:26'!
+deepSearchOfObsoleteClasses
+	"find all objects of obsolete classes down in object hierarchy"
+	| objectDictionary |
+	objectDictionary := IdentityDictionary new.
+	self deepCopyNotIn: objectDictionary.
+	^objectDictionary keys select: [:each | each class isObsolete].! !
+
+!Object methodsFor: '*Aida' stamp: 'JM 4/22/2007 15:26'!
+expiresTimestamp
+	"until when content of this object wont be changed"
+	"used in http response, override if you like to be included"
+	^self modifiedTimestamp  "to reload pages immediately"! !
+
+!Object methodsFor: '*Aida' stamp: 'JM 4/22/2007 15:26'!
+firstAppFromStack
+	"try to find a first sender up in calling stack, who is  WebApplication"
+	| context |
+	context := thisContext.
+	[context notNil] whileTrue: [
+		(context receiver isKindOf: WebApplication) ifTrue: [^context receiver].
+		context := context sender].
+	^self firstSessionFromStack lastApp! !
+
+!Object methodsFor: '*Aida' stamp: 'JM 4/25/2007 21:34'!
+firstSessionFromStack
+	"try to find a first sender up in calling stack, who is  AIDASite and get session if that call"
+	| context |
+	context := thisContext.
+	[context notNil] whileTrue: [
+		(context receiver isKindOf: AIDASite) ifTrue: 	[^(context at: 3) "always?"].
+		context := context sender].
+	^nil! !
+
+!Object methodsFor: '*Aida' stamp: 'mivsek 1/10/2008 18:14'!
+forLanguage: aLanguageCodeSymbol
+	"for multilingual support: returns an apropriate instance of itself for that language. 
+	Langage is defined by ISO 639 2-letter language code, see 
+	http://en.wikipedia.org/wiki/List_of_ISO_639-1_codes"
+	^false! !
+
+!Object methodsFor: '*Aida' stamp: 'mivsek 1/10/2008 18:14'!
+isMultilingual
+	"for multilingual support: override this if your domain object responds 
+	to #forLanguage: and returns an apropriate instance of itself for that language"
+	^false! !
+
+!Object methodsFor: '*Aida' stamp: 'JM 4/22/2007 15:27'!
+isVersionedObject
+	^false! !
+
+!Object methodsFor: '*Aida' stamp: 'JM 4/22/2007 15:27'!
+isWebApplication
+	^false! !
+
+!Object methodsFor: '*Aida' stamp: 'JM 4/22/2007 15:27'!
+isWebStyle
+	^false! !
+
+!Object methodsFor: '*Aida' stamp: 'JM 4/22/2007 15:27'!
+modifiedTimestamp
+	"when this object was last modified"
+	"used in http response, override if you like to be included"
+	^nil! !
+
+!Object methodsFor: '*Aida' stamp: 'JM 4/22/2007 15:28'!
+preferedUrl
+	"override with a suggestion for url of this method!! If not already used, 
+	it will be considered by URLResolver during automatic url generation"
+	^nil! !
+
+!Object methodsFor: '*Aida' stamp: 'JM 4/22/2007 15:28'!
+printWebAppNotFoundFor: aSession 
+	| page |
+	page := WebPage new.
+	page addText: 'Cannot find aWebApplication for object a', self class name.
+	^page! !
+
+!Object methodsFor: '*Aida' stamp: 'JM 4/22/2007 15:28'!
+printWebPageFor: aSession 
+	"find appropriate web application to represent self as web page"
+
+	| webApp |
+	webApp := self webAppFor: aSession.
+	^webApp notNil 
+		ifTrue: [webApp printWebPage]
+		ifFalse: [self printWebAppNotFoundFor: aSession]! !
+
+!Object methodsFor: '*Aida' stamp: 'JM 4/22/2007 15:29'!
+sendOver: aStream 
+	"from Wiki rendering"
+	self printOn: aStream! !
+
+!Object methodsFor: '*Aida' stamp: 'JM 4/22/2007 15:29'!
+webAppFor: aSession
+	| webApp |
+	aSession isNil ifTrue: [^nil].
+	webApp := aSession webAppFor: self.
+	webApp notNil ifTrue: [^webApp].
+	webApp := WebApplication newFor: self on: aSession.
+	webApp notNil ifTrue: [aSession addWebApp: webApp for: self].
+	^webApp! !
+
+
+!Object methodsFor: '*DynamicBindings' stamp: 'svp 3/6/2003 16:08'!
+binding
+	"Answer the DynamicBinding for the receiver (if any)"
+
+	^Bindings bindingFor: self ifNotBound: [nil]! !
+
+!Object methodsFor: '*DynamicBindings' stamp: 'svp 4/29/2003 00:35'!
+binding: anObject
+	"Set the dynamic binding for the receiver, if anObject is nil, then 
+	remove the receiver's dynamic binding (if any)"
+
+	^anObject 
+		ifNil: [self removeBinding]
+		ifNotNil: [Bindings bind: self to: anObject]! !
+
+!Object methodsFor: '*DynamicBindings' stamp: 'svp 3/6/2003 16:09'!
+hasBinding
+	"Answer whether or not the receiver has a dynamic binding"
+
+	^Bindings includesKey: self! !
+
+!Object methodsFor: '*DynamicBindings' stamp: 'svp 3/6/2003 16:09'!
+removeBinding
+	"Remove the dynamic binding associated with the receiver"
+
+	^Bindings removeKey: self ifAbsent: []! !
+
+
+!Object methodsFor: '*KomHttpServer' stamp: 'SVP 8/23/1999 19:17'!
+asHtmlDocumentForRequest: aNetworkRequest
+
+	self error: 
+		('The requested object (', 
+		self asString, 
+		'), could not be converted into HTML for your browser.')! !
+
+!Object methodsFor: '*KomHttpServer' stamp: 'SVP 8/23/1999 19:23'!
+asHttpResponseTo: anHttpRequest
+
+	^(self asHtmlDocumentForRequest: anHttpRequest) 
+		asHttpResponseTo: anHttpRequest
+! !
+
+!Object methodsFor: '*KomHttpServer' stamp: 'svp 5/16/2003 12:47'!
+isComancheModule
+
+	^false! !
+
+!Object methodsFor: '*KomHttpServer' stamp: 'SVP 8/17/1999 17:51'!
+mimeType
+
+	^MIMEDocument defaultContentType! !
+
+
+!Object methodsFor: '*Morphic-NewCurve-testing''' stamp: 'wiz 12/31/2005 21:31'!
+isNonZero
+"Overriden in Number. This returns the backstop answer for non-numbers"
+^false.! !
+
+
+!Object methodsFor: '*Pinesoft-EventEnhancements' stamp: 'gvc 10/25/2006 18:18'!
+when: anEventSelector
+send: aMessageSelector
+to: anObject
+exclusive: aValueHolder
+ 
+	self
+		when: anEventSelector
+		evaluate: ((ExclusiveWeakMessageSend
+					receiver: anObject
+					selector: aMessageSelector)
+						basicExecuting: aValueHolder)! !
+
+!Object methodsFor: '*Pinesoft-EventEnhancements' stamp: 'gvc 10/25/2006 18:17'!
+when: anEventSelector
+send: aMessageSelector
+to: anObject
+with: anArg
+exclusive: aValueHolder
+ 
+    self
+        when: anEventSelector
+        evaluate: ((ExclusiveWeakMessageSend
+ 		receiver: anObject
+		selector: aMessageSelector
+		arguments: (Array with: anArg))
+			basicExecuting: aValueHolder)! !
+
+!Object methodsFor: '*Pinesoft-EventEnhancements' stamp: 'gvc 10/25/2006 18:17'!
+when: anEventSelector
+send: aMessageSelector
+to: anObject
+withArguments: anArgArray
+exclusive: aValueHolder
+ 
+    self
+        when: anEventSelector
+        evaluate: ((ExclusiveWeakMessageSend
+		receiver: anObject
+		selector: aMessageSelector
+		arguments: anArgArray)
+			basicExecuting: aValueHolder)! !
+
+!Object methodsFor: '*Pinesoft-EventEnhancements' stamp: 'gvc 10/24/2006 11:50'!
+when: anEventSelector
+sendOnce: aMessageSelector
+to: anObject
+ 
+    self
+        when: anEventSelector
+        evaluate: (NonReentrantWeakMessageSend
+            receiver: anObject
+            selector: aMessageSelector)! !
+
+!Object methodsFor: '*Pinesoft-EventEnhancements' stamp: 'gvc 10/24/2006 11:49'!
+when: anEventSelector
+sendOnce: aMessageSelector
+to: anObject
+with: anArg
+ 
+    self
+        when: anEventSelector
+        evaluate: (NonReentrantWeakMessageSend
+            receiver: anObject
+            selector: aMessageSelector
+		arguments: (Array with: anArg))! !
+
+!Object methodsFor: '*Pinesoft-EventEnhancements' stamp: 'gvc 10/24/2006 11:49'!
+when: anEventSelector
+sendOnce: aMessageSelector
+to: anObject
+withArguments: anArgArray
+ 
+    self
+        when: anEventSelector
+        evaluate: (NonReentrantWeakMessageSend
+            receiver: anObject
+            selector: aMessageSelector
+		arguments: anArgArray)! !
+
+
+!Object methodsFor: '*Pinesoft-Widgets' stamp: 'gvc 1/10/2007 11:41'!
+okToClose
+	"Sent to models when a window closing.
+	Allows this check to be independent of okToChange."
+	
+	^true! !
+
+!Object methodsFor: '*Pinesoft-Widgets' stamp: 'gvc 4/17/2007 17:41'!
+taskbarIcon
+	"Answer the icon for the receiver in a task bar
+	or nil for the default."
+
+	^self class taskbarIcon! !
+
+
+!Object methodsFor: '*Pinesoft-Widgets-override' stamp: 'gvc 9/4/2007 12:32'!
+windowActiveOnFirstClick
+	"Return true if my window should be active on first click."
+
+	^true! !
+
+
+!Object methodsFor: '*SeasideAdaptersCompatibility' stamp: 'pmm 11/25/2007 14:17'!
+toString
+	^self! !
+
+
+!Object methodsFor: '*Tools-Explorer' stamp: 'stephaneducasse 9/17/2005 21:52'!
+exploreAndYourself
+	"i.e. explore; yourself. Thisway i can peek w/o typing all the parentheses"
+	self explore. 
+     ^self! !
+
+!Object methodsFor: '*Tools-Explorer' stamp: 'stephaneducasse 9/17/2005 21:48'!
+exploreWithLabel: label
+
+	^ ObjectExplorer new openExplorerFor: self withLabel:
+label! !
+
+
+!Object methodsFor: '*kernel-extensions-flagging' stamp: 'mtf 1/26/2008 23:34'!
+deprecated
+	"Warn that the sending method has been deprecated."
+
+	Preferences showDeprecationWarnings ifTrue:
+		[Deprecation signal: thisContext sender printString, ' has been deprecated.']! !
+
+
+!Object methodsFor: '*kernel-extensions-flexibility' stamp: 'kph 1/27/2008 19:21'!
+askFor: selector 
+
+    "returns true or false"
+	
+	^ (self askFor: selector ifAbsent: nil) == true! !
+
+!Object methodsFor: '*kernel-extensions-flexibility' stamp: 'kph 10/17/2007 14:01'!
+askFor: selector ifAbsent: aBlock
+
+   "enables a default value to be specified in order to be tolerant of potentially missing methods
+	
+	e.g.
+	(myPoint askFor: #originOffset) ifAbsent: [ 0@0 ].
+	"
+
+	^ (self class canUnderstand: selector) ifFalse: [ aBlock value ] ifTrue: [self perform: selector]! !
+
+
+!Object methodsFor: '*kernel-extensions-logging' stamp: 'mtf 1/26/2008 23:52'!
+log
+	"This method provides the univeral entry point fo all logging mechanisms"
+	
+	"Options:
+	1. Null for null logging
+	2. A LogRouter instance wih a FrameworkAdaptor.
+	3. CurrentLog a process local variable supplying a LogRouter"
+	
+	^ (Smalltalk at: #CurrentLog ifAbsent: [ Null default ]) value
+		sender: thisContext sender; beginEntry; yourself! !
+
+
+!Object methodsFor: '*magritte-model-accessing' stamp: 'lr 3/9/2006 11:31'!
+description
+	"Return the description of the reciever. Subclasses might override this message to return instance-based descriptions."
+
+	^ self class description! !
+
+!Object methodsFor: '*magritte-model-accessing' stamp: 'lr 3/9/2006 11:31'!
+mementoClass
+	"Return a class to be used to remember or cache the receiver, namely a memento object."
+
+	^ MACheckedMemento! !
+
+
+!Object methodsFor: '*magritte-model-model' stamp: 'lr 3/9/2006 11:31'!
+readUsing: aDescription
+	"Dispatch the read-access to the receiver using the accessor of aDescription."
+
+	^ aDescription accessor read: self! !
+
+!Object methodsFor: '*magritte-model-model' stamp: 'lr 3/9/2006 11:31'!
+write: anObject using: aDescription
+	"Dispatch the write-access to the receiver of anObject using the accessor of aDescription."
+
+	aDescription accessor write: anObject to: self! !
+
+
+!Object methodsFor: '*magritte-model-testing' stamp: 'lr 3/9/2006 11:31'!
+isDescription
+	^ false! !
+
+
+!Object methodsFor: '*magritte-morph-converting' stamp: 'lr 3/9/2006 11:33'!
+asMorph
+	^ self description asMorphOn: self! !
+
+
+!Object methodsFor: '*magritte-seaside-converting' stamp: 'lr 3/9/2006 11:33'!
+asComponent
+	^ self description asComponentOn: self! !
+
+
+!Object methodsFor: '*monticello' stamp: 'dvf 8/10/2004 23:25'!
+isConflict
+	^false! !
+
+
+!Object methodsFor: '*null' stamp: 'kph 9/6/2007 23:31'!
+ifNull: aBlock
+
+	^ self! !
+
+!Object methodsFor: '*null' stamp: 'kph 9/6/2007 23:33'!
+isNull
+
+	^ false! !
+
+!Object methodsFor: '*null' stamp: 'kph 4/12/2007 08:27'!
+orNull
+
+	^ self! !
+
+
+!Object methodsFor: '*ob-tools-inspector' stamp: 'lr 6/5/2008 11:07'!
+basicInspectorNodes
+	<inspector: #'1' priority: 600>
+	
+	| nodes |
+	nodes := OrderedCollection new: self class instSize + self basicSize + 5.
+	nodes add: self selfInspectorNode.
+	self class allInstVarNames withIndexDo: [ :name :index |
+		nodes add: (OTNamedVariableNode on: self index: index name: name) ].
+	1 to: self basicSize do: [ :index |
+		nodes add: (OTIndexedVariableNode on: self index: index) ].
+	^ nodes! !
+
+!Object methodsFor: '*ob-tools-inspector' stamp: 'lr 6/5/2008 11:07'!
+protocolInspectorNodes
+	<inspector: #'#' priority: 800>
+
+	^ self class allSelectors asArray sort
+		collect: [ :each | OTProtocolInspectorNode on: self selector: each ]! !
+
+!Object methodsFor: '*ob-tools-inspector' stamp: 'lr 6/5/2008 09:58'!
+selfInspectorNode
+	^ OTDerivedInspectorNode on: self label: 'self' block: [ :obj | obj ]! !
+
+
+!Object methodsFor: '*omnibrowser-converting' stamp: 'cwp 4/17/2006 12:16'!
+asAnnouncement
+	^ self! !
+
+
+!Object methodsFor: '*pier-model' stamp: 'lr 3/9/2006 11:29'!
+accept: aVisitor
+	self subclassResponsibility! !
+
+!Object methodsFor: '*pier-model' stamp: 'lr 3/9/2006 11:29'!
+acceptDecorated: aVisitor
+	self accept: aVisitor! !
+
+
+!Object methodsFor: '*rio-kernel' stamp: 'kph 3/8/2007 21:25'!
+isRio
+
+	^ false! !
+
+
+!Object methodsFor: '*scriptaculous' stamp: 'lr 1/4/2007 17:20'!
+asFunction
+	^ self asFunction: #()! !
+
+!Object methodsFor: '*scriptaculous' stamp: 'lr 1/4/2007 17:21'!
+asFunction: aCollection
+	^ SUFunction new add: self; arguments: aCollection! !
+
+!Object methodsFor: '*scriptaculous' stamp: 'lr 4/11/2006 19:49'!
+asJavascript
+	^ String streamContents: [ :stream | self javascriptOn: stream ]! !
+
+
+!Object methodsFor: '*scriptaculous-printing' stamp: 'lr 4/20/2006 21:10'!
+javascriptOn: aStream
+	self printOn: aStream! !
+
+
+!Object methodsFor: '*seaside2' stamp: 'lr 6/5/2007 21:35'!
+deprecatedApi
+	self deprecatedApi: thisContext sender displayString! !
+
+!Object methodsFor: '*seaside2' stamp: 'lr 6/5/2007 21:35'!
+deprecatedApi: aString
+	WADeprecatedApi raiseSignal: aString! !
+
+!Object methodsFor: '*seaside2' stamp: 'lr 5/9/2007 08:47'!
+inspectorFields
+	| members |
+	members := Array new writeStream.
+	self class allInstVarNames withIndexDo: [ :each :index |
+		members nextPut: each -> (self instVarAt: index) ].
+	self class isVariable ifTrue: [
+		1 to: self size do: [ :index |
+			members nextPut: index -> (self at: index) ] ].
+	^ members contents! !
+
+!Object methodsFor: '*seaside2' stamp: 'avi 3/14/2005 15:19'!
+labelForSelector: aSymbol
+	^ aSymbol asCapitalizedPhrase! !
+
+!Object methodsFor: '*seaside2' stamp: 'pmm 4/7/2007 17:14'!
+renderOn: aRenderer
+	"Override this method to customize how objects (not components) are rendered when passed as an argument to #render:. The default is the return value of #displayString.
+	Just remember that you can not use #callback:, #on:of:, or #call:"
+
+	aRenderer text: self! !
+
+!Object methodsFor: '*seaside2' stamp: 'lr 3/19/2007 23:13'!
+restoreFromSnapshot: anObject
+	self copyFrom: anObject! !
+
+!Object methodsFor: '*seaside2' stamp: 'avi 9/1/2004 21:20'!
+snapshotCopy
+	^ self shallowCopy! !
+
+!Object methodsFor: '*seaside2' stamp: 'lr 10/28/2007 14:42'!
+validationError: message
+	^WAValidationNotification raiseSignal: message! !
+
+
+!Object methodsFor: '*seaside2-encoding' stamp: 'lr 3/26/2007 20:16'!
+encodeOn: aDocument
+	aDocument print: self displayString! !
+
+
+!Object methodsFor: '*seaside2-squeak' stamp: 'pmm 5/22/2007 22:10'!
+beMutable
+	"for VW compatibility, a hack that allows to cache a value in a literal array"! !
+
+!Object methodsFor: '*seaside2-squeak' stamp: 'lr 7/12/2005 17:01'!
+displayString
+	^ self asString! !
+
+
+!Object methodsFor: '*services-base' stamp: 'rr 3/21/2006 11:54'!
+requestor
+	"returns the focused window's requestor"
+
+	"SystemWindow focusedWindow ifNotNilDo: [:w | ^ w requestor]."
+
+	"triggers an infinite loop"
+
+	^ Requestor default! !
+
+
+!Object methodsFor: '*system-support' stamp: 'dvf 8/23/2003 12:27'!
+systemNavigation
+
+	^ SystemNavigation default! !
+
+
+!Object methodsFor: '*tools-browser' stamp: 'mu 3/6/2004 15:13'!
+browse
+	self systemNavigation browseClass: self class! !
+
+!Object methodsFor: '*tools-browser' stamp: 'mu 3/11/2004 16:00'!
+browseHierarchy
+	self systemNavigation browseHierarchy: self class! !
+
+
+!Object methodsFor: '*universes' stamp: 'ls 11/26/2006 12:33'!
+isUPackage
+	^false! !
+
+!Object methodsFor: '*universes' stamp: 'ls 11/26/2006 12:33'!
+isUPackageCategory
+	^false! !
+
+
+!Object methodsFor: 'accessing' stamp: 'sw 4/30/1998 12:18'!
+addInstanceVarNamed: aName withValue: aValue
+	"Add an instance variable named aName and give it value aValue"
+	self class addInstVarName: aName asString.
+	self instVarAt: self class instSize put: aValue! !
+
+!Object methodsFor: 'accessing' stamp: 'yo 6/29/2004 11:39'!
+at: index 
+	"Primitive. Assumes receiver is indexable. Answer the value of an 
+	indexable element in the receiver. Fail if the argument index is not an 
+	Integer or is out of bounds. Essential. See Object documentation 
+	whatIsAPrimitive."
+
+	<primitive: 60>
+	index isInteger ifTrue:
+		[self class isVariable
+			ifTrue: [self errorSubscriptBounds: index]
+			ifFalse: [self errorNotIndexable]].
+	index isNumber
+		ifTrue: [^self at: index asInteger]
+		ifFalse: [self errorNonIntegerIndex]! !
+
+!Object methodsFor: 'accessing'!
+at: index modify: aBlock
+	"Replace the element of the collection with itself transformed by the block"
+	^ self at: index put: (aBlock value: (self at: index))! !
+
+!Object methodsFor: 'accessing' stamp: 'yo 6/29/2004 13:08'!
+at: index put: value 
+	"Primitive. Assumes receiver is indexable. Store the argument value in 
+	the indexable element of the receiver indicated by index. Fail if the 
+	index is not an Integer or is out of bounds. Or fail if the value is not of 
+	the right type for this kind of collection. Answer the value that was 
+	stored. Essential. See Object documentation whatIsAPrimitive."
+
+	<primitive: 61>
+	index isInteger ifTrue:
+		[self class isVariable
+			ifTrue: [(index >= 1 and: [index <= self size])
+					ifTrue: [self errorImproperStore]
+					ifFalse: [self errorSubscriptBounds: index]]
+			ifFalse: [self errorNotIndexable]].
+	index isNumber
+		ifTrue: [^self at: index asInteger put: value]
+		ifFalse: [self errorNonIntegerIndex]! !
+
+!Object methodsFor: 'accessing' stamp: 'yo 9/20/2004 10:22'!
+basicAddInstanceVarNamed: aName withValue: aValue
+	"Add an instance variable named aName and give it value aValue"
+	self class addInstVarName: aName asString.
+	self instVarAt: self class instSize put: aValue! !
+
+!Object methodsFor: 'accessing'!
+basicAt: index 
+	"Primitive. Assumes receiver is indexable. Answer the value of an 
+	indexable element in the receiver. Fail if the argument index is not an 
+	Integer or is out of bounds. Essential. Do not override in a subclass. See 
+	Object documentation whatIsAPrimitive."
+
+	<primitive: 60>
+	index isInteger ifTrue: [self errorSubscriptBounds: index].
+	index isNumber
+		ifTrue: [^self basicAt: index asInteger]
+		ifFalse: [self errorNonIntegerIndex]! !
+
+!Object methodsFor: 'accessing'!
+basicAt: index put: value 
+	"Primitive. Assumes receiver is indexable. Store the second argument 
+	value in the indexable element of the receiver indicated by index. Fail 
+	if the index is not an Integer or is out of bounds. Or fail if the value is 
+	not of the right type for this kind of collection. Answer the value that 
+	was stored. Essential. Do not override in a subclass. See Object 
+	documentation whatIsAPrimitive."
+
+	<primitive: 61>
+	index isInteger
+		ifTrue: [(index >= 1 and: [index <= self size])
+					ifTrue: [self errorImproperStore]
+					ifFalse: [self errorSubscriptBounds: index]].
+	index isNumber
+		ifTrue: [^self basicAt: index asInteger put: value]
+		ifFalse: [self errorNonIntegerIndex]! !
+
+!Object methodsFor: 'accessing'!
+basicSize
+	"Primitive. Answer the number of indexable variables in the receiver. 
+	This value is the same as the largest legal subscript. Essential. Do not 
+	override in any subclass. See Object documentation whatIsAPrimitive."
+
+	<primitive: 62>
+	"The number of indexable fields of fixed-length objects is 0"
+	^0	! !
+
+!Object methodsFor: 'accessing'!
+bindWithTemp: aBlock
+	^ aBlock value: self value: nil! !
+
+!Object methodsFor: 'accessing' stamp: 'md 10/7/2004 15:43'!
+ifNil: nilBlock ifNotNilDo: aBlock 
+	"Evaluate aBlock with the receiver as its argument."
+
+	^ aBlock value: self
+! !
+
+!Object methodsFor: 'accessing' stamp: 'di 11/8/2000 21:04'!
+ifNotNilDo: aBlock
+	"Evaluate the given block with the receiver as its argument."
+
+	^ aBlock value: self
+! !
+
+!Object methodsFor: 'accessing' stamp: 'md 10/7/2004 15:43'!
+ifNotNilDo: aBlock ifNil: nilBlock
+	"Evaluate aBlock with the receiver as its argument."
+
+	^ aBlock value: self
+! !
+
+!Object methodsFor: 'accessing' stamp: 'ajh 1/21/2003 12:59'!
+in: aBlock
+	"Evaluate the given block with the receiver as its argument."
+
+	^ aBlock value: self
+! !
+
+!Object methodsFor: 'accessing' stamp: 'sw 10/17/2000 11:15'!
+presenter
+	"Answer the presenter object associated with the receiver.  For morphs, there is in effect a clear containment hierarchy of presenters (accessed via their association with PasteUpMorphs); for arbitrary objects the hook is simply via the current world, at least at present."
+
+	^ self currentWorld presenter! !
+
+!Object methodsFor: 'accessing'!
+readFromString: aString
+	"Create an object based on the contents of aString."
+
+	^self readFrom: (ReadStream on: aString)! !
+
+!Object methodsFor: 'accessing' stamp: 'di 3/29/1999 13:10'!
+size
+	"Primitive. Answer the number of indexable variables in the receiver. 
+	This value is the same as the largest legal subscript. Essential. See Object 
+	documentation whatIsAPrimitive."
+
+	<primitive: 62>
+	self class isVariable ifFalse: [self errorNotIndexable].
+	^ 0! !
+
+!Object methodsFor: 'accessing' stamp: 'md 5/16/2006 12:34'!
+yourself
+	"Answer self."
+	^self! !
+
+
+!Object methodsFor: 'associating' stamp: 'md 7/22/2005 16:03'!
+-> anObject
+	"Answer an Association between self and anObject"
+
+	^Association basicNew key: self value: anObject! !
+
+
+!Object methodsFor: 'binding'!
+bindingOf: aString
+	^nil! !
+
+
+!Object methodsFor: 'breakpoint' stamp: 'bkv 7/1/2003 12:33'!
+break
+	"This is a simple message to use for inserting breakpoints during debugging.
+	The debugger is opened by sending a signal. This gives a chance to restore
+	invariants related to multiple processes."
+
+	BreakPoint signal.
+
+	"nil break."! !
+
+
+!Object methodsFor: 'casing'!
+caseOf: aBlockAssociationCollection
+	"The elements of aBlockAssociationCollection are associations between blocks.
+	 Answer the evaluated value of the first association in aBlockAssociationCollection
+	 whose evaluated key equals the receiver.  If no match is found, report an error."
+
+	^ self caseOf: aBlockAssociationCollection otherwise: [self caseError]
+
+"| z | z _ {[#a]->[1+1]. ['b' asSymbol]->[2+2]. [#c]->[3+3]}. #b caseOf: z"
+"| z | z _ {[#a]->[1+1]. ['d' asSymbol]->[2+2]. [#c]->[3+3]}. #b caseOf: z"
+"The following are compiled in-line:"
+"#b caseOf: {[#a]->[1+1]. ['b' asSymbol]->[2+2]. [#c]->[3+3]}"
+"#b caseOf: {[#a]->[1+1]. ['d' asSymbol]->[2+2]. [#c]->[3+3]}"! !
+
+!Object methodsFor: 'casing'!
+caseOf: aBlockAssociationCollection otherwise: aBlock
+	"The elements of aBlockAssociationCollection are associations between blocks.
+	 Answer the evaluated value of the first association in aBlockAssociationCollection
+	 whose evaluated key equals the receiver.  If no match is found, answer the result
+	 of evaluating aBlock."
+
+	aBlockAssociationCollection associationsDo:
+		[:assoc | (assoc key value = self) ifTrue: [^assoc value value]].
+	^ aBlock value
+
+"| z | z _ {[#a]->[1+1]. ['b' asSymbol]->[2+2]. [#c]->[3+3]}. #b caseOf: z otherwise: [0]"
+"| z | z _ {[#a]->[1+1]. ['d' asSymbol]->[2+2]. [#c]->[3+3]}. #b caseOf: z otherwise: [0]"
+"The following are compiled in-line:"
+"#b caseOf: {[#a]->[1+1]. ['b' asSymbol]->[2+2]. [#c]->[3+3]} otherwise: [0]"
+"#b caseOf: {[#a]->[1+1]. ['d' asSymbol]->[2+2]. [#c]->[3+3]} otherwise: [0]"! !
+
+
+!Object methodsFor: 'class membership'!
+class
+	"Primitive. Answer the object which is the receiver's class. Essential. See 
+	Object documentation whatIsAPrimitive."
+
+	<primitive: 111>
+	self primitiveFailed! !
+
+!Object methodsFor: 'class membership' stamp: 'sw 9/27/2001 15:51'!
+inheritsFromAnyIn: aList
+	"Answer whether the receiver inherits from any class represented by any element in the list.  The elements of the list can be classes, class name symbols, or strings representing possible class names.  This allows speculative membership tests to be made even when some of the classes may not be known to the current image, and even when their names are not interned symbols."
+
+	| aClass |
+	aList do:
+		[:elem | Symbol hasInterned: elem asString ifTrue: 
+			[:elemSymbol | (((aClass _ Smalltalk at: elemSymbol ifAbsent: [nil]) isKindOf: Class)
+						and: [self isKindOf: aClass])
+				ifTrue:
+					[^ true]]].
+	^ false
+
+
+"
+{3.  true. 'olive'} do:
+	[:token |
+		 {{#Number. #Boolean}. {Number.  Boolean }.  {'Number'. 'Boolean'}} do:
+			[:list |
+				Transcript cr; show: token asString, ' list element provided as a ', list first class name, ' - ', (token inheritsFromAnyIn: list) asString]]
+"! !
+
+!Object methodsFor: 'class membership'!
+isKindOf: aClass 
+	"Answer whether the class, aClass, is a superclass or class of the receiver."
+
+	self class == aClass
+		ifTrue: [^true]
+		ifFalse: [^self class inheritsFrom: aClass]! !
+
+!Object methodsFor: 'class membership' stamp: 'sw 2/16/98 02:08'!
+isKindOf: aClass orOf: anotherClass
+	"Answer whether either of the classes, aClass or anotherClass,, is a superclass or class of the receiver.  A convenience; could be somewhat optimized"
+	^ (self isKindOf: aClass) or: [self isKindOf: anotherClass]! !
+
+!Object methodsFor: 'class membership'!
+isMemberOf: aClass 
+	"Answer whether the receiver is an instance of the class, aClass."
+
+	^self class == aClass! !
+
+!Object methodsFor: 'class membership'!
+respondsTo: aSymbol 
+	"Answer whether the method dictionary of the receiver's class contains 
+	aSymbol as a message selector."
+
+	^self class canUnderstand: aSymbol! !
+
+!Object methodsFor: 'class membership' stamp: 'tk 10/21/1998 12:38'!
+xxxClass
+	"For subclasses of nil, such as ObjectOut"
+	^ self class! !
+
+
+!Object methodsFor: 'comparing' stamp: 'tk 4/16/1999 18:26'!
+closeTo: anObject
+	"Answer whether the receiver and the argument represent the same
+	object. If = is redefined in any subclass, consider also redefining the
+	message hash."
+
+	| ans |
+	[ans _ self = anObject] ifError: [:aString :aReceiver | ^ false].
+	^ ans! !
+
+!Object methodsFor: 'comparing'!
+hash
+	"Answer a SmallInteger whose value is related to the receiver's identity.
+	May be overridden, and should be overridden in any classes that define = "
+
+	^ self identityHash! !
+
+!Object methodsFor: 'comparing' stamp: 'pm 9/23/97 09:36'!
+hashMappedBy: map
+	"Answer what my hash would be if oops changed according to map."
+
+	^map newHashFor: self! !
+
+!Object methodsFor: 'comparing' stamp: 'di 9/27/97 20:23'!
+identityHashMappedBy: map
+	"Answer what my hash would be if oops changed according to map."
+
+	^map newHashFor: self! !
+
+!Object methodsFor: 'comparing' stamp: 'sw 8/20/1998 12:34'!
+identityHashPrintString
+	"'fred' identityHashPrintString"
+
+	^ '(', self identityHash printString, ')'! !
+
+!Object methodsFor: 'comparing' stamp: 'ajh 2/2/2002 15:02'!
+literalEqual: other
+
+	^ self class == other class and: [self = other]! !
+
+!Object methodsFor: 'comparing'!
+= anObject 
+	"Answer whether the receiver and the argument represent the same 
+	object. If = is redefined in any subclass, consider also redefining the 
+	message hash."
+
+	^self == anObject! !
+
+!Object methodsFor: 'comparing'!
+~= anObject 
+	"Answer whether the receiver and the argument do not represent the 
+	same object."
+
+	^self = anObject == false! !
+
+
+!Object methodsFor: 'converting' stamp: 'di 11/9/1998 12:15'!
+adaptToFloat: rcvr andSend: selector
+	"If no method has been provided for adapting an object to a Float,
+	then it may be adequate to simply adapt it to a number."
+	^ self adaptToNumber: rcvr andSend: selector! !
+
+!Object methodsFor: 'converting' stamp: 'di 11/9/1998 12:14'!
+adaptToFraction: rcvr andSend: selector
+	"If no method has been provided for adapting an object to a Fraction,
+	then it may be adequate to simply adapt it to a number."
+	^ self adaptToNumber: rcvr andSend: selector! !
+
+!Object methodsFor: 'converting' stamp: 'di 11/9/1998 12:15'!
+adaptToInteger: rcvr andSend: selector
+	"If no method has been provided for adapting an object to a Integer,
+	then it may be adequate to simply adapt it to a number."
+	^ self adaptToNumber: rcvr andSend: selector! !
+
+!Object methodsFor: 'converting' stamp: 'rw 4/27/2002 07:48'!
+asActionSequence
+
+	^WeakActionSequence with: self! !
+
+!Object methodsFor: 'converting' stamp: 'rw 7/20/2003 16:03'!
+asActionSequenceTrappingErrors
+
+	^WeakActionSequenceTrappingErrors with: self! !
+
+!Object methodsFor: 'converting' stamp: 'svp 5/16/2000 18:14'!
+asDraggableMorph
+	^(StringMorph contents: self printString)
+		color: Color white;
+		yourself! !
+
+!Object methodsFor: 'converting' stamp: 'sma 5/12/2000 17:39'!
+asOrderedCollection
+	"Answer an OrderedCollection with the receiver as its only element."
+
+	^ OrderedCollection with: self! !
+
+!Object methodsFor: 'converting'!
+asString
+	"Answer a string that represents the receiver."
+
+	^ self printString ! !
+
+!Object methodsFor: 'converting' stamp: 'ajh 3/11/2003 10:27'!
+asStringOrText
+	"Answer a string that represents the receiver."
+
+	^ self printString ! !
+
+!Object methodsFor: 'converting'!
+as: aSimilarClass
+	"Create an object of class aSimilarClass that has similar contents to the receiver."
+
+	^ aSimilarClass newFrom: self! !
+
+!Object methodsFor: 'converting' stamp: 'RAA 8/2/1999 12:41'!
+complexContents
+
+	^self! !
+
+!Object methodsFor: 'converting' stamp: 'ajh 7/6/2003 20:37'!
+mustBeBoolean
+	"Catches attempts to test truth of non-Booleans.  This message is sent from the VM.  The sending context is rewound to just before the jump causing this exception."
+
+	^ self mustBeBooleanIn: thisContext sender! !
+
+!Object methodsFor: 'converting' stamp: 'ajh 7/6/2003 20:40'!
+mustBeBooleanIn: context
+	"context is the where the non-boolean error occurred. Rewind context to before jump then raise error."
+
+	| proceedValue |
+	context skipBackBeforeJump.
+	proceedValue _ NonBooleanReceiver new
+		object: self;
+		signal: 'proceed for truth.'.
+	^ proceedValue ~~ false! !
+
+!Object methodsFor: 'converting' stamp: 'sw 3/26/2001 12:12'!
+printDirectlyToDisplay
+	"For debugging: write the receiver's printString directly to the display at (0, 100); senders of this are detected by the check-for-slips mechanism."
+
+	self asString displayAt: 0@100
+
+"StringMorph someInstance printDirectlyToDisplay"! !
+
+!Object methodsFor: 'converting' stamp: 'RAA 3/31/1999 12:13'!
+withoutListWrapper
+
+	^self! !
+
+
+!Object methodsFor: 'copying'!
+clone
+
+	<primitive: 148>
+	self primitiveFailed! !
+
+!Object methodsFor: 'copying' stamp: 'ajh 8/18/2001 21:25'!
+copy
+	"Answer another instance just like the receiver. Subclasses typically override postCopy; they typically do not override shallowCopy."
+
+	^self shallowCopy postCopy! !
+
+!Object methodsFor: 'copying' stamp: 'tk 8/20/1998 16:01'!
+copyAddedStateFrom: anotherObject
+	"Copy over the values of instance variables added by the receiver's class from anotherObject to the receiver.  These will be remapped in mapUniClasses, if needed."
+
+	self class superclass instSize + 1 to: self class instSize do:
+		[:index | self instVarAt: index put: (anotherObject instVarAt: index)]! !
+
+!Object methodsFor: 'copying' stamp: 'tpr 2/14/2004 21:53'!
+copyFrom: anotherObject
+	"Copy to myself all instance variables I have in common with anotherObject.  This is dangerous because it ignores an object's control over its own inst vars.  "
+
+	| mine his |
+	<primitive: 168>
+	mine _ self class allInstVarNames.
+	his _ anotherObject class allInstVarNames.
+	1 to: (mine size min: his size) do: [:ind |
+		(mine at: ind) = (his at: ind) ifTrue: [
+			self instVarAt: ind put: (anotherObject instVarAt: ind)]].
+	self class isVariable & anotherObject class isVariable ifTrue: [
+		1 to: (self basicSize min: anotherObject basicSize) do: [:ind |
+			self basicAt: ind put: (anotherObject basicAt: ind)]].! !
+
+!Object methodsFor: 'copying' stamp: 'ajh 5/23/2002 00:38'!
+copySameFrom: otherObject
+	"Copy to myself all instance variables named the same in otherObject.
+	This ignores otherObject's control over its own inst vars."
+
+	| myInstVars otherInstVars match |
+	myInstVars _ self class allInstVarNames.
+	otherInstVars _ otherObject class allInstVarNames.
+	myInstVars doWithIndex: [:each :index |
+		(match _ otherInstVars indexOf: each) > 0 ifTrue:
+			[self instVarAt: index put: (otherObject instVarAt: match)]].
+	1 to: (self basicSize min: otherObject basicSize) do: [:i |
+		self basicAt: i put: (otherObject basicAt: i)].
+! !
+
+!Object methodsFor: 'copying' stamp: 'tk 4/20/1999 14:44'!
+copyTwoLevel
+	"one more level than a shallowCopy"
+
+	| newObject class index |
+	class _ self class.
+	newObject _ self clone.
+	newObject == self ifTrue: [^ self].
+	class isVariable
+		ifTrue: 
+			[index _ self basicSize.
+			[index > 0]
+				whileTrue: 
+					[newObject basicAt: index put: (self basicAt: index) shallowCopy.
+					index _ index - 1]].
+	index _ class instSize.
+	[index > 0]
+		whileTrue: 
+			[newObject instVarAt: index put: (self instVarAt: index) shallowCopy.
+			index _ index - 1].
+	^newObject! !
+
+!Object methodsFor: 'copying'!
+deepCopy
+	"Answer a copy of the receiver with its own copy of each instance 
+	variable."
+
+	| newObject class index |
+	class _ self class.
+	(class == Object) ifTrue: [^self].
+	class isVariable
+		ifTrue: 
+			[index _ self basicSize.
+			newObject _ class basicNew: index.
+			[index > 0]
+				whileTrue: 
+					[newObject basicAt: index put: (self basicAt: index) deepCopy.
+					index _ index - 1]]
+		ifFalse: [newObject _ class basicNew].
+	index _ class instSize.
+	[index > 0]
+		whileTrue: 
+			[newObject instVarAt: index put: (self instVarAt: index) deepCopy.
+			index _ index - 1].
+	^newObject! !
+
+!Object methodsFor: 'copying' stamp: 'hg 11/23/1999 13:43'!
+initialDeepCopierSize
+	"default value is 4096; other classes may override this, esp. for smaller (=faster) sizes"
+
+	^4096! !
+
+!Object methodsFor: 'copying' stamp: 'ajh 1/27/2003 18:45'!
+postCopy
+	"self is a shallow copy, subclasses should copy fields as necessary to complete the full copy"
+
+	^ self! !
+
+!Object methodsFor: 'copying' stamp: 'jm 11/14/97 11:08'!
+shallowCopy
+	"Answer a copy of the receiver which shares the receiver's instance variables."
+	| class newObject index |
+	<primitive: 148>
+	class _ self class.
+	class isVariable
+		ifTrue: 
+			[index _ self basicSize.
+			newObject _ class basicNew: index.
+			[index > 0]
+				whileTrue: 
+					[newObject basicAt: index put: (self basicAt: index).
+					index _ index - 1]]
+		ifFalse: [newObject _ class basicNew].
+	index _ class instSize.
+	[index > 0]
+		whileTrue: 
+			[newObject instVarAt: index put: (self instVarAt: index).
+			index _ index - 1].
+	^ newObject! !
+
+!Object methodsFor: 'copying' stamp: 'tk 3/11/2003 13:58'!
+veryDeepCopy
+	"Do a complete tree copy using a dictionary.  An object in the tree twice is only copied once.  All references to the object in the copy of the tree will point to the new copy."
+
+	| copier new |
+	copier _ DeepCopier new initialize: self initialDeepCopierSize.
+	new _ self veryDeepCopyWith: copier.
+	copier mapUniClasses.
+	copier references associationsDo: [:assoc | 
+		assoc value veryDeepFixupWith: copier].
+	copier fixDependents.
+	^ new! !
+
+!Object methodsFor: 'copying' stamp: 'tk 3/11/2003 13:58'!
+veryDeepCopySibling
+	"Do a complete tree copy using a dictionary.  Substitute a clone of oldPlayer for the root.  Normally, a Player or non systemDefined object would have a new class.  We do not want one this time.  An object in the tree twice, is only copied once.  All references to the object in the copy of the tree will point to the new copy."
+
+	| copier new |
+	copier _ DeepCopier new initialize: self initialDeepCopierSize.
+	copier newUniClasses: false.
+	new _ self veryDeepCopyWith: copier.
+	copier mapUniClasses.
+	copier references associationsDo: [:assoc | 
+		assoc value veryDeepFixupWith: copier].
+	copier fixDependents.
+	^ new! !
+
+!Object methodsFor: 'copying' stamp: 'tk 5/13/2003 19:39'!
+veryDeepCopyUsing: copier
+	"Do a complete tree copy using a dictionary.  An object in the tree twice is only copied once.  All references to the object in the copy of the tree will point to the new copy.
+	Same as veryDeepCopy except copier (with dictionary) is supplied.
+	** do not delete this method, even if it has no callers **"
+
+	| new refs newDep newModel |
+	new _ self veryDeepCopyWith: copier.
+	copier mapUniClasses.
+	copier references associationsDo: [:assoc | 
+		assoc value veryDeepFixupWith: copier].
+	"Fix dependents"
+	refs _ copier references.
+	DependentsFields associationsDo: [:pair |
+		pair value do: [:dep | 
+			(newDep _ refs at: dep ifAbsent: [nil]) ifNotNil: [
+				newModel _ refs at: pair key ifAbsent: [pair key].
+				newModel addDependent: newDep]]].
+	^ new! !
+
+!Object methodsFor: 'copying' stamp: 'tk 3/11/2003 14:12'!
+veryDeepCopyWith: deepCopier
+	"Copy me and the entire tree of objects I point to.  An object in the tree twice is copied once, and both references point to him.  deepCopier holds a dictionary of objects we have seen.  Some classes refuse to be copied.  Some classes are picky about which fields get deep copied."
+	| class index sub subAss new uc sup has mine |
+	deepCopier references at: self ifPresent: [:newer | ^ newer]. 	"already did him"
+	class _ self class.
+	class isMeta ifTrue: [^ self].		"a class"
+	new _ self clone.
+	(class isSystemDefined not and: [deepCopier newUniClasses "allowed"]) ifTrue: [
+		uc _ deepCopier uniClasses at: class ifAbsent: [nil].
+		uc ifNil: [
+			deepCopier uniClasses at: class put: (uc _ self copyUniClassWith: deepCopier).
+			deepCopier references at: class put: uc].	"remember"
+		new _ uc new.
+		new copyFrom: self].	"copy inst vars in case any are weak"
+	deepCopier references at: self put: new.	"remember"
+	(class isVariable and: [class isPointers]) ifTrue: 
+		[index _ self basicSize.
+		[index > 0] whileTrue: 
+			[sub _ self basicAt: index.
+			(subAss _ deepCopier references associationAt: sub ifAbsent: [nil])
+				ifNil: [new basicAt: index put: (sub veryDeepCopyWith: deepCopier)]
+				ifNotNil: [new basicAt: index put: subAss value].
+			index _ index - 1]].
+	"Ask each superclass if it wants to share (weak copy) any inst vars"
+	new veryDeepInner: deepCopier.		"does super a lot"
+
+	"other superclasses want all inst vars deep copied"
+	sup _ class.  index _ class instSize.
+	[has _ sup compiledMethodAt: #veryDeepInner: ifAbsent: [nil].
+	has _ has ifNil: [class isSystemDefined not "is a uniClass"] ifNotNil: [true].
+	mine _ sup instVarNames.
+	has ifTrue: [index _ index - mine size]	"skip inst vars"
+		ifFalse: [1 to: mine size do: [:xx |
+				sub _ self instVarAt: index.
+				(subAss _ deepCopier references associationAt: sub ifAbsent: [nil])
+						"use association, not value, so nil is an exceptional value"
+					ifNil: [new instVarAt: index put: 
+								(sub veryDeepCopyWith: deepCopier)]
+					ifNotNil: [new instVarAt: index put: subAss value].
+				index _ index - 1]].
+	(sup _ sup superclass) == nil] whileFalse.
+	new rehash.	"force Sets and Dictionaries to rehash"
+	^ new
+! !
+
+!Object methodsFor: 'copying' stamp: 'tk 1/6/1999 17:39'!
+veryDeepFixupWith: deepCopier
+	"I have no fields and no superclass.  Catch the super call."
+! !
+
+!Object methodsFor: 'copying' stamp: 'tk 9/4/2001 10:30'!
+veryDeepInner: deepCopier
+	"No special treatment for inst vars of my superclasses.  Override when some need to be weakly copied.  Object>>veryDeepCopyWith: will veryDeepCopy any inst var whose class does not actually define veryDeepInner:"
+! !
+
+
+!Object methodsFor: 'creation' stamp: 'nk 2/26/2004 13:35'!
+asStringMorph
+	"Open a StringMorph, as best one can, on the receiver"
+
+	^ self asStringOrText asStringMorph
+! !
+
+!Object methodsFor: 'creation' stamp: 'nk 2/26/2004 13:35'!
+asTextMorph
+	"Open a TextMorph, as best one can, on the receiver"
+
+	^ TextMorph new contentsAsIs: self asStringOrText
+! !
+
+!Object methodsFor: 'creation' stamp: 'sw 1/29/2002 21:45'!
+openAsMorph
+	"Open a morph, as best one can, on the receiver"
+
+	^ self asMorph openInHand
+
+"
+234 openAsMorph
+(ScriptingSystem formAtKey: #TinyMenu) openAsMorph
+'fred' openAsMorph
+"! !
+
+
+!Object methodsFor: 'debugging' stamp: 'md 11/24/2004 11:45'!
+haltIf: condition
+	"This is the typical message to use for inserting breakpoints during 
+	debugging.  Param can be a block or expression, halt if true.
+	If the Block has one arg, the receiver is bound to that.
+ 	If the condition is a selector, we look up in the callchain. Halt if
+      any method's selector equals selector."
+	| cntxt |
+
+	condition isSymbol ifTrue:[
+		"only halt if a method with selector symbol is in callchain"
+		cntxt := thisContext.
+		[cntxt sender isNil] whileFalse: [
+			cntxt := cntxt sender. 
+			(cntxt selector = condition) ifTrue: [Halt signal].
+			].
+		^self.
+	].
+	(condition isBlock 
+			ifTrue: [condition valueWithPossibleArgument: self] 
+			ifFalse: [condition] 
+	) ifTrue: [
+		Halt signal
+	].! !
+
+!Object methodsFor: 'debugging'!
+needsWork! !
+
+
+!Object methodsFor: 'debugging-haltOnce' stamp: 'sbw 6/2/2004 08:26'!
+checkHaltCountExpired
+	| counter |
+	counter _ Smalltalk at: #HaltCount ifAbsent: [0].
+	^counter = 0! !
+
+!Object methodsFor: 'debugging-haltOnce' stamp: 'sbw 5/19/2004 19:04'!
+clearHaltOnce
+	"Turn on the halt once flag."
+	Smalltalk at: #HaltOnce put: false! !
+
+!Object methodsFor: 'debugging-haltOnce' stamp: 'sbw 6/2/2004 08:30'!
+decrementAndCheckHaltCount
+	self decrementHaltCount.
+	^self checkHaltCountExpired! !
+
+!Object methodsFor: 'debugging-haltOnce' stamp: 'sbw 6/2/2004 08:28'!
+decrementHaltCount
+	| counter |
+	counter := Smalltalk
+				at: #HaltCount
+				ifAbsent: [0].
+	counter > 0 ifTrue: [
+		counter _ counter - 1.
+		self setHaltCountTo: counter]! !
+
+!Object methodsFor: 'debugging-haltOnce' stamp: 'sbw 6/2/2004 08:42'!
+doExpiredHaltCount
+	self clearHaltOnce.
+	self removeHaltCount.
+	self halt! !
+
+!Object methodsFor: 'debugging-haltOnce' stamp: 'sbw 6/2/2004 08:44'!
+doExpiredHaltCount: aString
+	self clearHaltOnce.
+	self removeHaltCount.
+	self halt: aString! !
+
+!Object methodsFor: 'debugging-haltOnce' stamp: 'sbw 6/2/2004 08:45'!
+doExpiredInspectCount
+	self clearHaltOnce.
+	self removeHaltCount.
+	self inspect! !
+
+!Object methodsFor: 'debugging-haltOnce' stamp: 'sbw 6/2/2004 08:43'!
+haltOnCount: int 
+	self haltOnceEnabled
+		ifTrue: [self hasHaltCount
+				ifTrue: [self decrementAndCheckHaltCount
+						ifTrue: [self doExpiredHaltCount]]
+				ifFalse: [int = 1
+						ifTrue: [self doExpiredHaltCount]
+						ifFalse: [self setHaltCountTo: int - 1]]]! !
+
+!Object methodsFor: 'debugging-haltOnce' stamp: 'sbw 5/19/2004 19:05'!
+haltOnce
+	"Halt unless we have already done it once."
+	self haltOnceEnabled
+		ifTrue: [self clearHaltOnce.
+			^ self halt]! !
+
+!Object methodsFor: 'debugging-haltOnce' stamp: 'sbw 5/19/2004 19:04'!
+haltOnceEnabled
+	^ Smalltalk
+		at: #HaltOnce
+		ifAbsent: [false]! !
+
+!Object methodsFor: 'debugging-haltOnce' stamp: 'sbw 5/19/2004 19:05'!
+haltOnce: aString 
+	"Halt unless we have already done it once."
+	self haltOnceEnabled
+		ifTrue: [self clearHaltOnce.
+			^ self halt: aString]! !
+
+!Object methodsFor: 'debugging-haltOnce' stamp: 'sbw 6/2/2004 08:45'!
+halt: aString onCount: int 
+	self haltOnceEnabled
+		ifTrue: [self hasHaltCount
+				ifTrue: [self decrementAndCheckHaltCount
+						ifTrue: [self doExpiredHaltCount: aString]]
+				ifFalse: [int = 1
+						ifTrue: [self doExpiredHaltCount: aString]
+						ifFalse: [self setHaltCountTo: int - 1]]]! !
+
+!Object methodsFor: 'debugging-haltOnce' stamp: 'sbw 6/2/2004 08:36'!
+hasHaltCount
+	^Smalltalk
+				includesKey: #HaltCount! !
+
+!Object methodsFor: 'debugging-haltOnce' stamp: 'sbw 6/2/2004 08:46'!
+inspectOnCount: int 
+	self haltOnceEnabled
+		ifTrue: [self hasHaltCount
+				ifTrue: [self decrementAndCheckHaltCount
+						ifTrue: [self doExpiredInspectCount]]
+				ifFalse: [int = 1
+						ifTrue: [self doExpiredInspectCount]
+						ifFalse: [self setHaltCountTo: int - 1]]]! !
+
+!Object methodsFor: 'debugging-haltOnce' stamp: 'sbw 5/19/2004 19:05'!
+inspectOnce
+	"Inspect unless we have already done it once."
+	self haltOnceEnabled
+		ifTrue: [self clearHaltOnce.
+			^ self inspect]! !
+
+!Object methodsFor: 'debugging-haltOnce' stamp: 'sbw 6/2/2004 13:20'!
+inspectUntilCount: int 
+	self haltOnceEnabled
+		ifTrue: [self hasHaltCount
+				ifTrue: [self decrementAndCheckHaltCount
+						ifTrue: [self doExpiredInspectCount]
+						ifFalse: [self inspect]]
+				ifFalse: [int = 1
+						ifTrue: [self doExpiredInspectCount]
+						ifFalse: [self setHaltCountTo: int - 1]]]! !
+
+!Object methodsFor: 'debugging-haltOnce' stamp: 'sbw 6/2/2004 08:49'!
+removeHaltCount
+	(Smalltalk includesKey: #HaltCount) ifTrue: [
+		Smalltalk removeKey: #HaltCount]! !
+
+!Object methodsFor: 'debugging-haltOnce' stamp: 'sbw 6/2/2004 08:25'!
+setHaltCountTo: int
+	Smalltalk at: #HaltCount put: int! !
+
+!Object methodsFor: 'debugging-haltOnce' stamp: 'sbw 5/19/2004 19:04'!
+setHaltOnce
+	"Turn on the halt once flag."
+	Smalltalk at: #HaltOnce put: true! !
+
+!Object methodsFor: 'debugging-haltOnce' stamp: 'sbw 5/19/2004 19:04'!
+toggleHaltOnce
+	self haltOnceEnabled
+		ifTrue: [self clearHaltOnce]
+		ifFalse: [self setHaltOnce]! !
+
+
+!Object methodsFor: 'dependents access' stamp: 'ar 2/11/2001 01:55'!
+addDependent: anObject
+	"Make the given object one of the receiver's dependents."
+
+	| dependents |
+	dependents _ self dependents.
+	(dependents includes: anObject) ifFalse:
+		[self myDependents: (dependents copyWithDependent: anObject)].
+	^ anObject! !
+
+!Object methodsFor: 'dependents access' stamp: 'sma 2/29/2000 19:53'!
+breakDependents
+	"Remove all of the receiver's dependents."
+
+	self myDependents: nil! !
+
+!Object methodsFor: 'dependents access' stamp: 'sma 2/29/2000 19:26'!
+canDiscardEdits
+	"Answer true if none of the views on this model has unaccepted edits that matter."
+
+	self dependents
+		do: [:each | each canDiscardEdits ifFalse: [^ false]]
+		without: self.
+	^ true! !
+
+!Object methodsFor: 'dependents access' stamp: 'sma 2/29/2000 19:58'!
+dependents
+	"Answer a collection of objects that are 'dependent' on the receiver;
+	 that is, all objects that should be notified if the receiver changes."
+
+	^ self myDependents ifNil: [#()]! !
+
+!Object methodsFor: 'dependents access'!
+evaluate: actionBlock wheneverChangeIn: aspectBlock
+	| viewerThenObject objectThenViewer |
+	objectThenViewer _ self.
+	viewerThenObject _ ObjectViewer on: objectThenViewer.
+	objectThenViewer become: viewerThenObject.
+	"--- Then ---"
+	objectThenViewer xxxViewedObject: viewerThenObject
+			evaluate: actionBlock
+			wheneverChangeIn: aspectBlock! !
+
+!Object methodsFor: 'dependents access' stamp: 'sma 2/29/2000 19:59'!
+hasUnacceptedEdits
+	"Answer true if any of the views on this object has unaccepted edits."
+
+	self dependents
+		do: [:each | each hasUnacceptedEdits ifTrue: [^ true]]
+		without: self.
+	^ false! !
+
+!Object methodsFor: 'dependents access' stamp: 'sma 2/29/2000 19:55'!
+myDependents
+	"Private. Answer a list of all the receiver's dependents."
+
+	^ DependentsFields at: self ifAbsent: []! !
+
+!Object methodsFor: 'dependents access' stamp: 'sma 2/29/2000 19:52'!
+myDependents: aCollectionOrNil
+	"Private. Set (or remove) the receiver's dependents list."
+
+	aCollectionOrNil
+		ifNil: [DependentsFields removeKey: self ifAbsent: []]
+		ifNotNil: [DependentsFields at: self put: aCollectionOrNil]! !
+
+!Object methodsFor: 'dependents access' stamp: 'reThink 2/18/2001 17:06'!
+release
+	"Remove references to objects that may refer to the receiver. This message 
+	should be overridden by subclasses with any cycles, in which case the 
+	subclass should also include the expression super release."
+
+	self releaseActionMap! !
+
+!Object methodsFor: 'dependents access' stamp: 'sma 2/29/2000 20:23'!
+removeDependent: anObject
+	"Remove the given object as one of the receiver's dependents."
+
+	| dependents |
+	dependents _ self dependents reject: [:each | each == anObject].
+	self myDependents: (dependents isEmpty ifFalse: [dependents]).
+	^ anObject! !
+
+
+!Object methodsFor: 'drag and drop' stamp: 'bh 9/16/2001 18:10'!
+acceptDroppingMorph: transferMorph event: evt inMorph: dstListMorph 
+	
+	^false.! !
+
+!Object methodsFor: 'drag and drop' stamp: 'mir 5/16/2000 11:35'!
+dragAnimationFor: item transferMorph: transferMorph 
+	"Default do nothing"! !
+
+!Object methodsFor: 'drag and drop' stamp: 'panda 4/28/2000 16:20'!
+dragPassengerFor: item inMorph: dragSource 
+	^item! !
+
+!Object methodsFor: 'drag and drop' stamp: 'panda 4/28/2000 16:11'!
+dragTransferType
+	^nil! !
+
+!Object methodsFor: 'drag and drop' stamp: 'panda 4/28/2000 16:05'!
+dragTransferTypeForMorph: dragSource 
+	^nil! !
+
+!Object methodsFor: 'drag and drop' stamp: 'mir 5/8/2000 17:19'!
+wantsDroppedMorph: aMorph event: anEvent inMorph: destinationLM 
+	^false! !
+
+
+!Object methodsFor: 'error handling' stamp: 'sma 5/6/2000 19:35'!
+assert: aBlock
+	"Throw an assertion error if aBlock does not evaluates to true."
+
+	aBlock value ifFalse: [AssertionFailure signal: 'Assertion failed']! !
+
+!Object methodsFor: 'error handling' stamp: 'nk 1/15/2004 10:54'!
+assert: aBlock descriptionBlock: descriptionBlock
+	"Throw an assertion error if aBlock does not evaluate to true."
+
+	aBlock value ifFalse: [AssertionFailure signal: descriptionBlock value asString ]! !
+
+!Object methodsFor: 'error handling' stamp: 'nk 10/25/2003 16:47'!
+assert: aBlock description: aString
+	"Throw an assertion error if aBlock does not evaluates to true."
+
+	aBlock value ifFalse: [AssertionFailure signal: aString ]! !
+
+!Object methodsFor: 'error handling' stamp: 'md 10/13/2004 15:59'!
+backwardCompatibilityOnly: anExplanationString
+	"Warn that the sending method has been deprecated. Methods that are tagt with #backwardCompatibility:
+	 are kept for compatibility."
+
+	Preferences showDeprecationWarnings ifTrue:
+		[Deprecation signal: thisContext sender printString, ' has been deprecated (but will be kept for compatibility). ', anExplanationString]! !
+
+!Object methodsFor: 'error handling'!
+caseError
+	"Report an error from an in-line or explicit case statement."
+
+	self error: 'Case not found, and no otherwise clause'! !
+
+!Object methodsFor: 'error handling' stamp: 'rbb 3/1/2005 09:26'!
+confirm: queryString
+	"Put up a yes/no menu with caption queryString. Answer true if the 
+	response is yes, false if no. This is a modal question--the user must 
+	respond yes or no."
+
+	"nil confirm: 'Are you hungry?'"
+
+	^ UIManager default confirm: queryString! !
+
+!Object methodsFor: 'error handling' stamp: 'rbb 3/1/2005 09:27'!
+confirm: aString orCancel: cancelBlock
+	"Put up a yes/no/cancel menu with caption aString. Answer true if  
+	the response is yes, false if no. If cancel is chosen, evaluate  
+	cancelBlock. This is a modal question--the user must respond yes or no."
+
+	^ UIManager default confirm: aString orCancel: cancelBlock! !
+
+!Object methodsFor: 'error handling' stamp: 'dew 10/6/2003 18:20'!
+deprecated: anExplanationString
+	"Warn that the sending method has been deprecated."
+
+	Preferences showDeprecationWarnings ifTrue:
+		[Deprecation signal: thisContext sender printString, ' has been deprecated. ', anExplanationString]! !
+
+!Object methodsFor: 'error handling' stamp: 'dew 10/7/2003 00:26'!
+deprecated: anExplanationString block: aBlock 
+	 "Warn that the sender has been deprecated.  Answer the value of aBlock on resumption.  (Note that #deprecated: is usually the preferred method.)"
+
+	Preferences showDeprecationWarnings ifTrue:
+		[Deprecation
+			signal: thisContext sender printString, ' has been deprecated. ', anExplanationString].
+	^ aBlock value.
+! !
+
+!Object methodsFor: 'error handling' stamp: 'md 2/22/2006 21:21'!
+doesNotUnderstand: aMessage 
+	 "Handle the fact that there was an attempt to send the given message to the receiver but the receiver does not understand this message (typically sent from the machine when a message is sent to the receiver and no method is defined for that selector)."
+	"Testing: (3 activeProcess)"
+
+	MessageNotUnderstood new 
+		message: aMessage;
+		receiver: self;
+		signal.
+	^ aMessage sentTo: self.
+! !
+
+!Object methodsFor: 'error handling' stamp: 'TRee 11/4/2003 16:47'!
+dpsTrace: reportObject  
+	Transcript myDependents isNil ifTrue: [^self].
+	self dpsTrace: reportObject levels: 1 withContext: thisContext
+		
+" nil dpsTrace: 'sludder'. "! !
+
+!Object methodsFor: 'error handling' stamp: 'TRee 11/4/2003 16:49'!
+dpsTrace: reportObject levels: anInt
+	self dpsTrace: reportObject levels: anInt withContext: thisContext
+
+"(1 to: 3) do: [:int | nil dpsTrace: int levels: 5.]"! !
+
+!Object methodsFor: 'error handling' stamp: 'TRee 11/4/2003 17:02'!
+dpsTrace: reportObject levels: anInt withContext: currentContext
+	| reportString context displayCount |
+	reportString := (reportObject respondsTo: #asString) 
+			ifTrue: [reportObject asString] ifFalse: [reportObject printString].
+	(Smalltalk at: #Decompiler ifAbsent: [nil]) 
+	ifNil: 
+		[Transcript cr; show: reportString]
+	ifNotNil:
+		[context := currentContext.
+		displayCount := anInt > 1.
+		1 to: anInt do:
+			[:count |
+			Transcript cr.
+			displayCount
+				ifTrue: [Transcript show: count printString, ': '].
+			
+			reportString notNil
+			ifTrue:
+				[Transcript show: context home class name 
+			, '/' , context sender selector,  ' (' , reportString , ')'.
+				context := context sender.
+				reportString := nil]
+			ifFalse:
+				[(context notNil and: [(context := context sender) notNil])
+				ifTrue: [Transcript show: context receiver class name , '/' , context selector]]].
+		"Transcript cr"].! !
+
+!Object methodsFor: 'error handling' stamp: 'md 8/2/2005 22:17'!
+error
+	"Throw a generic Error exception."
+
+	^self error: 'Error!!'.! !
+
+!Object methodsFor: 'error handling' stamp: 'tfei 4/12/1999 12:55'!
+error: aString 
+	"Throw a generic Error exception."
+
+	^Error new signal: aString! !
+
+!Object methodsFor: 'error handling' stamp: 'al 9/16/2005 14:12'!
+explicitRequirement
+	self error: 'Explicitly required method'! !
+
+!Object methodsFor: 'error handling' stamp: 'al 2/13/2006 22:20'!
+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! !
+
+!Object methodsFor: 'error handling' stamp: 'tfei 4/12/1999 12:59'!
+halt: aString 
+	"This is the typical message to use for inserting breakpoints during 
+	debugging. It creates and schedules a Notifier with the argument, 
+	aString, as the label."
+	
+	Halt new signal: aString! !
+
+!Object methodsFor: 'error handling' stamp: 'md 1/20/2006 16:24'!
+handles: exception
+	"This method exists in case a non exception class is the first arg in an on:do: (for instance using a exception class that is not loaded). We prefer this to raising an error during error handling itself. Also, semantically it makes sense that the exception handler is not active if its exception class is not loaded"
+
+	^ false! !
+
+!Object methodsFor: 'error handling' stamp: 'ar 9/27/2005 20:24'!
+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."
+
+	ToolSet
+		debugContext: thisContext
+		label: aString
+		contents: aString
+
+	"nil notifyWithLabel: 'let us see if this works'"! !
+
+!Object methodsFor: 'error handling' stamp: 'hg 10/2/2001 20:49'!
+notify: aString 
+	"Create and schedule a Notifier with the argument as the message in 
+	order to request confirmation before a process can proceed."
+
+	Warning signal: aString
+
+	"nil notify: 'confirmation message'"! !
+
+!Object methodsFor: 'error handling'!
+notify: aString at: location
+	"Create and schedule a Notifier with the argument as the message in 
+	order to request confirmation before a process can proceed. Subclasses can
+	override this and insert an error message at location within aString."
+
+	self notify: aString
+
+	"nil notify: 'confirmation message' at: 12"! !
+
+!Object methodsFor: 'error handling'!
+primitiveFailed
+	"Announce that a primitive has failed and there is no appropriate 
+	Smalltalk code to run."
+
+	self error: 'a primitive has failed'! !
+
+!Object methodsFor: 'error handling' stamp: 'al 9/16/2005 14:12'!
+requirement
+	self error: 'Implicitly required method'! !
+
+!Object methodsFor: 'error handling' stamp: 'AFi 2/8/2003 22:52'!
+shouldBeImplemented
+	"Announce that this message should be implemented"
+
+	self error: 'This message should be implemented'! !
+
+!Object methodsFor: 'error handling'!
+shouldNotImplement
+	"Announce that, although the receiver inherits this message, it should 
+	not implement it."
+
+	self error: 'This message is not appropriate for this object'! !
+
+!Object methodsFor: 'error handling' stamp: 'md 2/17/2006 12:02'!
+subclassResponsibility
+	"This message sets up a framework for the behavior of the class' subclasses.
+	Announce that the subclass should have implemented this message."
+
+	self error: 'My subclass should have overridden ', thisContext sender selector printString! !
+
+!Object methodsFor: 'error handling' stamp: 'al 12/16/2003 16:16'!
+traitConflict
+	self error: 'A class or trait does not properly resolve a conflict between multiple traits it uses.'! !
+
+
+!Object methodsFor: 'evaluating' stamp: 'reThink 3/12/2001 18:14'!
+value
+
+	^self! !
+
+!Object methodsFor: 'evaluating' stamp: 'reThink 2/18/2001 15:23'!
+valueWithArguments: aSequenceOfArguments
+
+	^self! !
+
+
+!Object methodsFor: 'events' stamp: 'nk 8/27/2003 16:23'!
+actionsWithReceiver: anObject forEvent: anEventSelector
+
+	^(self actionSequenceForEvent: anEventSelector)
+                select: [:anAction | anAction receiver == anObject ]! !
+
+!Object methodsFor: 'events' stamp: 'nk 8/27/2003 17:45'!
+renameActionsWithReceiver: anObject forEvent: anEventSelector toEvent: newEvent
+
+	| oldActions newActions |
+	oldActions _ Set new.
+	newActions _ Set new.
+	(self actionSequenceForEvent: anEventSelector) do: [ :action |
+		action receiver == anObject
+			ifTrue: [ oldActions add: anObject ]
+			ifFalse: [ newActions add: anObject ]].
+	self setActionSequence: (ActionSequence withAll: newActions) forEvent: anEventSelector.
+	oldActions do: [ :act | self when: newEvent evaluate: act ].! !
+
+
+!Object methodsFor: 'events-accessing' stamp: 'nk 12/20/2002 17:48'!
+actionForEvent: anEventSelector
+    "Answer the action to be evaluated when <anEventSelector> has been triggered."
+
+	| actions |
+	actions := self actionMap
+		at: anEventSelector asSymbol
+		ifAbsent: [nil].
+	actions ifNil: [^nil].
+	^ actions asMinimalRepresentation! !
+
+!Object methodsFor: 'events-accessing' stamp: 'nk 12/20/2002 17:48'!
+actionForEvent: anEventSelector
+ifAbsent: anExceptionBlock
+    "Answer the action to be evaluated when <anEventSelector> has been triggered."
+
+	| actions |
+	actions := self actionMap
+		at: anEventSelector asSymbol
+		ifAbsent: [nil].
+	actions ifNil: [^anExceptionBlock value].
+	^ actions asMinimalRepresentation! !
+
+!Object methodsFor: 'events-accessing' stamp: 'reThink 2/18/2001 14:43'!
+actionMap
+
+	^EventManager actionMapFor: self! !
+
+!Object methodsFor: 'events-accessing' stamp: 'rw 4/27/2002 08:35'!
+actionSequenceForEvent: anEventSelector
+
+    ^(self actionMap
+        at: anEventSelector asSymbol
+        ifAbsent: [^WeakActionSequence new])
+            asActionSequence! !
+
+!Object methodsFor: 'events-accessing' stamp: 'SqR 6/28/2001 13:19'!
+actionsDo: aBlock
+
+	self actionMap do: aBlock! !
+
+!Object methodsFor: 'events-accessing' stamp: 'rw 2/10/2002 13:05'!
+createActionMap
+
+	^IdentityDictionary new! !
+
+!Object methodsFor: 'events-accessing' stamp: 'SqR 2/19/2001 14:04'!
+hasActionForEvent: anEventSelector
+    "Answer true if there is an action associated with anEventSelector"
+
+    ^(self actionForEvent: anEventSelector) notNil! !
+
+!Object methodsFor: 'events-accessing' stamp: 'reThink 2/18/2001 15:29'!
+setActionSequence: actionSequence
+forEvent: anEventSelector
+
+    | action |
+    action := actionSequence asMinimalRepresentation.
+    action == nil
+        ifTrue:
+            [self removeActionsForEvent: anEventSelector]
+        ifFalse:
+            [self updateableActionMap
+                at: anEventSelector asSymbol
+                put: action]! !
+
+!Object methodsFor: 'events-accessing' stamp: 'reThink 2/25/2001 08:50'!
+updateableActionMap
+
+	^EventManager updateableActionMapFor: self! !
+
+
+!Object methodsFor: 'events-registering' stamp: 'reThink 2/18/2001 15:04'!
+when: anEventSelector evaluate: anAction 
+
+	| actions |
+	actions := self actionSequenceForEvent: anEventSelector.
+	(actions includes: anAction)
+		ifTrue: [^ self].
+	self 
+		setActionSequence: (actions copyWith: anAction)
+		forEvent: anEventSelector! !
+
+!Object methodsFor: 'events-registering' stamp: 'rww 12/30/2002 10:37'!
+when: anEventSelector
+send: aMessageSelector
+to: anObject
+ 
+    self
+        when: anEventSelector
+        evaluate: (WeakMessageSend
+            receiver: anObject
+            selector: aMessageSelector)! !
+
+!Object methodsFor: 'events-registering' stamp: 'rww 12/30/2002 10:37'!
+when: anEventSelector
+send: aMessageSelector
+to: anObject
+withArguments: anArgArray
+ 
+    self
+        when: anEventSelector
+        evaluate: (WeakMessageSend
+            receiver: anObject
+            selector: aMessageSelector
+		arguments: anArgArray)! !
+
+!Object methodsFor: 'events-registering' stamp: 'rww 12/30/2002 10:37'!
+when: anEventSelector
+send: aMessageSelector
+to: anObject
+with: anArg
+ 
+    self
+        when: anEventSelector
+        evaluate: (WeakMessageSend
+            receiver: anObject
+            selector: aMessageSelector
+		arguments: (Array with: anArg))! !
+
+
+!Object methodsFor: 'events-removing' stamp: 'reThink 2/18/2001 15:33'!
+releaseActionMap
+
+	EventManager releaseActionMapFor: self! !
+
+!Object methodsFor: 'events-removing' stamp: 'reThink 2/18/2001 15:33'!
+removeActionsForEvent: anEventSelector
+
+    | map |
+    map := self actionMap.
+    map removeKey: anEventSelector asSymbol ifAbsent: [].
+    map isEmpty
+        ifTrue: [self releaseActionMap]! !
+
+!Object methodsFor: 'events-removing' stamp: 'nk 8/25/2003 21:46'!
+removeActionsSatisfying: aBlock
+
+	self actionMap keys do:
+		[:eachEventSelector |
+			self
+   				removeActionsSatisfying: aBlock
+				forEvent: eachEventSelector
+		]! !
+
+!Object methodsFor: 'events-removing' stamp: 'reThink 2/18/2001 15:31'!
+removeActionsSatisfying: aOneArgBlock 
+forEvent: anEventSelector
+
+    self
+        setActionSequence:
+            ((self actionSequenceForEvent: anEventSelector)
+                reject: [:anAction | aOneArgBlock value: anAction])
+        forEvent: anEventSelector! !
+
+!Object methodsFor: 'events-removing' stamp: 'rw 7/29/2003 17:18'!
+removeActionsWithReceiver: anObject
+
+	self actionMap copy keysDo:
+		[:eachEventSelector |
+			self
+   				removeActionsSatisfying: [:anAction | anAction receiver == anObject]
+				forEvent: eachEventSelector
+		]! !
+
+!Object methodsFor: 'events-removing' stamp: 'reThink 2/18/2001 15:36'!
+removeActionsWithReceiver: anObject
+forEvent: anEventSelector
+
+    self
+        removeActionsSatisfying:
+            [:anAction |
+            anAction receiver == anObject]
+        forEvent: anEventSelector! !
+
+!Object methodsFor: 'events-removing' stamp: 'reThink 2/18/2001 15:31'!
+removeAction: anAction
+forEvent: anEventSelector
+
+    self
+        removeActionsSatisfying: [:action | action = anAction]
+        forEvent: anEventSelector! !
+
+
+!Object methodsFor: 'events-triggering' stamp: 'reThink 2/18/2001 15:22'!
+triggerEvent: anEventSelector
+	"Evaluate all actions registered for <anEventSelector>. Return the value of the last registered action."
+
+    ^(self actionForEvent: anEventSelector) value! !
+
+!Object methodsFor: 'events-triggering' stamp: 'reThink 2/18/2001 17:09'!
+triggerEvent: anEventSelector
+ifNotHandled: anExceptionBlock