nil subclass: #Object instanceVariableNames: '' category: 'Kernel'! !Object methodsFor: 'accessing'! yourself ^self ! class {'return self.klass'} ! size self error: 'Object not indexable' ! instVarAt: aString {' var value = self[''@''+aString]; if(typeof(value) == ''undefined'') { return nil; } else { return value; } '} ! instVarAt: aString put: anObject {'self[''@'' + aString] = anObject'} ! basicAt: aString {' var value = self[aString]; if(typeof(value) == ''undefined'') { return nil; } else { return value; } '} ! basicAt: aString put: anObject {'return self[aString] = anObject'} ! basicDelete: aString {'delete self[aString]'} ! ! !Object methodsFor: 'comparing'! = anObject {'return self == anObject'} ! ~= anObject ^(self = anObject) == false ! ! !Object methodsFor: 'converting'! -> anObject ^Association key: self value: anObject ! asString ^self printString ! asJavascript ^self asString ! asJSON {'return JSON.stringify(self._asJSONObject())'} ! asJSONObject | object | object := Object new. self class instanceVariableNames do: [:each | object basicAt: each put: (self instVarAt: each) asJSONObject]. ^object ! ! !Object methodsFor: 'copying'! copy ^self shallowCopy postCopy ! shallowCopy {' var copy = self.klass._new(); for(var i in self) { if(/^@.+/.test(i)) { copy[i] = self[i]; } } return copy; '} ! deepCopy {' var copy = self.klass._new(); for(var i in self) { if(/^@.+/.test(i)) { copy[i] = self[i]._deepCopy(); } } return copy; '}. ! postCopy ! ! !Object methodsFor: 'error handling'! error: aString Error signal: aString ! subclassResponsibility self error: 'This method is a responsibility of a subclass' ! shouldNotImplement self error: 'This method should not be implemented in ', self class name ! try: aBlock catch: anotherBlock {'try{aBlock()} catch(e) {anotherBlock(e)}'} ! doesNotUnderstand: aMessage MessageNotUnderstood new receiver: self; message: aMessage; signal ! ! !Object methodsFor: 'initialization'! initialize ! ! !Object methodsFor: 'message handling'! perform: aSymbol ^self perform: aSymbol withArguments: #() ! perform: aSymbol withArguments: aCollection ^self basicPerform: aSymbol asSelector withArguments: aCollection ! basicPerform: aSymbol ^self basicPerform: aSymbol withArguments: #() ! basicPerform: aSymbol withArguments: aCollection {'return self[aSymbol].apply(self, aCollection);'} ! ! !Object methodsFor: 'printing'! printString ^'a ', self class name ! printNl {'console.log(self)'} ! ! !Object methodsFor: 'testing'! isKindOf: aClass ^(self isMemberOf: aClass) ifTrue: [true] ifFalse: [self class inheritsFrom: aClass] ! isMemberOf: aClass ^self class = aClass ! ifNil: aBlock ^self ! ifNil: aBlock ifNotNil: anotherBlock ^anotherBlock value ! ifNotNil: aBlock ^aBlock value ! ifNotNil: aBlock ifNil: anotherBlock ^aBlock value ! isNil ^false ! notNil ^self isNil not ! isClass ^false ! isMetaclass ^false ! isNumber ^false ! isString ^false ! isParseFailure ^false ! ! !Object class methodsFor: 'initialization'! initialize "no op" ! ! Object subclass: #Smalltalk instanceVariableNames: '' category: 'Kernel'! !Smalltalk methodsFor: 'accessing'! classes {'return self.classes()'} ! debugMode {'return self.debugMode'} ! debugMode: aBoolean {'self.debugMode = aBoolean'} ! readJSON: anObject {'return self.readJSObject(anObject);'} ! at: aString {'return self[aString]'} ! ! Smalltalk class instanceVariableNames: 'current'! !Smalltalk class methodsFor: 'accessing'! current {'return smalltalk'} ! ! Object subclass: #Behavior instanceVariableNames: '' category: 'Kernel'! !Behavior methodsFor: 'accessing'! name {'return self.className || nil'} ! superclass {'return self.superclass || nil'} ! subclasses {'return smalltalk.subclasses(self)'} ! allSubclasses | result | result := self subclasses. self subclasses do: [:each | result addAll: each allSubclasses]. ^result ! withAllSubclasses ^(Array with: self) addAll: self allSubclasses; yourself ! prototype {'return self.fn.prototype'} ! methodDictionary {'var dict = smalltalk.Dictionary._new(); var methods = self.fn.prototype.methods; for(var i in methods) { if(methods[i].selector) { dict._at_put_(methods[i].selector, methods[i]); } }; return dict'} ! methodsFor: aString ^ClassCategoryReader new class: self category: aString; yourself ! addCompiledMethod: aMethod {'self.fn.prototype[aMethod.selector._asSelector()] = aMethod.fn; self.fn.prototype.methods[aMethod.selector] = aMethod; aMethod.methodClass = self'} ! instanceVariableNames {'return self.iVarNames'} ! comment ^(self basicAt: 'comment') ifNil: [''] ! comment: aString self basicAt: 'comment' put: aString ! commentStamp ^ClassCommentReader new class: self; yourself ! removeCompiledMethod: aMethod {'delete self.fn.prototype[aMethod.selector._asSelector()]; delete self.fn.prototype.methods[aMethod.selector]'} ! protocols | protocols | protocols := Array new. self methodDictionary do: [:each | (protocols includes: each category) ifFalse: [ protocols add: each category]]. ^protocols sort ! protocolsDo: aBlock "Execute aBlock for each method category with its collection of methods in the sort order of category name." | methodsByCategory | methodsByCategory := Dictionary new. self methodDictionary values do: [:m | (methodsByCategory at: m category ifAbsentPut: [Array new]) add: m]. self protocols do: [:category | aBlock value: category value: (methodsByCategory at: category)] ! ! !Behavior methodsFor: 'instance creation'! new ^self basicNew initialize ! basicNew {'return new self.fn()'} ! inheritsFrom: aClass ^aClass allSubclasses includes: self ! ! Behavior subclass: #Class instanceVariableNames: '' category: 'Kernel'! !Class methodsFor: 'accessing'! category {'return self.category'} ! category: aString {'self.category = aString'} ! rename: aString {' smalltalk[aString] = self; delete smalltalk[self.className]; self.className = aString; '} ! ! !Class methodsFor: 'class creation'! subclass: aString instanceVariableNames: anotherString ^self subclass: aString instanceVariableNames: anotherString category: nil ! subclass: aString instanceVariableNames: aString2 category: aString3 ^ClassBuilder new superclass: self subclass: aString instanceVariableNames: aString2 category: aString3 ! ! !Class methodsFor: 'printing'! printString ^self name ! ! !Class methodsFor: 'testing'! isClass ^true ! ! Behavior subclass: #Metaclass instanceVariableNames: '' category: 'Kernel'! !Metaclass methodsFor: 'accessing'! instanceClass {'return self.instanceClass'} ! instanceVariableNames: aCollection ClassBuilder new class: self instanceVariableNames: aCollection ! ! !Metaclass methodsFor: 'printing'! printString ^self instanceClass name, ' class' ! ! !Metaclass methodsFor: 'testing'! isMetaclass ^true ! ! Object subclass: #CompiledMethod instanceVariableNames: '' category: 'Kernel'! !CompiledMethod methodsFor: 'accessing'! source ^(self basicAt: 'source') ifNil: [''] ! source: aString self basicAt: 'source' put: aString ! category ^(self basicAt: 'category') ifNil: [''] ! category: aString self basicAt: 'category' put: aString ! selector ^self basicAt: 'selector' ! selector: aString self basicAt: 'selector' put: aString ! fn ^self basicAt: 'fn' ! fn: aBlock self basicAt: 'fn' put: aBlock ! messageSends ^self basicAt: 'messageSends' ! methodClass ^self basicAt: 'methodClass' ! referencedClasses ^self basicAt: 'referencedClasses' ! ! Object subclass: #Number instanceVariableNames: '' category: 'Kernel'! !Number methodsFor: 'arithmetic'! + aNumber {'return self + aNumber'} ! - aNumber {'return self - aNumber'} ! * aNumber {'return self * aNumber'} ! / aNumber {'return self / aNumber'} ! max: aNumber {'return Math.max(self, aNumber);'} ! min: aNumber {'return Math.min(self, aNumber);'} ! ! !Number methodsFor: 'comparing'! = aNumber {'return Number(self) == aNumber'} ! > aNumber {'return self > aNumber'} ! < aNumber {'return self < aNumber'} ! >= aNumber {'return self >= aNumber'} ! <= aNumber {'return self <= aNumber'} ! ! !Number methodsFor: 'converting'! rounded {'return Math.round(self);'} ! truncated {'return Math.floor(self);'} ! to: aNumber | array first last count | first := self truncated. last := aNumber truncated + 1. count := 1. (first <= last) ifFalse: [self error: 'Wrong interval']. array := Array new. (last - first) timesRepeat: [ array at: count put: first. count := count + 1. first := first + 1]. ^array ! asString ^self printString ! asJavascript ^'(', self printString, ')' ! atRandom ^(Random new next * self) truncated + 1 ! @ aNumber ^Point x: self y: aNumber ! asPoint ^Point x: self y: self ! asJSONObject ^self ! ! !Number methodsFor: 'enumerating'! timesRepeat: aBlock | integer count | integer := self truncated. count := 1. [count > self] whileFalse: [ aBlock value. count := count + 1] ! to: aNumber do: aBlock ^(self to: aNumber) do: aBlock ! ! !Number methodsFor: 'printing'! printString {'return String(self)'} ! ! !Number methodsFor: 'testing'! isNumber ^true ! ! !Number methodsFor: 'timeouts/intervals'! clearInterval {'clearInterval(Number(self))'} ! clearTimeout {'clearTimeout(Number(self))'} ! ! !Number class methodsFor: 'instance creation'! pi {'return Math.PI'} ! ! Object subclass: #BlockClosure instanceVariableNames: '' category: 'Kernel'! !BlockClosure methodsFor: 'accessing'! compiledSource {'return self.toString()'} ! ! !BlockClosure methodsFor: 'controlling'! whileTrue: aBlock {'while(self()) {aBlock()}'} ! whileFalse: aBlock {'while(!!self()) {aBlock()}'} ! ! !BlockClosure methodsFor: 'error handling'! on: anErrorClass do: aBlock self try: self catch: [:error | (error isKindOf: anErrorClass) ifTrue: [aBlock value: error] ifFalse: [error signal]] ! ! !BlockClosure methodsFor: 'evaluating'! value {'return self();'} ! value: anArg {'return self(anArg);'} ! value: firstArg value: secondArg {'return self(firstArg, secondArg);'} ! value: firstArg value: secondArg value: thirdArg {'return self(firstArg, secondArg, thirdArg);'} ! valueWithPossibleArguments: aCollection {'return self.apply(null, aCollection);'} ! ! !BlockClosure methodsFor: 'timeout/interval'! valueWithTimeout: aNumber {'return setTimeout(self, aNumber)'} ! valueWithInterval: aNumber {'return setInterval(self, aNumber)'} ! ! Object subclass: #Boolean instanceVariableNames: '' category: 'Kernel'! !Boolean methodsFor: 'comparing'! = aBoolean {'return Boolean(self == true) == aBoolean'} ! asJSONObject ^self ! ! !Boolean methodsFor: 'controlling'! ifTrue: aBlock ^self ifTrue: aBlock ifFalse: [] ! ifFalse: aBlock ^self ifTrue: [] ifFalse: aBlock ! ifFalse: aBlock ifTrue: anotherBlock ^self ifTrue: anotherBlock ifFalse: aBlock ! ifTrue: aBlock ifFalse: anotherBlock {' if(self == true) { return aBlock(); } else { return anotherBlock(); } '} ! and: aBlock ^self = true ifTrue: aBlock ifFalse: [false] ! or: aBlock ^self = true ifTrue: [true] ifFalse: aBlock ! not ^self = false ! ! !Boolean methodsFor: 'copying'! shallowCopy ^self ! deepCopy ^self ! ! !Boolean methodsFor: 'printing'! printString {'return self.toString()'} ! ! Object subclass: #Date instanceVariableNames: '' category: 'Kernel'! !Date commentStamp! The Date class is used to work with dates and times.! !Date methodsFor: 'accessing'! year {'return self.getFullYear()'} ! month {'return self.getMonth() + 1'} ! month: aNumber {'self.setMonth(aNumber - 1)'} ! day ^self dayOfWeek ! dayOfWeek {'return self.getDay() + 1'} ! dayOfWeek: aNumber {'return self.setDay(aNumber - 1)'} ! day: aNumber self day: aNumber ! year: aNumber {'self.setFullYear(aNumber)'} ! dayOfMonth {'return self.getDate()'} ! dayOfMonth: aNumber {'self.setDate(aNumber)'} ! time {'return self.getTime()'} ! time: aNumber {'self.setTime(aNumber)'} ! hours: aNumber {'self.setHours(aNumber)'} ! minutes: aNumber {'self.setMinutes(aNumber)'} ! seconds: aNumber {'self.setSeconds(aNumber)'} ! milliseconds: aNumber {'self.setMilliseconds(aNumber)'} ! hours {'return self.getHours()'} ! minutes {'return self.getMinutes()'} ! seconds {'return self.getSeconds()'} ! milliseconds {'return self.getMilliseconds()'} ! ! !Date methodsFor: 'arithmetic'! - aDate {'return self - aDate'} ! + aDate {'return self + aDate'} ! ! !Date methodsFor: 'comparing'! < aDate {'return self < aDate'} ! > aDate {'return self > aDate'} ! <= aDate {'self <= aDate'} ! >= aDate {'self >= aDate'} ! ! !Date methodsFor: 'converting'! asString {'return self.toString()'} ! asMilliseconds ^self time ! asDateString {'return self.toDateString()'} ! asTimeString {'return self.toTimeString()'} ! asLocaleString {'return self.toLocaleString()'} ! asNumber ^self asMilliseconds ! asJSONObject ^self ! ! !Date methodsFor: 'printing'! printString ^self asString ! ! !Date class methodsFor: 'instance creation'! new: anObject {'return new Date(anObject)'} ! fromString: aString "Example: Date fromString('2011/04/15 00:00:00')" ^self new: aString ! fromSeconds: aNumber ^self fromMilliseconds: aNumber * 1000 ! fromMilliseconds: aNumber ^self new: aNumber ! today ^self new ! now ^self today ! millisecondsToRun: aBlock | t | t := Date now. aBlock value. ^Date now - t ! ! Object subclass: #UndefinedObject instanceVariableNames: '' category: 'Kernel'! !UndefinedObject methodsFor: 'class creation'! subclass: aString instanceVariableNames: anotherString ^self subclass: aString instanceVariableNames: anotherString category: nil ! subclass: aString instanceVariableNames: aString2 category: aString3 ^ClassBuilder new superclass: self subclass: aString instanceVariableNames: aString2 category: aString3 ! ! !UndefinedObject methodsFor: 'copying'! shallowCopy ^self ! deepCopy ^self ! ! !UndefinedObject methodsFor: 'printing'! printString ^'nil' ! ! !UndefinedObject methodsFor: 'testing'! ifNil: aBlock ^self ifNil: aBlock ifNotNil: [] ! ifNotNil: aBlock ^self ! ifNil: aBlock ifNotNil: anotherBlock ^aBlock value ! ifNotNil: aBlock ifNil: anotherBlock ^anotherBlock value ! isNil ^true ! notNil ^false ! ! !UndefinedObject class methodsFor: 'instance creation'! new self error: 'You cannot create new instances of UndefinedObject. Use nil' ! ! Object subclass: #Collection instanceVariableNames: '' category: 'Kernel'! !Collection methodsFor: 'accessing'! size self subclassResponsibility ! readStream ^self stream ! writeStream ^self stream ! stream ^self streamClass on: self ! streamClass ^self class streamClass ! ! !Collection methodsFor: 'adding/removing'! add: anObject self subclassResponsibility ! addAll: aCollection aCollection do: [:each | self add: each]. ^aCollection ! remove: anObject self subclassResponsibility ! ! !Collection methodsFor: 'converting'! asArray | array index | array := Array new. index := 0. self do: [:each | index := index + 1. array at: index put: each]. ^array ! ! !Collection methodsFor: 'copying'! , aCollection ^self copy addAll: aCollection; yourself ! copyWith: anObject ^self copy add: anObject; yourself ! copyWithAll: aCollection ^self copy addAll: aCollection; yourself ! ! !Collection methodsFor: 'enumerating'! do: aBlock {'for(var i=0;i aString {'return String(self) > aString'} ! < aString {'return String(self) < aString'} ! >= aString {'return String(self) >= aString'} ! <= aString {'return String(self) <= aString'} ! ! !String methodsFor: 'converting'! asSelector "If you change this method, change smalltalk.convertSelector too (see js/boot.js file)" | selector | selector := '_', self. selector := selector replace: ':' with: '_'. selector := selector replace: '[+]' with: '_plus'. selector := selector replace: '-' with: '_minus'. selector := selector replace: '[*]' with: '_star'. selector := selector replace: '[/]' with: '_slash'. selector := selector replace: '>' with: '_gt'. selector := selector replace: '<' with: '_lt'. selector := selector replace: '=' with: '_eq'. selector := selector replace: ',' with: '_comma'. selector := selector replace: '[@]' with: '_at'. ^selector ! asJavascript {' if(self.search(/^[a-zA-Z0-9_:.$ ]*$/) == -1) return "unescape(\"" + escape(self) + "\")"; else return "\"" + self + "\""; '} ! tokenize: aString {'return self.split(aString)'} ! asString ^self ! asNumber {'return Number(self);'} ! asParser ^PPStringParser new string: self ! asChoiceParser ^PPChoiceParser withAll: (self asArray collect: [:each | each asParser]) ! asCharacterParser ^PPCharacterParser new string: self ! asJSONObject ^self ! ! !String methodsFor: 'copying'! , aString {'return self + aString'} ! copyFrom: anIndex to: anotherIndex {'return self.substring(anIndex - 1, anotherIndex);'} ! shallowCopy ^self class fromString: self ! deepCopy ^self shallowCopy ! ! !String methodsFor: 'error handling'! errorReadOnly self error: 'Object is read-only' ! ! !String methodsFor: 'printing'! printString ^'''', self, '''' ! printNl {'console.log(self)'} ! ! !String methodsFor: 'regular expressions'! replace: aString with: anotherString ^self replaceRegexp: (RegularExpression fromString: aString flag: 'g') with: anotherString ! replaceRegexp: aRegexp with: aString {'return self.replace(aRegexp, aString);'} ! match: aRegexp {'return self.search(aRegexp) !!= -1'} ! trimLeft: separators ^self replaceRegexp: (RegularExpression fromString: '^[', separators, ']+' flag: 'g') with: '' ! trimRight: separators ^self replaceRegexp: (RegularExpression fromString: '[', separators, ']+$' flag: 'g') with: '' ! trimLeft ^self trimLeft: '\s' ! trimRight ^self trimRight: '\s' ! trimBoth ^self trimBoth: '\s' ! trimBoth: separators ^(self trimLeft: separators) trimRight: separators ! ! !String methodsFor: 'testing'! isString ^true ! ! !String class methodsFor: 'accessing'! streamClass ^StringStream ! cr {'return ''\r'';'} ! lf {'return ''\n'';'} ! space {'return '' '';'} ! tab {'return ''\t'';'} ! crlf {'return ''\r\n'';'} ! ! !String class methodsFor: 'instance creation'! fromString: aString {'return new self.fn(aString);'} ! ! SequenceableCollection subclass: #Array instanceVariableNames: '' category: 'Kernel'! !Array methodsFor: 'accessing'! size {'return self.length'} ! at: anIndex put: anObject {'return self[anIndex - 1] = anObject'} ! at: anIndex ifAbsent: aBlock {' var value = self[anIndex - 1]; if(value === undefined) { return aBlock(); } else { return value; } '} ! ! !Array methodsFor: 'adding/removing'! add: anObject {'self.push(anObject); return anObject;'} ! remove: anObject {' for(var i=0;i