--- a/Annotation.st Fri Sep 07 13:46:06 2012 +0100
+++ b/Annotation.st Fri Sep 07 17:24:32 2012 +0100
@@ -112,7 +112,16 @@
"Created: / 05-09-2011 / 04:39:17 / cg"
!
+nameSpace: aString
+
+ ^Annotation::NameSpace new nameSpaceName: aString
+
+ "Created: / 19-05-2010 / 16:01:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Created: / 26-07-2012 / 23:05:28 / cg"
+!
+
namespace: aString
+ <resource: #obsolete>
^Annotation::NameSpace new nameSpaceName: aString
@@ -354,6 +363,15 @@
^ aBlock valueWithArguments: self arguments
! !
+!Annotation methodsFor:'queries'!
+
+refersToLiteral: anObject
+ (anObject == self key) ifTrue:[ ^ true ].
+ ^ false
+
+ "Created: / 26-07-2012 / 15:58:34 / cg"
+! !
+
!Annotation methodsFor:'testing'!
hasLiteral: aLiteral
@@ -467,16 +485,17 @@
!Annotation::Resource methodsFor:'printing & storing'!
storeOn:aStream
-
aStream nextPutAll: '(Annotation resource: '.
type storeOn: aStream.
- value notNil ifTrue:
- [aStream nextPutAll: ' value: '.
- value storeOn: aStream].
+ value notNil ifTrue: [
+ aStream nextPutAll: ' value: '.
+ value storeOn: aStream
+ ].
aStream nextPut:$)
"Modified: / 16-07-2010 / 11:36:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 29-11-2011 / 11:19:06 / cg"
+ "Modified (format): / 26-07-2012 / 15:59:14 / cg"
! !
!Annotation::Resource methodsFor:'processing'!
@@ -495,6 +514,26 @@
"Modified: / 16-07-2010 / 11:28:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+!Annotation::Resource methodsFor:'queries'!
+
+refersToLiteral: anObject
+ (anObject == type) ifTrue:[ ^ true ].
+ (anObject == value) ifTrue:[ ^ true ].
+ value isArray ifTrue:[ ^ value refersToLiteral: anObject].
+ ^ false
+
+ "Created: / 26-07-2012 / 15:57:58 / cg"
+!
+
+refersToLiteralMatching: aMatchString
+ (type isSymbol and:[aMatchString match:type])ifTrue:[ ^ true ].
+ (value isSymbol and:[aMatchString match:value])ifTrue:[ ^ true ].
+ value isArray ifTrue:[ ^ value refersToLiteralMatching: aMatchString].
+ ^ false
+
+ "Created: / 26-07-2012 / 16:01:26 / cg"
+! !
+
!Annotation::Resource methodsFor:'testing'!
isResource
@@ -564,6 +603,28 @@
"Modified: / 20-05-2010 / 11:15:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+!Annotation::Unknown methodsFor:'queries'!
+
+refersToLiteral: anObject
+ (anObject == method) ifTrue:[ ^ true ].
+ (anObject == key) ifTrue:[ ^ true ].
+ (anObject == arguments) ifTrue:[ ^ true ].
+ arguments isArray ifTrue:[ ^ arguments refersToLiteral: anObject].
+ ^ false
+
+ "Created: / 26-07-2012 / 15:57:43 / cg"
+!
+
+refersToLiteralMatching: aMatchString
+ (method isSymbol and:[aMatchString match:method])ifTrue:[ ^ true ].
+ (key isSymbol and:[aMatchString match:key])ifTrue:[ ^ true ].
+ (arguments isSymbol and:[aMatchString match:arguments])ifTrue:[ ^ true ].
+ arguments isArray ifTrue:[ ^ arguments refersToLiteralMatching: aMatchString].
+ ^ false
+
+ "Created: / 26-07-2012 / 16:00:58 / cg"
+! !
+
!Annotation::Unknown methodsFor:'testing'!
isUnknown
@@ -573,15 +634,15 @@
!Annotation class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Annotation.st,v 1.8 2012/07/18 17:33:44 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Annotation.st,v 1.10 2012/07/26 21:26:14 cg Exp $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/Annotation.st,v 1.8 2012/07/18 17:33:44 cg Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/Annotation.st,v 1.10 2012/07/26 21:26:14 cg Exp §'
!
version_SVN
- ^ '$Id: Annotation.st 10829 2012-07-25 08:45:15Z vranyj1 $'
+ ^ '$Id: Annotation.st 10844 2012-09-07 16:24:32Z vranyj1 $'
! !
Annotation initialize!
--- a/ApplicationDefinition.st Fri Sep 07 13:46:06 2012 +0100
+++ b/ApplicationDefinition.st Fri Sep 07 17:24:32 2012 +0100
@@ -1552,7 +1552,7 @@
^ '# $','Header','$
#
# DO NOT EDIT
-# automagically generated from the projectDefinition: ',self name,"JV@2012-04-12: Commented, it only generates new unnecessary revisions -->' at ',Timestamp now printString,"'.
+# automagically generated from the projectDefinition: ',self name",' at ',Timestamp now printString",'.
#
# Warning: once you modify this file, do not rerun
# stmkmp or projectDefinition-build again - otherwise, your changes are lost.
@@ -1615,6 +1615,7 @@
STCLOCALOPT=''-package=$(PACKAGE)'' $(LOCALDEFINES) $(LOCALINCLUDES) %(HEADEROUTPUTARG) $(STCLOCALOPTIMIZATIONS) $(STCWARNINGS) $(LOCALDEFINES) $(COMMONSYMFLAG) -varPrefix=$(LIBNAME)
!!ifdef USEBC
+
OBJDIR=objbc
LIBDIR=libbc
@@ -1622,8 +1623,10 @@
# LFLAGS = -L$(TOP)\$(LIBDIR);$(BCB)\lib;$(DEBUGLIBPATH) -H:0x400000 -Hc:0x100000 -S:0x40000 -Sc:0x10000 -ap -Tpe -x -Gn -v -Ao:0x10000
LFLAGS = -L$(TOP)\$(LIBDIR);$(BCB)\lib -S:0x40000 -Sc:0x10000 $(LFLAGS_APPTYPE) -Tpe -x -Gn -v -Ao:0x10000
USE_ARG=-DUSEBC
+
!!else
!! ifdef USEVC
+
OBJDIR=objvc
LIBDIR=libvc
@@ -1632,27 +1635,47 @@
RT_LIB =
LFLAGS = /nologo /DEBUG /DYNAMICBASE:NO /MACHINE:X86 /ERRORREPORT:PROMPT
USE_ARG=-DUSEVC
+
!! else
+!! ifdef USETCC
+
+OBJDIR=objtcc
+LIBDIR=libtcc
+
+# TCCDIR=$(TOP)\support\tcc
+CRT_STARTUP=
+RT_LIB =
+LFLAGS =
+USE_ARG=-DUSETCC
+
+!! else
error error
+!! endif
!! endif
!!endif
-PROJECT_NOCONSOLE = %(NOCONSOLE_APPLICATION)
-PROJECT_CONSOLE = %(CONSOLE_APPLICATION)
-ALLOBJFILES = main.obj
-RESFILES = %(RESFILENAME)
-ALLOBJ = $(CRT_STARTUP) $(ALLOBJFILES) $(OBJS)
+PROJECT_NOCONSOLE= %(NOCONSOLE_APPLICATION)
+PROJECT_CONSOLE= %(CONSOLE_APPLICATION)
+ALLOBJFILES= main.$(O)
+RESFILES= %(RESFILENAME)
+ALLOBJ= $(CRT_STARTUP) $(ALLOBJFILES) $(OBJS)
DEFFILE=$(TOP)\rules\bc_exe.def
LIBFILES=$(TOP)\$(LIBDIR)\librun.lib
+OBJDIR_LIBRUN=$(OBJDIR)
!!ifdef USEBC
ALLLIB=$(LIBFILES) import32.lib $(RT_LIB)
!!endif
-
!!ifdef USEVC
ALLLIB=$(LIBFILES) kernel32.lib
!!endif
+!!ifdef USETCC
+OBJDIR_LIBRUN=objvc
+LIBFILES=$(TOP)\libvc\librun.lib
+RESFILES=
+ALLLIB=$(LIBFILES) kernel32.lib
+!!endif
REQUIRED_LIBS=librun.dll %(REQUIRED_LIBS)
REQUIRED_FILES=cs3245.dll X11.dll Xext.dll symbols.stc $(REQUIRED_LIBS)
@@ -1669,7 +1692,7 @@
# the executable only
# with console
consoleApp: $(REQUIRED_LIBS)
- -del main.obj
+ -del main.$(O)
$(MAKE) -N -f bc.mak \
$(USE_ARG) \
MAKE_BAT=$(MAKE_BAT) \
@@ -1680,7 +1703,7 @@
# without console
noConsoleApp: $(REQUIRED_LIBS)
- -del main.obj
+ -del main.$(O)
$(MAKE) -N -f bc.mak \
$(USE_ARG) \
MAKE_BAT=$(MAKE_BAT) \
@@ -1755,7 +1778,19 @@
/SUBSYSTEM:CONSOLE kernel32.lib $(ALLLIB) $(RESFILES)
!! else
+!! ifdef USETCC
+
+$(PROJECT_CONSOLE): $(ALLOBJFILES) $(OBJS) $(RESFILES) $(DEFFILE)
+ $(CC) $(LFLAGS) $(ALLOBJ) -o "$(PROJECT_CONSOLE)" \
+ kernel32.lib $(ALLLIB) $(RESFILES)
+
+$(PROJECT_NOCONSOLE): $(ALLOBJFILES) $(OBJS) $(RESFILES) $(DEFFILE)
+ $(CC) $(LFLAGS) $(ALLOBJ) -o "$(PROJECT_NOCONSOLE)" \
+ kernel32.lib $(ALLLIB) $(RESFILES)
+
+!! else
error error error
+!! endif
!! endif
!!endif
@@ -1766,7 +1801,7 @@
#
%(APPLICATION)Win.res: %(APPLICATION)Win.rc %(APPLICATION).ico
-main.obj: buildDate.h main.c bc.mak
+main.$(O): buildDate.h main.c bc.mak
main.c: $(TOP)\librun\main.c
copy $(TOP)\librun\main.c main.c
@@ -1774,8 +1809,8 @@
buildDate.h: $(TOP)\librun\genDate.exe
$(TOP)\librun\genDate.exe
-librun.dll: $(TOP)\librun\$(OBJDIR)\librun.dll
- copy $(TOP)\librun\$(OBJDIR)\librun.dll librun.dll
+librun.dll: $(TOP)\librun\$(OBJDIR_LIBRUN)\librun.dll
+ copy $(TOP)\librun\$(OBJDIR_LIBRUN)\librun.dll librun.dll
cs3245.dll: $(TOP)\support\win32\borland\cs3245.dll
copy $(TOP)\support\win32\borland\cs3245.dll cs3245.dll
@@ -1822,8 +1857,7 @@
# ENDMAKEDEPEND --- do not remove this line
'.
- "Modified: / 20-01-2012 / 13:56:17 / cg"
- "Modified: / 28-09-2011 / 13:30:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 04-09-2012 / 00:58:03 / cg"
!
bc_dot_mak_app_source_rules
@@ -2123,7 +2157,7 @@
^
'# $','Header','$
#
-# automagically generated from the projectDefinition: ',self name,"JV@2012-04-12: Commented, it only generates new unnecessary revisions -->' at ',Timestamp now printString,"'.
+# automagically generated from the projectDefinition: ',self name",' at ',Timestamp now printString",'.
#
# -------------- no need to change anything below ----------
#
@@ -2247,7 +2281,7 @@
"Modified: / 09-08-2006 / 16:50:23 / fm"
"Created: / 29-09-2006 / 23:47:07 / cg"
"Modified: / 24-06-2009 / 21:40:26 / Jan Vrany <vranyj1@fel.cvut.cz>"
- "Modified: / 23-12-2011 / 15:07:38 / cg"
+ "Modified: / 26-07-2012 / 00:57:07 / cg"
!
make_dot_proto_app_source_rules
@@ -2877,13 +2911,13 @@
!ApplicationDefinition class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/ApplicationDefinition.st,v 1.193 2012/07/20 15:42:43 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ApplicationDefinition.st,v 1.195 2012/09/03 23:03:35 cg Exp $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/ApplicationDefinition.st,v 1.193 2012/07/20 15:42:43 cg Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/ApplicationDefinition.st,v 1.195 2012/09/03 23:03:35 cg Exp §'
!
version_SVN
- ^ '$Id: ApplicationDefinition.st 10829 2012-07-25 08:45:15Z vranyj1 $'
+ ^ '$ Id: ApplicationDefinition.st 10645 2011-06-09 15:28:45Z vranyj1 $'
! !
--- a/Array.st Fri Sep 07 13:46:06 2012 +0100
+++ b/Array.st Fri Sep 07 17:24:32 2012 +0100
@@ -1803,6 +1803,28 @@
"Modified: / 18.8.2000 / 21:18:14 / cg"
!
+refersToLiteralMatching:aMatchPattern
+ "return true if the receiver or recursively any array element in the
+ receiver is symbolic and matches aMatchPattern (i.e. a deep search)"
+
+ self do:[ :el |
+ (el isSymbol and:[ aMatchPattern match: el]) ifTrue:[^true].
+ el class == Array ifTrue:[
+ (el refersToLiteralMatching: aMatchPattern) ifTrue: [^true]
+ ]
+ ].
+ ^ false
+
+ "
+ #(1 2 3) refersToLiteralMatching:#foo
+ #(1 2 3 foo bar baz) refersToLiteralMatching:#foo
+ #(1 2 3 (((bar foo))) bar baz) refersToLiteralMatching:#foo
+ "
+
+ "Modified: / 18-08-2000 / 21:18:14 / cg"
+ "Created: / 26-07-2012 / 15:38:01 / cg"
+!
+
size
"return the number of indexed elements in the receiver.
Reimplemented here to avoid the additional size->basicSize send
@@ -2538,15 +2560,15 @@
!Array class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Array.st,v 1.150 2012/06/07 09:08:32 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Array.st,v 1.151 2012/07/26 14:06:44 cg Exp $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/Array.st,v 1.150 2012/06/07 09:08:32 cg Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/Array.st,v 1.151 2012/07/26 14:06:44 cg Exp §'
!
version_SVN
- ^ '$Id: Array.st 10824 2012-07-18 16:55:48Z vranyj1 $'
+ ^ '$Id: Array.st 10844 2012-09-07 16:24:32Z vranyj1 $'
! !
--- a/Behavior.st Fri Sep 07 13:46:06 2012 +0100
+++ b/Behavior.st Fri Sep 07 17:24:32 2012 +0100
@@ -20,8 +20,6 @@
!Behavior class methodsFor:'documentation'!
-
-
copyright
"
COPYRIGHT (c) 1988 by Claus Gittinger
@@ -347,7 +345,6 @@
%}
!
-
flagBehavior
"return the flag code which marks Behavior-like instances.
Inline C-code and the VM check this single bit in the flag value when
@@ -2818,14 +2815,23 @@
!Behavior methodsFor:'printing & storing'!
-displayString
- "although behaviors have no name, we return something
+displayOn:aGCOrStream
+ "return a string to display the receiver - include the
+ count for your convenience.
+
+ although behaviors have no name, we return something
useful here - there are many places (inspectors) where
a classes name is asked for.
Implementing this message here allows instances of anonymous classes
to show a reasonable name."
- ^ 'someBehavior'
+ "/ what a kludge - Dolphin and Squeak mean: printOn: a stream;
+ "/ ST/X (and some old ST80's) mean: draw-yourself on a GC.
+ (aGCOrStream isStream) ifFalse:[
+ ^ super displayOn:aGCOrStream
+ ].
+
+ aGCOrStream nextPutAll:self name
!
printOn:aStream
@@ -3221,14 +3227,14 @@
|classname|
classname := self name.
- classname isEmpty ifTrue:[ ^ 'an anonymous' ].
+ classname isEmptyOrNil ifTrue:[ ^ 'an anonymous' ].
^ classname article , ' ' , classname
"
SmallInteger nameWithArticle
"
- "Modified: / 16-07-2006 / 00:02:23 / cg"
+ "Modified: / 13-06-2012 / 14:50:03 / cg"
!
owningClass
@@ -3794,7 +3800,7 @@
^ 0
-!
+!
isAlienBehavior
"Returns true iff I'm an alien behavior."
@@ -3804,7 +3810,6 @@
!
-
isBits
"return true, if instances have indexed byte or short instance variables.
Ignore long, float and double arrays, since ST-80 code using isBits are probably
@@ -4790,13 +4795,13 @@
!Behavior class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.321 2012/07/23 09:38:41 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.323 2012/08/03 15:53:19 stefan Exp $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.321 2012/07/23 09:38:41 cg Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.323 2012/08/03 15:53:19 stefan Exp §'
!
version_SVN
- ^ '$Id: Behavior.st 10829 2012-07-25 08:45:15Z vranyj1 $'
+ ^ '$Id: Behavior.st 10844 2012-09-07 16:24:32Z vranyj1 $'
! !
--- a/ClassBuilder.st Fri Sep 07 13:46:06 2012 +0100
+++ b/ClassBuilder.st Fri Sep 07 17:24:32 2012 +0100
@@ -1055,7 +1055,7 @@
"/ dont allow built-in classes to be modified
(oldClass notNil and:[oldClass isBuiltInClass and:[instVarChange]]) ifTrue:[
- ClassBuildError raiseErrorString:'the layout of this class is fixed - you cannot change it'.
+ ClassBuildError raiseErrorString:'The layout of this class is fixed - you cannot change it.'.
AbortSignal raise
].
@@ -1107,7 +1107,7 @@
].
].
- "Modified: / 30-10-2011 / 12:07:49 / cg"
+ "Modified: / 26-07-2012 / 11:34:12 / cg"
!
flagsForVariable:variable pointers:pointers words:words
@@ -2377,15 +2377,15 @@
!ClassBuilder class methodsFor:'documentation'!
version
- ^ '$Id: ClassBuilder.st 10843 2012-09-07 12:46:06Z vranyj1 $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ClassBuilder.st,v 1.116 2012/07/26 09:43:46 cg Exp $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/ClassBuilder.st,v 1.114 2012/01/31 13:14:34 cg Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/ClassBuilder.st,v 1.116 2012/07/26 09:43:46 cg Exp §'
!
version_SVN
- ^ '$Id: ClassBuilder.st 10843 2012-09-07 12:46:06Z vranyj1 $'
+ ^ '$Id: ClassBuilder.st 10844 2012-09-07 16:24:32Z vranyj1 $'
! !
ClassBuilder initialize!
--- a/ClassDescription.st Fri Sep 07 13:46:06 2012 +0100
+++ b/ClassDescription.st Fri Sep 07 17:24:32 2012 +0100
@@ -820,7 +820,6 @@
"Created: / 28.3.1998 / 21:21:52 / cg"
! !
-
!ClassDescription methodsFor:'Compatibility-V''Age'!
categoriesFor:aSelector are:listOfCategories
@@ -2785,35 +2784,41 @@
!ClassDescription methodsFor:'printing & storing'!
-displayString
+displayOn:aGCOrStream
"return a string for display in inspectors"
- |nm more cat|
-
- cat := self category.
-
- (cat = 'obsolete'
- or:[cat = '* obsolete *']) ifTrue:[
- "add obsolete - to make life easier ..."
- more := ' (obsolete)'
- ].
- (cat = 'removed'
- or:[cat = '* removed *']) ifTrue:[
- "add removed - to make life easier ..."
- more := ' (removed)'
- ].
- self isLoaded ifFalse:[
- more := ' (autoloaded)'
+ |cat|
+
+ "/ what a kludge - Dolphin and Squeak mean: printOn: a stream;
+ "/ ST/X (and some old ST80's) mean: draw-yourself on a GC.
+ (aGCOrStream isStream) ifFalse:[
+ ^ super displayOn:aGCOrStream
].
self isPrivate ifTrue:[
- nm := self nameWithoutPrefix.
- more := ' (private in ' , self owningClass name , ')'.
+ aGCOrStream
+ nextPutAll:self nameWithoutPrefix;
+ nextPutAll:' (private in ';
+ nextPutAll:self owningClass name;
+ nextPut:$).
] ifFalse:[
- nm := self name.
+ aGCOrStream nextPutAll:self name.
+ ].
+
+ cat := self category.
+ (cat = 'obsolete'
+ or:[cat = '* obsolete *']) ifTrue:[
+ "add obsolete - to make life easier ..."
+ aGCOrStream nextPutAll:' (obsolete)'.
].
- more isNil ifTrue:[^ nm].
- ^ nm , more
+ (cat = 'removed'
+ or:[cat = '* removed *']) ifTrue:[
+ "add removed - to make life easier ..."
+ aGCOrStream nextPutAll:' (removed)'.
+ ].
+ self isLoaded ifFalse:[
+ aGCOrStream nextPutAll:' (autoloaded)'.
+ ].
"Modified: 15.10.1996 / 20:01:30 / cg"
"Modified: 1.4.1997 / 15:49:13 / stefan"
@@ -4193,15 +4198,15 @@
!ClassDescription class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/ClassDescription.st,v 1.224 2012/07/23 10:17:39 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ClassDescription.st,v 1.225 2012/08/03 15:54:13 stefan Exp $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/ClassDescription.st,v 1.224 2012/07/23 10:17:39 cg Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/ClassDescription.st,v 1.225 2012/08/03 15:54:13 stefan Exp §'
!
version_SVN
- ^ '$Id: ClassDescription.st 10829 2012-07-25 08:45:15Z vranyj1 $'
+ ^ '$Id: ClassDescription.st 10844 2012-09-07 16:24:32Z vranyj1 $'
! !
ClassDescription::MethodRedefinitionNotification initialize!
--- a/Collection.st Fri Sep 07 13:46:06 2012 +0100
+++ b/Collection.st Fri Sep 07 17:24:32 2012 +0100
@@ -1257,10 +1257,10 @@
abs
"absolute value of all elements in the collection"
- ^ self collect: [:a | a abs]
-
- "
- TestCase assert:( { 1. -2. -3. 4 } abs = { 1. 2. 3. 4 }).
+ ^ self collect:[:a | a abs]
+
+ "
+ TestCase assert:( #(1 -2 -3 4) abs = #(1 2 3 4)).
"
"Modified: / 18-03-2011 / 10:33:50 / cg"
@@ -1272,7 +1272,7 @@
^ self collect:[:a | a negated]
"
- TestCase assert:( { 1. -2. -3. 4 } negated = { -1. 2. 3. -4 }).
+ TestCase assert:( #(1 -2 -3 4) negated = #(-1 2 3 -4)).
"
"Modified: / 18-03-2011 / 10:33:53 / cg"
@@ -1281,17 +1281,15 @@
product
"multiply up all elements."
- self emptyCheck.
^ self
- inject:(self first class unity)
- into:[:accum :each | accum * each].
-
- "
- TestCase should:[ Array new sum ] raise:Error.
-
- TestCase assert:( { 1 } product == 1).
- TestCase assert:( { 6 } product == 6).
- TestCase assert:( { 1. 2. 3. 4. 5. } product = 5 factorial )
+ fold:[:accum :each | accum * each].
+
+ "
+ TestCase should:[ Array new product ] raise:Error.
+
+ TestCase assert:( #(1) product == 1).
+ TestCase assert:( #(6) product == 6).
+ TestCase assert:( #(1 2 3 4 5) product = 5 factorial )
"
!
@@ -1301,14 +1299,12 @@
self isEmpty ifTrue:[^ 0].
^ self
- inject:(self first class zero)
- into:[:accum :each | accum + each].
-
-
- "
- TestCase assert: ( { } sum = 0 ).
- TestCase assert: ( { 1 } sum = 1 ).
- TestCase assert: ( { 1. 2. 3. 4. } sum = 10 ).
+ fold:[:accum :each | accum + each].
+
+ "
+ TestCase assert: ( #() sum = 0 ).
+ TestCase assert: ( #(1) sum = 1 ).
+ TestCase assert: ( #(1 2 3 4) sum = 10 ).
TestCase assert: ( (1 to:10) sum = 55 ).
TestCase assert: ( 'abc' asByteArray sum = 294 ).
TestCase assert: ( { 10 +/- 2.
@@ -1341,8 +1337,9 @@
^ sum ? 0
"
- ((1 to:10) collect:[:n | n squared]) sum
- ((1 to:10) sum:[:n | n squared])
+ TestCase assert:(
+ ((1 to:10) collect:[:n | n squared]) sum = ((1 to:10) sum:[:n | n squared])
+ )
"
"Modified: / 23-08-2010 / 18:19:42 / cg"
@@ -1529,7 +1526,7 @@
asSet
"return a new Set with the receiver collections elements"
- ^ self addAllNonNilElementsTo:(Set new:self size)
+ ^ self addAllTo:(Set new:self size)
!
asSharedCollection
@@ -2400,22 +2397,29 @@
and so on. Answer the result of the final evaluation. If the receiver
is empty, raise an error. If the receiver has a single element, answer
that element.
- See also: inject:into:"
+
+ Here the reduction is done from left to right.
+
+ See also: #inject:into: #reduce:"
| first nextValue |
- self emptyCheck.
-
first := true.
self do:[:each |
- nextValue := first
- ifTrue: [first := false. each]
- ifFalse: [binaryBlock value: nextValue value: each]
+ first
+ ifTrue: [first := false. nextValue := each]
+ ifFalse: [nextValue := binaryBlock value:nextValue value:each]
+ ].
+ first ifTrue:[
+ ^ self emptyCollectionError.
].
^ nextValue
"
+ (1 to:15) fold:[:x :y| '(', x printString, '+', y printString, ')']
+ (1 to:15) reduce:[:x :y| '(', x printString, '+', y printString, ')']
#('if' 'it' 'is' 'to' 'be' 'it' 'is' 'up' 'to' 'me') fold: [:a :b | a, ' ', b]
+ #('if' 'it' 'is' 'to' 'be' 'it' 'is' 'up' 'to' 'me') reduce: [:a :b | a, ' ', b]
"
"Created: / 14-09-2011 / 16:29:53 / cg"
@@ -2424,7 +2428,9 @@
inject:thisValue into:binaryBlock
"starting with thisValue for value, pass this value and each element
to binaryBlock, replacing value with the result returned from the block
- in the next iteration."
+ in the next iteration.
+
+ See also: #fold: #reduce:"
|nextValue|
@@ -2623,27 +2629,35 @@
"Created: / 20-07-2011 / 00:54:41 / cg"
!
-reduce:aTwoArgBlock
- "reduce by iteratively applying aTwoArgBlock to the result from the
- previous reduce and an element.
- The first evaluation is on the first two elements."
-
- |first|
-
- self emptyCheck.
+reduce:binaryBlock
+ "Evaluate the block with the first two elements of the receiver,
+ then with the result of the first evaluation and the next element,
+ and so on. Answer the result of the final evaluation. If the receiver
+ is empty, raise an error. If the receiver has a single element, answer
+ that element.
+
+ Here the reduction is done from right to left.
+
+ See also: #inject:into: #fold:"
+
+ | first nextValue |
+
first := true.
- ^ self
- inject:nil
- into:[:accu :el |
- first ifTrue:[
- first := false.
- el
- ] ifFalse:[
- aTwoArgBlock value:el value:accu
- ]
- ]
-
- "
+ self do:[:each |
+ first
+ ifTrue: [first := false. nextValue := each]
+ ifFalse: [nextValue := binaryBlock value:each value:nextValue]
+ ].
+ first ifTrue:[
+ ^ self emptyCollectionError.
+ ].
+ ^ nextValue
+
+ "
+ (1 to:15) reduce:[:x :y| '(', x printString, '+', y printString, ')']
+ (1 to:15) fold:[:x :y| '(', x printString, '+', y printString, ')']
+ #('if' 'it' 'is' 'to' 'be' 'it' 'is' 'up' 'to' 'me') reduce: [:a :b | a, ' ', b]
+ #('if' 'it' 'is' 'to' 'be' 'it' 'is' 'up' 'to' 'me') fold: [:a :b | a, ' ', b]
#(10 1 2 3) reduce:[:el :diff | diff - el]
#(10 1 2 3) reduce:[:el :diff | diff + el]
"
@@ -2652,23 +2666,7 @@
!
reduceLeft:aTwoArgBlock
- "reduce by iteratively applying aTwoArgBlock to an element and the result from the
- previous reduce. The first evaluation is on the first two elements."
-
- |first|
-
- self emptyCheck.
- first := true.
- ^ self
- inject:nil
- into:[:accu :el |
- first ifTrue:[
- first := false.
- el
- ] ifFalse:[
- aTwoArgBlock value:accu value:el
- ]
- ]
+ ^ self fold:aTwoArgBlock
"
#(1 2 3 4 5) reduceLeft:[:sum :el | sum + el]
@@ -2817,6 +2815,30 @@
"Modified: 10.5.1997 / 14:15:43 / cg"
!
+tuplesDo:aBlock
+ "evaluate the argument, aBlock for every element in the collection,
+ which is supposed to consist of N-element collections.
+ The block is called with N arguments for each collection in the receiver."
+
+ self do:[:aTuple |
+ aBlock valueWithArguments:aTuple
+ ]
+ "
+ #(
+ (1 one eins uno)
+ (2 two zwei due)
+ (3 three drei tre)
+ (4 four vier quattro)
+ (5 five #'fuenf' cinque)
+ )
+ tuplesDo:[:num :sym1 :sym2 :sym3 |
+ Transcript show:num; space; show:sym1; space; show:sym2; space; showCR:sym3
+ ]
+ "
+
+ "Modified: 10.5.1997 / 14:15:43 / cg"
+!
+
with:aCollection collect:aTwoArgBlock
"evaluate the argument, aBlock for successive elements from
each the receiver and the argument, aSequenceableCollection;
@@ -3069,7 +3091,11 @@
!Collection methodsFor:'error handling'!
emptyCheck
- "check if the receiver is empty; report an error if so"
+ "check if the receiver is empty; report an error if so.
+
+ CAVEAT: Set redefines #emptySet with a different meaning,
+ so calling this for a Set or a Dictionary does not show the
+ expected behaviour!!"
self isEmpty ifTrue:[
^ self emptyCollectionError.
@@ -3237,7 +3263,7 @@
displayStringName
"redefinable helper for displayString"
- ^ (self class name)
+ ^ self class name
"Created: / 2.2.1999 / 22:39:33 / cg"
!
@@ -3661,13 +3687,10 @@
using #< to compare elements.
Raises an error, if the receiver is empty."
- self emptyCheck.
-
^ self
- inject:nil
- into:[:maxSoFar :this |
- (maxSoFar isNil or:[maxSoFar < this])
- ifTrue:[this]
+ fold:[:maxSoFar :each |
+ maxSoFar < each
+ ifTrue:[each]
ifFalse:[maxSoFar]
]
@@ -3687,9 +3710,9 @@
using aBlock to compare elements.
Raises an error, if the receiver is empty."
- self emptyCheck.
-
- ^ self
+ |ret|
+
+ ret := self
inject:nil
into:[:maxSoFar :this |
|v|
@@ -3698,9 +3721,15 @@
(maxSoFar isNil or:[maxSoFar < v])
ifTrue:[v]
ifFalse:[maxSoFar]
- ]
-
- "
+ ].
+
+ ret isNil ifTrue:[
+ ^ self emptyCollectionError.
+ ].
+ ^ ret.
+
+ "
+ #() max -> Error
#(15 1 -9 -20 10 5) max -> 15
#(15 1 -9 -20 10 5) maxApplying:[:el | el abs] -> 20
"
@@ -3714,13 +3743,10 @@
using < to compare elements.
Raises an error, if the receiver is empty."
- self emptyCheck.
-
^ self
- inject:nil
- into:[:minSoFar :this |
- (minSoFar isNil or:[this < minSoFar])
- ifTrue:[this]
+ fold:[:minSoFar :each |
+ each < minSoFar
+ ifTrue:[each]
ifFalse:[minSoFar]
]
@@ -3739,9 +3765,9 @@
using aBlock to compare elements.
Raises an error, if the receiver is empty."
- self emptyCheck.
-
- ^ self
+ |ret|
+
+ ret := self
inject:nil
into:[:minSoFar :this |
|v|
@@ -3750,7 +3776,11 @@
(minSoFar isNil or:[v < minSoFar])
ifTrue:[v]
ifFalse:[minSoFar]
- ]
+ ].
+ ret isNil ifTrue:[
+ ^ self emptyCollectionError.
+ ].
+ ^ ret.
"
#(15 -1 -9 10 5) min -> -9
@@ -3768,8 +3798,6 @@
|min max|
- self emptyCheck.
-
min := max := nil.
self do:[:each |
min isNil ifTrue:[
@@ -3784,6 +3812,10 @@
]
]
].
+ min isNil ifTrue:[
+ ^ self emptyCollectionError.
+ ].
+
^ Array with:min with:max
"
@@ -3858,9 +3890,9 @@
^ (sumDeltaSquares / (self size - 1)) sqrt
"
- TestCase assert:( { 1. 2. 3. 4 } arithmeticMean = 2.5).
- TestCase assert:( { 13. 23. 12. 44. 55 } arithmeticMean closeTo: 29.4).
- TestCase assert:( { 13. 23. 12. 44. 55 } standardDeviation closeTo: 19.2431).
+ TestCase assert:( #( 1 2 3 4) arithmeticMean = 2.5).
+ TestCase assert:( #(13 23 12 44 55) arithmeticMean closeTo: 29.4).
+ TestCase assert:( #(13 23 12 44 55) standardDeviation closeTo: 19.2431).
"
"Created: / 13-04-2011 / 17:58:47 / cg"
@@ -4365,15 +4397,15 @@
!Collection class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Collection.st,v 1.276 2012/07/20 13:05:23 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Collection.st,v 1.281 2012/08/21 12:49:44 cg Exp $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/Collection.st,v 1.276 2012/07/20 13:05:23 cg Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/Collection.st,v 1.281 2012/08/21 12:49:44 cg Exp §'
!
version_SVN
- ^ '$Id: Collection.st 10829 2012-07-25 08:45:15Z vranyj1 $'
+ ^ '$Id: Collection.st 10844 2012-09-07 16:24:32Z vranyj1 $'
! !
Collection initialize!
--- a/CompiledCode.st Fri Sep 07 13:46:06 2012 +0100
+++ b/CompiledCode.st Fri Sep 07 17:24:32 2012 +0100
@@ -1818,10 +1818,10 @@
receiver refers to aLiteral (i.e. a deep search)"
self literalsDo: [ :el |
- el == aLiteral ifTrue:[^true].
- el class == Array ifTrue:[
- (el refersToLiteral: aLiteral) ifTrue: [^true]
- ]
+ el == aLiteral ifTrue:[^true].
+ el class == Array ifTrue:[
+ (el refersToLiteral: aLiteral) ifTrue: [^true]
+ ]
].
^ false
@@ -1830,22 +1830,44 @@
(CompiledCode compiledMethodAt:#refersToLiteral:) refersToLiteral:#class
"
- "Modified: / 3.3.1998 / 00:02:28 / stefan"
- "Modified: / 18.8.2000 / 21:17:47 / cg"
+ "Modified: / 03-03-1998 / 00:02:28 / stefan"
+ "Modified: / 26-07-2012 / 15:44:33 / cg"
+!
+
+refersToLiteralMatching:aMatchPattern
+ "return true if the receiver or recursively any array element in the
+ receiver is symbolic and matches aMatchPattern (i.e. a deep search)"
+
+ self literalsDo: [ :el |
+ (el isSymbol and:[ aMatchPattern match: el]) ifTrue:[^true].
+ el class == Array ifTrue:[
+ (el refersToLiteralMatching: aMatchPattern) ifTrue: [^true]
+ ]
+ ].
+ ^ false
+
+ "
+ (CompiledCode compiledMethodAt:#refersToLiteralMatching:) refersToLiteral:'is*'
+ (CompiledCode compiledMethodAt:#refersToLiteralMatching:) refersToLiteral:'foo*'
+ "
+
+ "Modified: / 03-03-1998 / 00:02:28 / stefan"
+ "Modified: / 18-08-2000 / 21:17:47 / cg"
+ "Created: / 26-07-2012 / 15:37:23 / cg"
! !
!CompiledCode class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/CompiledCode.st,v 1.115 2012/06/01 21:36:35 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/CompiledCode.st,v 1.116 2012/07/26 14:05:24 cg Exp $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/CompiledCode.st,v 1.115 2012/06/01 21:36:35 cg Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/CompiledCode.st,v 1.116 2012/07/26 14:05:24 cg Exp §'
!
version_SVN
- ^ '$Id: CompiledCode.st 10814 2012-06-05 13:35:12Z vranyj1 $'
+ ^ '$Id: CompiledCode.st 10844 2012-09-07 16:24:32Z vranyj1 $'
! !
--- a/Context.st Fri Sep 07 13:46:06 2012 +0100
+++ b/Context.st Fri Sep 07 17:24:32 2012 +0100
@@ -1527,10 +1527,20 @@
"Modified: / 07-03-2012 / 13:09:17 / cg"
!
-displayString
- "return a string describing the context - for display in Inspector"
-
- ^ self class name , '(' , self printString , ')'
+displayOn:aGCOrStream
+ "return a string to display the receiver - for display in Inspector"
+
+ "/ what a kludge - Dolphin and Squeak mean: printOn: a stream;
+ "/ ST/X (and some old ST80's) mean: draw-yourself on a GC.
+ (aGCOrStream isStream) ifFalse:[
+ ^ super displayOn:aGCOrStream
+ ].
+
+ aGCOrStream
+ nextPutAll:self class name;
+ nextPut:$(.
+ self printOn:aGCOrStream.
+ aGCOrStream nextPut:$).
!
fullPrintAllOn:aStream
@@ -1681,11 +1691,11 @@
aStream normal.
aStream space.
(method notNil and:[method isWrapped]) ifTrue:[
- aStream nextPutAll:'W '
+ aStream nextPutAll:'(wrapped) '
].
aStream nextPutAll:' ['; nextPutAll:self lineNumber printString; nextPutAll:']' .
- "Modified: / 20-07-2012 / 14:33:13 / cg"
+ "Modified: / 05-08-2012 / 12:00:00 / cg"
!
receiverPrintString
@@ -2441,11 +2451,11 @@
!Context class methodsFor:'documentation'!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/Context.st,v 1.172 2012/07/20 12:47:39 cg Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/Context.st,v 1.174 2012/08/05 16:22:41 cg Exp §'
!
version_SVN
- ^ '$Id: Context.st 10829 2012-07-25 08:45:15Z vranyj1 $'
+ ^ '$Id: Context.st 10844 2012-09-07 16:24:32Z vranyj1 $'
! !
Context initialize!
--- a/Date.st Fri Sep 07 13:46:06 2012 +0100
+++ b/Date.st Fri Sep 07 17:24:32 2012 +0100
@@ -798,7 +798,6 @@
"
! !
-
!Date class methodsFor:'change & update'!
update:something with:aParameter from:changedObject
@@ -1623,7 +1622,6 @@
"
! !
-
!Date methodsFor:'Compatibility-ANSI'!
dayOfWeek
@@ -2410,6 +2408,86 @@
"
!
+addMonths:numberOfMonths
+ "
+ Return a new instance which added numberOfMonths to self months. Keep the day of month if possible.
+ If the month of the new instance has fewer days than self dayOfMonth set the day to the last
+ day of the new instance's month.
+ Does (probably) not work correct for resulting dates before calendar reform.
+ "
+ |yearToAdd years monthsInYear tempDate newMonth newMonthAsDate|
+
+ yearToAdd := 0.
+ years := numberOfMonths // 12.
+ monthsInYear := numberOfMonths \\ 12.
+ tempDate := self addYears:years.
+
+ newMonth := tempDate month + monthsInYear.
+ (newMonth between:1 and:12) ifFalse:[
+ newMonth := newMonth \\ 12.
+ yearToAdd := 1.
+ ].
+
+ newMonthAsDate := self class
+ newDay:1
+ month:newMonth
+ year:(tempDate year + yearToAdd).
+
+ ^ self class
+ newDay:(newMonthAsDate daysInMonth min:tempDate day)
+ month:newMonth
+ year:(tempDate year + yearToAdd)
+
+ "Created: / 23-08-2012 / 11:04:17 / sr"
+ "Created: / 24-08-2012 / 12:14:52 / anwild"
+!
+
+addMonthsUsingEncoding:numberOfMonths
+ "
+ Return a new instance which added numberOfMonths to self months. Keep the day of month if possible.
+ If the month of the new instance has fewer days than self dayOfMonth set the day to the last
+ day of the new instance's month.
+ Does (probably) not work correct for resulting dates before calendar reform.
+ "
+ | newEncoding |
+ newEncoding := dateEncoding
+ + ((numberOfMonths + self month) // 12 * 10000) "the new year"
+ + ((((numberOfMonths \\ 12) + self month) \\ 12) * 100) "the new month"
+ - (self month * 100) "in the line above the new month is already completely calculated. So subtract the current month"
+ - self day "in the line below the new day is already completely calculated. So subtract the current day"
+ + (self day min: self daysInMonth). "the new day considering the maximum number of days in the new month."
+ ^ Date newDay: newEncoding \\ 100 month: (newEncoding // 100 \\ 100) year: newEncoding // 10000.
+
+ "Created: / 24-08-2012 / 15:18:44 / anwild"
+!
+
+addYears:numberOfYears
+ "
+ Return a new instance which added numberOfYears to self. Take care about leap years.
+ "
+ |newYear newDay|
+
+ newYear := self year + numberOfYears.
+
+ (self day = 29 and:[self month == 2]) ifTrue:[
+ (self class leapYear:newYear) ifTrue: [
+ newDay := self day.
+ ] ifFalse: [
+ newDay := 28.
+ ].
+ ] ifFalse: [
+ newDay := self day.
+ ].
+
+ ^ self class
+ newDay:newDay
+ month:self month
+ year:newYear
+
+ "Created: / 23-08-2012 / 11:05:04 / sr"
+ "Created: / 24-08-2012 / 12:14:09 / anwild"
+!
+
daysSince:aDate
"return the number of days between the receiver and the argument,
aDate, which should be some kind of date"
@@ -2628,7 +2706,6 @@
"
! !
-
!Date methodsFor:'obsolete'!
asAbsoluteTime
@@ -2699,7 +2776,6 @@
^ self addDays:days
! !
-
!Date methodsFor:'printing & storing'!
addPrintBindingsTo:aDictionary
@@ -3057,18 +3133,15 @@
!Date class methodsFor:'documentation'!
version
- ^ '§Header: /cvs/stx/stx/libbasic/Date.st,v 1.140 2011/09/28 13:56:45 cg Exp §'
+ ^ '$Header: /cvs/stx/stx/libbasic/Date.st,v 1.141 2012/08/29 14:24:55 sr Exp $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/Date.st,v 1.140 2011/09/28 13:56:45 cg Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/Date.st,v 1.141 2012/08/29 14:24:55 sr Exp §'
!
version_SVN
- ^ '$Id: Date.st 10761 2012-01-19 11:46:00Z vranyj1 $'
+ ^ '$Id: Date.st 10844 2012-09-07 16:24:32Z vranyj1 $'
! !
Date initialize!
-
-
-
--- a/Dictionary.st Fri Sep 07 13:46:06 2012 +0100
+++ b/Dictionary.st Fri Sep 07 17:24:32 2012 +0100
@@ -18,13 +18,6 @@
category:'Collections-Unordered'
!
-Object subclass:#NilKey
- instanceVariableNames:''
- classVariableNames:'TheOneAndOnlyInstance'
- poolDictionaries:''
- privateIn:Dictionary
-!
-
!Dictionary class methodsFor:'documentation'!
copyright
@@ -134,24 +127,6 @@
"
! !
-!Dictionary class methodsFor:'initialization'!
-
-initialize
- "initialize the NilKey singleton"
-
- NilKey isNil ifTrue:[
- NilKey := Dictionary::NilKey new
- ].
-
- "
- Dictionary initialize
- "
-
-
-
-
-! !
-
!Dictionary class methodsFor:'instance creation'!
decodeFromLiteralArray:anArray
@@ -257,7 +232,6 @@
^ self = aDictionary
! !
-
!Dictionary methodsFor:'accessing'!
associationAt:aKey
@@ -292,22 +266,22 @@
!
at:aKey ifAbsent:exceptionBlock
- "return the element indexed by aKey -
+ "return the element indexed by aKey -
return result of exceptionBlock if no element is stored under aKey"
|index k|
(k := aKey) isNil ifTrue:[
- "/ nil is not allowed as key
- "/
- "/ previous versions of ST/X raised an error
- "/ here. However, there seem to exist applications
- "/ which depend on getting the exceptionBlocks value
- "/ in this case ... well ...
- "/ ^ self errorInvalidKey:aKey
+ "/ nil is not allowed as key
+ "/
+ "/ previous versions of ST/X raised an error
+ "/ here. However, there seem to exist applications
+ "/ which depend on getting the exceptionBlocks value
+ "/ in this case ... well ...
+ "/ ^ self errorInvalidKey:aKey
"/ no longer invalid.
"/ ^ exceptionBlock value
- k := NilKey
+ k := NilEntry
].
"/ I could have written:
@@ -317,7 +291,7 @@
index := self find:k ifAbsent:0.
index ~~ 0 ifTrue:[
- ^ valueArray basicAt:index
+ ^ valueArray basicAt:index
].
^ exceptionBlock value.
!
@@ -327,19 +301,19 @@
if not present, store the result of evaluating valueBlock
under aKey and return it.
WARNING: do not add elements while iterating over the receiver.
- Iterate over a copy to do this."
+ Iterate over a copy to do this."
|index "{ Class: SmallInteger }"
k newValue|
(k := aKey) isNil ifTrue:[
- k := NilKey
+ k := NilEntry
].
index := self findKeyOrNil:k.
(keyArray basicAt:index) notNil ifTrue:[
- "/ already present
- ^ valueArray at:index.
+ "/ already present
+ ^ valueArray at:index.
].
"/ a new one
newValue := valueBlock value.
@@ -379,19 +353,19 @@
"add the argument anObject under key, aKey to the receiver.
Return anObject (sigh).
WARNING: do not add elements while iterating over the receiver.
- Iterate over a copy to do this."
+ Iterate over a copy to do this."
|k index "{ Class: SmallInteger }"|
(k := aKey) isNil ifTrue:[
- k := NilKey
+ k := NilEntry
].
index := self findKeyOrNil:k.
(keyArray basicAt:index) notNil ifTrue:[
- "/ key already present
- valueArray basicAt:index put:anObject.
- ^ anObject
+ "/ key already present
+ valueArray basicAt:index put:anObject.
+ ^ anObject
].
"/ a new key
keyArray basicAt:index put:k.
@@ -435,29 +409,29 @@
!
keyAtEqualValue:aValue ifAbsent:exceptionBlock
- "return the key whose value is equal (i.e. using #= for compare)
+ "return the key whose value is equal (i.e. using #= for compare)
to the argument, if not found, return the value of exceptionBlock.
This is a slow access, since there is no fast reverse mapping.
NOTICE:
- The value is searched using equality compare;
- use #keyAtValue:ifAbsent: to compare for identity."
+ The value is searched using equality compare;
+ use #keyAtValue:ifAbsent: to compare for identity."
|idx k|
idx := 0.
[true] whileTrue:[
- idx := valueArray indexOf:aValue startingAt:idx+1.
- idx == 0 ifTrue:[
- ^ exceptionBlock value
- ].
- (k := keyArray at:idx) notNil ifTrue:[
- k ~~ DeletedEntry ifTrue:[
- k == NilKey ifTrue:[
- ^ nil
- ].
- ^ k
- ].
- ].
+ idx := valueArray indexOf:aValue startingAt:idx+1.
+ idx == 0 ifTrue:[
+ ^ exceptionBlock value
+ ].
+ (k := keyArray at:idx) notNil ifTrue:[
+ k ~~ DeletedEntry ifTrue:[
+ k == NilEntry ifTrue:[
+ ^ nil
+ ].
+ ^ k
+ ].
+ ].
].
"/ NOT REACHED
!
@@ -474,29 +448,29 @@
!
keyAtIdentityValue:aValue ifAbsent:exceptionBlock
- "return the key whose value is identical (i.e. using #== for compare)
+ "return the key whose value is identical (i.e. using #== for compare)
to the argument, if not found, return the value of exceptionBlock.
This is a slow access, since there is no fast reverse mapping.
NOTICE:
- The value is searched using identity compare;
- use #keyAtEqualValue:ifAbsent: to compare for equality."
+ The value is searched using identity compare;
+ use #keyAtEqualValue:ifAbsent: to compare for equality."
|idx k|
idx := 0.
[true] whileTrue:[
- idx := valueArray identityIndexOf:aValue startingAt:idx+1.
- idx == 0 ifTrue:[
- ^ exceptionBlock value
- ].
- (k := keyArray at:idx) notNil ifTrue:[
- k ~~ DeletedEntry ifTrue:[
- k == NilKey ifTrue:[
- ^ nil
- ].
- ^ k
- ].
- ].
+ idx := valueArray identityIndexOf:aValue startingAt:idx+1.
+ idx == 0 ifTrue:[
+ ^ exceptionBlock value
+ ].
+ (k := keyArray at:idx) notNil ifTrue:[
+ k ~~ DeletedEntry ifTrue:[
+ k == NilEntry ifTrue:[
+ ^ nil
+ ].
+ ^ k
+ ].
+ ].
].
"/ NOT REACHED
!
@@ -529,11 +503,10 @@
|keySet|
keySet := self emptyCollectionForKeys.
- keyArray do:[:key |
+ keyArray do:[:key |
(key notNil and:[key ~~ DeletedEntry]) ifTrue:[
- key == NilKey ifTrue:[
- "No, Set does not accept nil as an element!!"
-"/ keySet add:nil
+ key == NilEntry ifTrue:[
+ keySet add:nil
] ifFalse:[
keySet add:key
]
@@ -765,20 +738,20 @@
removeKey:aKey ifAbsent:aBlock
"remove the association under aKey from the collection,
return the value previously stored there..
- If it was not in the collection return the result
+ If it was not in the collection return the result
from evaluating aBlock.
WARNING: do not remove elements while iterating over the receiver.
- See #saveRemoveKey: to do this."
+ See #saveRemoveKey: to do this."
|index "{ Class:SmallInteger }"
- "/ next "{ Class:SmallInteger }"
+ "/ next "{ Class:SmallInteger }"
oldValue k|
(k := aKey) isNil ifTrue:[
"/ no longer invalid
"/ ^ self errorInvalidKey:aKey
- k := NilKey
+ k := NilEntry
].
"/ below, I could have written:
@@ -796,7 +769,7 @@
tally := tally - 1.
tally == 0 ifTrue:[
- self setTally:0
+ self setTally:0
] ifFalse:[
"/ index == keyArray basicSize ifTrue:[
"/ next := 1
@@ -806,7 +779,7 @@
"/ (keyArray basicAt:next) notNil ifTrue:[
"/ keyArray basicAt:index put:DeletedEntry
"/ ].
- self emptyCheck
+ self emptyCheck
].
^ oldValue
@@ -851,42 +824,42 @@
therefore be slow for big dictionaries.
WARNING: do not remove elements while iterating over the receiver.
- See #saveRemoveValue: to do this."
+ See #saveRemoveValue: to do this."
- |next "{ Class:SmallInteger }"
+ |next "{ Class:SmallInteger }"
oldKey|
keyArray keysAndValuesDo:[:index :aKey |
- |idx "{Class:SmallInteger}"|
+ |idx "{Class:SmallInteger}"|
- (aKey notNil and:[aKey ~~ DeletedEntry]) ifTrue:[
- idx := index.
- (self compareSame:(valueArray at:idx) with:aValue) ifTrue:[
- "found it"
- valueArray basicAt:idx put:nil.
- oldKey := keyArray basicAt:idx.
- oldKey == NilKey ifTrue:[
- oldKey := nil
- ].
- keyArray basicAt:idx put:nil.
- tally := tally - 1.
- tally == 0 ifTrue:[
- self setTally:0.
- ^ oldKey
- ].
+ (aKey notNil and:[aKey ~~ DeletedEntry]) ifTrue:[
+ idx := index.
+ (self compareSame:(valueArray at:idx) with:aValue) ifTrue:[
+ "found it"
+ valueArray basicAt:idx put:nil.
+ oldKey := keyArray basicAt:idx.
+ oldKey == NilEntry ifTrue:[
+ oldKey := nil
+ ].
+ keyArray basicAt:idx put:nil.
+ tally := tally - 1.
+ tally == 0 ifTrue:[
+ self setTally:0.
+ ^ oldKey
+ ].
- idx == keyArray basicSize ifTrue:[
- next := 1
- ] ifFalse:[
- next := index + 1.
- ].
- (keyArray basicAt:next) notNil ifTrue:[
- keyArray basicAt:idx put:DeletedEntry
- ].
- self emptyCheck.
- ^ oldKey
- ]
- ]
+ idx == keyArray basicSize ifTrue:[
+ next := 1
+ ] ifFalse:[
+ next := index + 1.
+ ].
+ (keyArray basicAt:next) notNil ifTrue:[
+ keyArray basicAt:idx put:DeletedEntry
+ ].
+ self emptyCheck.
+ ^ oldKey
+ ]
+ ]
].
^ aBlock value
@@ -904,15 +877,15 @@
which is not possible if #removeKey: is used.
WARNING: since no resizing is done, the physical amount of memory used
- by the container remains the same, although the logical size shrinks.
- You may want to manually resize the receiver using #emptyCheck."
+ by the container remains the same, although the logical size shrinks.
+ You may want to manually resize the receiver using #emptyCheck."
|index "{ Class:SmallInteger }"
- next "{ Class:SmallInteger }"
+ next "{ Class:SmallInteger }"
oldValue k|
(k := aKey) isNil ifTrue:[
- k := NilKey
+ k := NilEntry
].
"/ aKey isNil ifTrue:[^ nil].
@@ -926,59 +899,59 @@
tally := tally - 1.
tally ~~ 0 ifTrue:[
- index == keyArray basicSize ifTrue:[
- next := 1
- ] ifFalse:[
- next := index + 1.
- ].
- (keyArray basicAt:next) notNil ifTrue:[
- keyArray basicAt:index put:DeletedEntry
- ].
+ index == keyArray basicSize ifTrue:[
+ next := 1
+ ] ifFalse:[
+ next := index + 1.
+ ].
+ (keyArray basicAt:next) notNil ifTrue:[
+ keyArray basicAt:index put:DeletedEntry
+ ].
].
^ oldValue
"does NOT work:
- |d|
+ |d|
- d := Dictionary new.
- d at:'one' put:1.
- d at:'two' put:2.
- d at:'three' put:3.
- d at:'four' put:4.
- d at:'five' put:5.
- d at:'six' put:6.
- d at:'seven' put:7.
- d at:'eight' put:8.
- d at:'nine' put:9.
- d keysAndValuesDo:[:k :v |
- v odd ifTrue:[
- d removeKey:k
- ]
- ].
- d inspect
+ d := Dictionary new.
+ d at:'one' put:1.
+ d at:'two' put:2.
+ d at:'three' put:3.
+ d at:'four' put:4.
+ d at:'five' put:5.
+ d at:'six' put:6.
+ d at:'seven' put:7.
+ d at:'eight' put:8.
+ d at:'nine' put:9.
+ d keysAndValuesDo:[:k :v |
+ v odd ifTrue:[
+ d removeKey:k
+ ]
+ ].
+ d inspect
"
"DOES work:
- |d|
+ |d|
- d := Dictionary new.
- d at:'one' put:1.
- d at:'two' put:2.
- d at:'three' put:3.
- d at:'four' put:4.
- d at:'five' put:5.
- d at:'six' put:6.
- d at:'seven' put:7.
- d at:'eight' put:8.
- d at:'nine' put:9.
- d keysAndValuesDo:[:k :v |
- v odd ifTrue:[
- d saveRemoveKey:k
- ]
- ].
- d inspect
+ d := Dictionary new.
+ d at:'one' put:1.
+ d at:'two' put:2.
+ d at:'three' put:3.
+ d at:'four' put:4.
+ d at:'five' put:5.
+ d at:'six' put:6.
+ d at:'seven' put:7.
+ d at:'eight' put:8.
+ d at:'nine' put:9.
+ d keysAndValuesDo:[:k :v |
+ v odd ifTrue:[
+ d saveRemoveKey:k
+ ]
+ ].
+ d inspect
"
"Created: 1.3.1996 / 21:14:42 / cg"
@@ -998,84 +971,84 @@
which is not possible if #removeValue: is used.
WARNING: since no resizing is done, the physical amount of memory used
- by the container remains the same, although the logical size shrinks.
- You may want to manually resize the receiver using #emptyCheck."
+ by the container remains the same, although the logical size shrinks.
+ You may want to manually resize the receiver using #emptyCheck."
- |next "{ Class:SmallInteger }"
+ |next "{ Class:SmallInteger }"
oldKey|
keyArray keysAndValuesDo:[:index :aKey |
- |idx "{Class:SmallInteger}"|
+ |idx "{Class:SmallInteger}"|
- (aKey notNil and:[aKey ~~ DeletedEntry]) ifTrue:[
- idx := index.
- (self compareSame:(valueArray at:idx) with:aValue) ifTrue:[
- "found it"
- valueArray basicAt:idx put:nil.
- oldKey := keyArray basicAt:idx.
- oldKey == NilKey ifTrue:[
- oldKey := nil
- ].
- keyArray basicAt:idx put:nil.
- tally := tally - 1.
- tally ~~ 0 ifTrue:[
- idx == keyArray basicSize ifTrue:[
- next := 1
- ] ifFalse:[
- next := index + 1.
- ].
- (keyArray basicAt:next) notNil ifTrue:[
- keyArray basicAt:idx put:DeletedEntry
- ].
- ].
- ^ oldKey
- ]
- ]
+ (aKey notNil and:[aKey ~~ DeletedEntry]) ifTrue:[
+ idx := index.
+ (self compareSame:(valueArray at:idx) with:aValue) ifTrue:[
+ "found it"
+ valueArray basicAt:idx put:nil.
+ oldKey := keyArray basicAt:idx.
+ oldKey == NilEntry ifTrue:[
+ oldKey := nil
+ ].
+ keyArray basicAt:idx put:nil.
+ tally := tally - 1.
+ tally ~~ 0 ifTrue:[
+ idx == keyArray basicSize ifTrue:[
+ next := 1
+ ] ifFalse:[
+ next := index + 1.
+ ].
+ (keyArray basicAt:next) notNil ifTrue:[
+ keyArray basicAt:idx put:DeletedEntry
+ ].
+ ].
+ ^ oldKey
+ ]
+ ]
].
^ aValue
"does NOT work:
- |d|
+ |d|
- d := Dictionary new.
- d at:'one' put:1.
- d at:'two' put:2.
- d at:'three' put:3.
- d at:'four' put:4.
- d at:'five' put:5.
- d at:'six' put:6.
- d at:'seven' put:7.
- d at:'eight' put:8.
- d at:'nine' put:9.
- d keysAndValuesDo:[:k :v |
- v odd ifTrue:[
- d removeValue:v ifAbsent:nil
- ]
- ].
- d inspect
+ d := Dictionary new.
+ d at:'one' put:1.
+ d at:'two' put:2.
+ d at:'three' put:3.
+ d at:'four' put:4.
+ d at:'five' put:5.
+ d at:'six' put:6.
+ d at:'seven' put:7.
+ d at:'eight' put:8.
+ d at:'nine' put:9.
+ d keysAndValuesDo:[:k :v |
+ v odd ifTrue:[
+ d removeValue:v ifAbsent:nil
+ ]
+ ].
+ d inspect
"
"DOES work:
- |d|
+ |d|
- d := Dictionary new.
- d at:'one' put:1.
- d at:'two' put:2.
- d at:'three' put:3.
- d at:'four' put:4.
- d at:'five' put:5.
- d at:'six' put:6.
- d at:'seven' put:7.
- d at:'eight' put:8.
- d at:'nine' put:9.
- d keysAndValuesDo:[:k :v |
- v odd ifTrue:[
- d saveRemoveValue:v
- ]
- ].
- d inspect
+ d := Dictionary new.
+ d at:'one' put:1.
+ d at:'two' put:2.
+ d at:'three' put:3.
+ d at:'four' put:4.
+ d at:'five' put:5.
+ d at:'six' put:6.
+ d at:'seven' put:7.
+ d at:'eight' put:8.
+ d at:'nine' put:9.
+ d keysAndValuesDo:[:k :v |
+ v odd ifTrue:[
+ d saveRemoveValue:v
+ ]
+ ].
+ d inspect
"
"Created: 1.3.1996 / 21:17:10 / cg"
@@ -1157,6 +1130,27 @@
^ self
!
+associationsOrderedBy:aCollectionOfKeys
+ "return an OrderedCollection of my key-value pairs, ordered by the given key list"
+
+ self assert:(aCollectionOfKeys size == self size).
+ ^ aCollectionOfKeys collect:[:eachKey | eachKey -> (self at:eachKey) ] as: OrderedCollection
+
+ "
+ |d|
+
+ d := Dictionary new.
+ d at:'zzz' put:3.
+ d at:'aaa' put:1.
+ d at:'eee' put:2.
+ d.
+ d valuesOrderedBy:#('aaa' 'eee' 'zzz').
+ d associationsOrderedBy:#('aaa' 'eee' 'zzz').
+ "
+
+ "Created: / 31-07-2012 / 17:32:34 / cg"
+!
+
fromLiteralArrayEncoding:encoding
"read my values from an encoding.
The encoding is supposed to be of the form:
@@ -1199,6 +1193,15 @@
dict at:'fasel' put:#[1 2 3 4].
dict literalArrayEncoding
"
+!
+
+valuesOrderedBy:aCollectionOfKeys
+ "return an OrderedCollection of my values, ordered by the given key list"
+
+ self assert:(aCollectionOfKeys size == self size).
+ ^ aCollectionOfKeys collect:[:eachKey | self at:eachKey ] as: OrderedCollection
+
+ "Created: / 31-07-2012 / 17:33:12 / cg"
! !
!Dictionary methodsFor:'copying'!
@@ -1302,29 +1305,29 @@
"perform the block for all associations in the collection.
See also:
- #do: (which passes values to its block)
- #keysDo: (which passes only keys to its block)
- #keysAndValuesDo: (which passes keys&values)
+ #do: (which passes values to its block)
+ #keysDo: (which passes only keys to its block)
+ #keysAndValuesDo: (which passes keys&values)
This is much like #keysAndValuesDo:, but aBlock gets the
key and value as a single association argument.
#keysAndValuesDo: and is a bit faster therefore (no intermediate objects).
WARNING: do not add/remove elements while iterating over the receiver.
- Iterate over a copy to do this."
+ Iterate over a copy to do this."
|key n "{ Class: SmallInteger }"|
tally == 0 ifTrue:[^ self].
n := keyArray basicSize.
1 to:n do:[:index |
- key := keyArray basicAt:index.
- (key notNil and:[key ~~ DeletedEntry]) ifTrue:[
- key == NilKey ifTrue:[
- key := nil
- ].
- aBlock value:(Association key:key value:(valueArray basicAt:index))
- ]
+ key := keyArray basicAt:index.
+ (key notNil and:[key ~~ DeletedEntry]) ifTrue:[
+ key == NilEntry ifTrue:[
+ key := nil
+ ].
+ aBlock value:(Association key:key value:(valueArray basicAt:index))
+ ]
]
"Modified: 20.4.1996 / 11:31:39 / cg"
@@ -1334,16 +1337,16 @@
"perform the block for all associations in the collection.
See also:
- #do: (which passes values to its block)
- #keysDo: (which passes only keys to its block)
- #keysAndValuesDo: (which passes keys&values)
+ #do: (which passes values to its block)
+ #keysDo: (which passes only keys to its block)
+ #keysAndValuesDo: (which passes keys&values)
This is much like #keysAndValuesDo:, but aBlock gets the
key and value as a single association argument.
#keysAndValuesDo: and is a bit faster therefore (no intermediate objects).
WARNING: do not add/remove elements while iterating over the receiver.
- Iterate over a copy to do this."
+ Iterate over a copy to do this."
|key n "{ Class: SmallInteger }"
first|
@@ -1353,18 +1356,18 @@
first := true.
n := keyArray basicSize.
1 to:n do:[:index |
- key := keyArray basicAt:index.
- (key notNil and:[key ~~ DeletedEntry]) ifTrue:[
- key == NilKey ifTrue:[
- key := nil
- ].
- first ifTrue:[
- first := false.
- ] ifFalse:[
- sepBlock value
- ].
- aBlock value:(Association key:key value:(valueArray basicAt:index))
- ]
+ key := keyArray basicAt:index.
+ (key notNil and:[key ~~ DeletedEntry]) ifTrue:[
+ key == NilEntry ifTrue:[
+ key := nil
+ ].
+ first ifTrue:[
+ first := false.
+ ] ifFalse:[
+ sepBlock value
+ ].
+ aBlock value:(Association key:key value:(valueArray basicAt:index))
+ ]
]
"Modified: / 20-04-1996 / 11:31:39 / cg"
@@ -1477,16 +1480,16 @@
passing both key and element as arguments.
See also:
- #associationsDo: (which passes keys->value pairs)
- #do: (which only passes values)
- #keysDo: (which only passes keys)
+ #associationsDo: (which passes keys->value pairs)
+ #do: (which only passes values)
+ #keysDo: (which only passes keys)
This is much like #associationsDo:, but aBlock gets the
key and value as two separate arguments.
#associationsDo: is a bit slower.
WARNING: do not add/remove elements while iterating over the receiver.
- Iterate over a copy to do this."
+ Iterate over a copy to do this."
|key n "{ Class: SmallInteger }"
deletedEntry|
@@ -1495,13 +1498,13 @@
n := keyArray basicSize.
deletedEntry := DeletedEntry.
1 to:n do:[:index |
- key := keyArray basicAt:index.
- (key notNil and:[key ~~ deletedEntry]) ifTrue:[
- key == NilKey ifTrue:[
- key := nil
- ].
- aTwoArgBlock value:key value:(valueArray basicAt:index)
- ].
+ key := keyArray basicAt:index.
+ (key notNil and:[key ~~ deletedEntry]) ifTrue:[
+ key == NilEntry ifTrue:[
+ key := nil
+ ].
+ aTwoArgBlock value:key value:(valueArray basicAt:index)
+ ].
]
"Modified: 20.4.1996 / 11:33:42 / cg"
@@ -1554,25 +1557,25 @@
"evaluate the argument, aBlock for every key in the collection.
See also:
- #associationsDo: (which passes key-value associations)
- #keysAndValuesDo: (which passes keys & values separately)
- #do: (which passes values only)
+ #associationsDo: (which passes key-value associations)
+ #keysAndValuesDo: (which passes keys & values separately)
+ #do: (which passes values only)
WARNING: do not add/remove elements while iterating over the receiver.
- Iterate over a copy to do this."
+ Iterate over a copy to do this."
|sz "{ Class: SmallInteger }"
key|
sz := keyArray size.
1 to:sz do:[:index |
- key := keyArray at:index.
- (key notNil and:[key ~~ DeletedEntry]) ifTrue:[
- key == NilKey ifTrue:[
- key := nil
- ].
- aBlock value:key
- ]
+ key := keyArray at:index.
+ (key notNil and:[key ~~ DeletedEntry]) ifTrue:[
+ key == NilEntry ifTrue:[
+ key := nil
+ ].
+ aBlock value:key
+ ]
]
"Modified: / 24-08-2010 / 10:13:58 / cg"
@@ -1659,7 +1662,6 @@
^ self do:aBlock
! !
-
!Dictionary methodsFor:'printing & storing'!
printElementsDo:aBlock
@@ -1983,7 +1985,7 @@
includesKey:aKey
"return true, if the argument, aKey is a key in the receiver"
- ^ (self find:(aKey ? NilKey) ifAbsent:0) ~~ 0
+ ^ (self find:(aKey ? NilEntry) ifAbsent:0) ~~ 0
"Modified: / 17-08-2006 / 21:06:41 / cg"
!
@@ -2048,32 +2050,16 @@
^ aVisitor visitDictionary:self with:aParameter
! !
-!Dictionary::NilKey class methodsFor:'instance creation'!
-
-basicNew
- TheOneAndOnlyInstance isNil ifTrue:[
- TheOneAndOnlyInstance := super basicNew
- ].
- ^ TheOneAndOnlyInstance
-
-
-! !
-
!Dictionary class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Dictionary.st,v 1.105 2012/07/20 12:54:17 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Dictionary.st,v 1.108 2012/08/14 07:05:43 stefan Exp $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/Dictionary.st,v 1.105 2012/07/20 12:54:17 cg Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/Dictionary.st,v 1.108 2012/08/14 07:05:43 stefan Exp §'
!
version_SVN
- ^ '$Id: Dictionary.st 10829 2012-07-25 08:45:15Z vranyj1 $'
+ ^ '$Id: Dictionary.st 10844 2012-09-07 16:24:32Z vranyj1 $'
! !
-
-Dictionary initialize!
-
-
-
--- a/EncodedStream.st Fri Sep 07 13:46:06 2012 +0100
+++ b/EncodedStream.st Fri Sep 07 17:24:32 2012 +0100
@@ -1,6 +1,6 @@
"
COPYRIGHT (c) 2004 by eXept Software AG
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -23,7 +23,7 @@
copyright
"
COPYRIGHT (c) 2004 by eXept Software AG
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -46,17 +46,17 @@
|encoding decoder decodedStream|
aStream isPositionable ifTrue:[
- encoding := CharacterEncoder guessEncodingOfStream:aStream.
- (encoding notNil
- and:[ encoding ~= #'iso8859-1'
- and:[ encoding ~= #'ascii' ]]) ifTrue:[
- decoder := CharacterEncoder encoderFor:encoding.
- ].
+ encoding := CharacterEncoder guessEncodingOfStream:aStream.
+ (encoding notNil
+ and:[ encoding ~= #'iso8859-1'
+ and:[ encoding ~= #'ascii' ]]) ifTrue:[
+ decoder := CharacterEncoder encoderFor:encoding.
+ ].
].
decoder isNil ifTrue:[
- "/ setup for no-encoding; allows for a later switch to a real encoder,
- "/ whenever an encoding pragma is encountered later.
- decoder := CharacterEncoder nullEncoderInstance.
+ "/ setup for no-encoding; allows for a later switch to a real encoder,
+ "/ whenever an encoding pragma is encountered later.
+ decoder := CharacterEncoder nullEncoderInstance.
].
decodedStream := self stream:aStream encoder:decoder.
decodedStream skipEncodingChunk.
@@ -88,7 +88,7 @@
"if our base stream hat a pathname, delegate..."
stream isNil ifTrue:[
- ^ nil.
+ ^ nil.
].
^ stream pathName.
!
@@ -118,10 +118,10 @@
contents
^String streamContents:
- [:s|
- [ stream atEnd ] whileFalse:
- [s nextPut: stream next]
- ]
+ [:s|
+ [ stream atEnd ] whileFalse:
+ [s nextPut: stream next]
+ ]
"Created: / 25-02-2010 / 23:34:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
@@ -230,9 +230,11 @@
!
size
+ "not correct, but probably better than 0"
+
^ stream size
- "Created: / 11-02-2012 / 20:12:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Created: / 31-08-2012 / 16:52:40 / cg"
!
skip: anInteger
@@ -253,14 +255,14 @@
|pos chunk token|
stream isPositionable ifFalse:[
- ^ self
+ ^ self
].
pos := self position.
chunk := self nextChunk.
[
- "/ if this is a valid chunk (i.e. not a comment or encoding-directive),
- "/ then position back, so it will be processed as usual.
+ "/ if this is a valid chunk (i.e. not a comment or encoding-directive),
+ "/ then position back, so it will be processed as usual.
"/ We could parse here, but this is overkill, since we are only interested in the fact,
"/ that there is anything else than a comment in the chunk.
"/ result := (Parser for:chunk)
@@ -268,19 +270,19 @@
"/ ignoreWarnings:true;
"/ parseMethodBody.
- token := (Scanner for:chunk)
- ignoreErrors:true;
- ignoreWarnings:true;
- nextToken.
+ token := (Scanner for:chunk)
+ ignoreErrors:true;
+ ignoreWarnings:true;
+ nextToken.
- token ~= #EOF ifTrue:[
- self position:pos
- ].
+ token ~= #EOF ifTrue:[
+ self position:pos
+ ].
] on:Parser parseWarningSignal do:[:ex|
- "really ignore any error.
- Even setting ignorError will output diagnostics here
- during standalone startup when debugging"
- ex proceedWith:#ignore.
+ "really ignore any error.
+ Even setting ignorError will output diagnostics here
+ during standalone startup when debugging"
+ ex proceedWith:#ignore.
].
"Modified: / 29-07-2011 / 17:42:11 / cg"
@@ -289,13 +291,13 @@
!EncodedStream class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/EncodedStream.st,v 1.25 2012/04/05 10:01:32 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/EncodedStream.st,v 1.26 2012/08/31 18:01:03 cg Exp $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/EncodedStream.st,v 1.25 2012/04/05 10:01:32 stefan Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/EncodedStream.st,v 1.26 2012/08/31 18:01:03 cg Exp §'
!
version_SVN
- ^ '$Id: EncodedStream.st 10804 2012-04-13 13:18:13Z vranyj1 $'
+ ^ '$Id: EncodedStream.st 10844 2012-09-07 16:24:32Z vranyj1 $'
! !
--- a/ExecutableFunction.st Fri Sep 07 13:46:06 2012 +0100
+++ b/ExecutableFunction.st Fri Sep 07 17:24:32 2012 +0100
@@ -377,6 +377,18 @@
"Modified: / 18.8.2000 / 21:18:03 / cg"
!
+refersToLiteralMatching:aMatchPattern
+ "return true if the receiver or recursively any array element in the
+ receiver is symbolic and matches aMatchPattern (i.e. a deep search).
+ Return false (we dont know) here, to allow alien code objects to be
+ handled by the browsers."
+
+ ^ false
+
+ "Modified: / 18-08-2000 / 21:18:03 / cg"
+ "Created: / 26-07-2012 / 15:38:26 / cg"
+!
+
resources
^ nil
@@ -404,15 +416,15 @@
!ExecutableFunction class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/ExecutableFunction.st,v 1.56 2010/04/27 10:26:12 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ExecutableFunction.st,v 1.57 2012/07/26 14:34:24 cg Exp $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/ExecutableFunction.st,v 1.56 2010/04/27 10:26:12 cg Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/ExecutableFunction.st,v 1.57 2012/07/26 14:34:24 cg Exp §'
!
version_SVN
- ^ '$Id: ExecutableFunction.st 10761 2012-01-19 11:46:00Z vranyj1 $'
+ ^ '$Id: ExecutableFunction.st 10844 2012-09-07 16:24:32Z vranyj1 $'
! !
--- a/FileDirectory.st Fri Sep 07 13:46:06 2012 +0100
+++ b/FileDirectory.st Fri Sep 07 17:24:32 2012 +0100
@@ -295,21 +295,6 @@
^ self files
!
-fileNamesMatching:pattern
- "Same as directoryContants, but returns only files
- that match the given pattern.
- This uses String>>matches: for glob pattern matching"
-
- | names |
-
- names := self asFilename directoryContents.
- names isNil ifTrue:[^ nil].
- ^ names select: [:e | e matches: pattern].
-
- "Created: / 12-09-2010 / 18:41:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Modified (format): / 18-11-2011 / 14:45:42 / cg"
-!
-
forceNewFileNamed:fn
"Squeak/ST80 compatibility"
@@ -598,7 +583,7 @@
aStream close
! !
-!FileDirectory methodsFor:'more instance creation'!
+!FileDirectory methodsFor:'instance creation'!
directoryNamed:aName
"create & return a new fileDirectory for a subdirectory in myself"
@@ -832,19 +817,15 @@
!FileDirectory class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/FileDirectory.st,v 1.52 2011/11/24 17:29:22 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/FileDirectory.st,v 1.53 2012/08/31 17:57:10 cg Exp $'
!
version_CVS
- ^ 'Header: /cvs/stx/stx/libbasic/FileDirectory.st,v 1.52 2011/11/24 17:29:22 cg Exp '
+ ^ '§Header: /cvs/stx/stx/libbasic/FileDirectory.st,v 1.53 2012/08/31 17:57:10 cg Exp §'
!
version_SVN
- ^ '$Id: FileDirectory.st 10761 2012-01-19 11:46:00Z vranyj1 $'
+ ^ '$Id: FileDirectory.st 10844 2012-09-07 16:24:32Z vranyj1 $'
! !
FileDirectory initialize!
-
-
-
-
--- a/Filename.st Fri Sep 07 13:46:06 2012 +0100
+++ b/Filename.st Fri Sep 07 17:24:32 2012 +0100
@@ -5533,9 +5533,10 @@
!Filename methodsFor:'suffixes'!
addSuffix:aSuffix
- "return a new filename for the receivers name with a different suffix.
- If the name already has a suffix, the new suffix replaces it;
- otherwise, the new suffix is simply appended to the name."
+ "return a new filename for the receivers name with a additional suffix.
+ The new suffix is simply appended to the name,
+ regardless whether there is already an existing suffix.
+ See also #withSuffix:"
|prefixName|
@@ -5874,15 +5875,15 @@
!Filename class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Filename.st,v 1.377 2012/07/21 10:35:55 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Filename.st,v 1.378 2012/08/10 10:49:56 stefan Exp $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/Filename.st,v 1.377 2012/07/21 10:35:55 cg Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/Filename.st,v 1.378 2012/08/10 10:49:56 stefan Exp §'
!
version_SVN
- ^ '$Id: Filename.st 10829 2012-07-25 08:45:15Z vranyj1 $'
+ ^ '$Id: Filename.st 10844 2012-09-07 16:24:32Z vranyj1 $'
! !
Filename initialize!
--- a/Float.st Fri Sep 07 13:46:06 2012 +0100
+++ b/Float.st Fri Sep 07 17:24:32 2012 +0100
@@ -690,6 +690,7 @@
^ 2 "must be careful here, whenever ST/X is used on VAX or a 370"
! !
+
!Float methodsFor:'arithmetic'!
* aNumber
@@ -1473,6 +1474,7 @@
"Modified: / 16.11.2001 / 14:14:43 / cg"
! !
+
!Float methodsFor:'printing & storing'!
printString
@@ -1879,6 +1881,7 @@
"
! !
+
!Float methodsFor:'testing'!
isFinite
@@ -2775,15 +2778,15 @@
!Float class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Float.st,v 1.179 2012/04/17 20:36:48 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Float.st,v 1.180 2012/08/03 20:25:37 stefan Exp $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/Float.st,v 1.179 2012/04/17 20:36:48 stefan Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/Float.st,v 1.180 2012/08/03 20:25:37 stefan Exp §'
!
version_SVN
- ^ '$Id: Float.st 10807 2012-05-05 21:58:24Z vranyj1 $'
+ ^ '$Id: Float.st 10844 2012-09-07 16:24:32Z vranyj1 $'
! !
Float initialize!
--- a/Integer.st Fri Sep 07 13:46:06 2012 +0100
+++ b/Integer.st Fri Sep 07 17:24:32 2012 +0100
@@ -3468,15 +3468,22 @@
!
-displayString
- "return a string for displaying in a view (as in inspector).
+displayOn:aGCOrStream
+ "return a string to display the receiver.
The output radix is usually 10, but can be changed by setting
DefaultDisplayRadix (see Integer>>displayRadix:)"
+ "/ what a kludge - Dolphin and Squeak mean: printOn: a stream;
+ "/ ST/X (and some old ST80's) mean: draw-yourself on a GC.
+ (aGCOrStream isStream) ifFalse:[
+ ^ super displayOn:aGCOrStream
+ ].
+
(DefaultDisplayRadix isNil or:[DefaultDisplayRadix == 10]) ifTrue:[
- ^ self printString
+ self printOn:aGCOrStream
+ ] ifFalse:[
+ self printOn:aGCOrStream base:DefaultDisplayRadix showRadix:true.
].
- ^ self radixPrintStringRadix:DefaultDisplayRadix
"
Integer displayRadix:16. 12345
@@ -4820,15 +4827,15 @@
!Integer class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Integer.st,v 1.265 2012/07/06 16:33:28 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Integer.st,v 1.266 2012/08/03 15:54:07 stefan Exp $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/Integer.st,v 1.265 2012/07/06 16:33:28 stefan Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/Integer.st,v 1.266 2012/08/03 15:54:07 stefan Exp §'
!
version_SVN
- ^ '$Id: Integer.st 10824 2012-07-18 16:55:48Z vranyj1 $'
+ ^ '$Id: Integer.st 10844 2012-09-07 16:24:32Z vranyj1 $'
! !
Integer initialize!
--- a/InterestConverter.st Fri Sep 07 13:46:06 2012 +0100
+++ b/InterestConverter.st Fri Sep 07 17:24:32 2012 +0100
@@ -202,8 +202,28 @@
!InterestConverter methodsFor:'printing'!
-displayString
- ^ self className , '(sending ' , selector storeString , ' to ' , destination printString , ')'
+displayOn:aGCOrStream
+ "Compatibility
+ append a printed desription on some stream (Dolphin, Squeak)
+ OR:
+ display the receiver in a graphicsContext at 0@0 (ST80).
+ This method allows for any object to be displayed in some view
+ (although the fallBack is to display its printString ...)"
+
+ "/ what a kludge - Dolphin and Squeak mean: printOn: a stream;
+ "/ ST/X (and some old ST80's) mean: draw-yourself on a GC.
+ aGCOrStream isStream ifFalse:[
+ ^ super displayOn:aGCOrStream.
+ ].
+
+ aGCOrStream
+ nextPutAll:self class name;
+ nextPutAll:'(sending '.
+
+ selector storeOn:aGCOrStream.
+ aGCOrStream nextPutAll:' to '.
+ destination printOn:aGCOrStream.
+ aGCOrStream nextPut:$).
! !
!InterestConverter methodsFor:'testing'!
@@ -215,11 +235,11 @@
!InterestConverter class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/InterestConverter.st,v 1.15 2009/05/28 06:01:29 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/InterestConverter.st,v 1.16 2012/08/03 15:52:54 stefan Exp $'
!
version_SVN
- ^ '$Id: InterestConverter.st 10761 2012-01-19 11:46:00Z vranyj1 $'
+ ^ '$Id: InterestConverter.st 10844 2012-09-07 16:24:32Z vranyj1 $'
! !
--- a/LibraryDefinition.st Fri Sep 07 13:46:06 2012 +0100
+++ b/LibraryDefinition.st Fri Sep 07 17:24:32 2012 +0100
@@ -270,7 +270,7 @@
'# $','Header','$
#
# DO NOT EDIT
-# automagically generated from the projectDefinition: ',self name,"JV@2012-04-12: Commented, it only generates new unnecessary revisions -->' at ',Timestamp now printString,"'.
+# automagically generated from the projectDefinition: ',self name",' at ',Timestamp now printString",'.
#
# Warning: once you modify this file, do not rerun
# stmkmp or projectDefinition-build again - otherwise, your changes are lost.
@@ -331,7 +331,7 @@
"Created: / 09-08-2006 / 11:44:20 / fm"
"Modified: / 09-08-2006 / 19:59:32 / fm"
- "Modified: / 20-01-2012 / 12:18:24 / cg"
+ "Modified: / 26-07-2012 / 00:57:20 / cg"
!
extensionLine_libInit_dot_cc
@@ -391,7 +391,7 @@
'# $','Header','$
#
# DO NOT EDIT
-# automagically generated from the projectDefinition: ',self name,"JV@2012-04-12: Commented, it only generates new unnecessary revisions -->' at ',Timestamp now printString,"'.
+# automagically generated from the projectDefinition: ',self name",' at ',Timestamp now printString",'.
#
# Warning: once you modify this file, do not rerun
# stmkmp or projectDefinition-build again - otherwise, your changes are lost.
@@ -515,7 +515,7 @@
"Created: / 08-08-2006 / 20:45:36 / fm"
"Modified: / 09-08-2006 / 16:50:23 / fm"
"Modified: / 24-06-2009 / 21:39:29 / Jan Vrany <vranyj1@fel.cvut.cz>"
- "Modified: / 08-10-2011 / 00:47:53 / cg"
+ "Modified: / 26-07-2012 / 00:57:29 / cg"
!
vc_dot_def
@@ -702,18 +702,13 @@
!LibraryDefinition class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/LibraryDefinition.st,v 1.108 2012/01/24 17:35:50 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/LibraryDefinition.st,v 1.109 2012/07/25 23:03:19 cg Exp $'
!
version_CVS
- ^ 'Header: /cvs/stx/stx/libbasic/LibraryDefinition.st,v 1.108 2012/01/24 17:35:50 cg Exp '
+ ^ '§Header: /cvs/stx/stx/libbasic/LibraryDefinition.st,v 1.109 2012/07/25 23:03:19 cg Exp §'
!
version_SVN
- ^ '$Id: LibraryDefinition.st 10802 2012-04-12 23:04:07Z vranyj1 $'
+ ^ '$Id: LibraryDefinition.st 10844 2012-09-07 16:24:32Z vranyj1 $'
! !
-
-
-
-
-
--- a/Make.proto Fri Sep 07 13:46:06 2012 +0100
+++ b/Make.proto Fri Sep 07 17:24:32 2012 +0100
@@ -63,7 +63,7 @@
all:: preMake classLibRule postMake
-pre_objs::
+pre_objs::
@@ -78,7 +78,7 @@
echo -n exported > .svnversion; \
fi
-stx_libbasic.o: stx_libbasic.st .svnversion
+stx_libbasic.o: stx_libbasic.st .svnversion
@if [ -d .svn ]; then \
rev2="$(shell printf "%-16s" $$(cat .svnversion))"; \
echo " [SV] Expanding svnRevisionNo in $1.st"; \
@@ -87,7 +87,7 @@
$(MAKE) CC="$(CLASSLIB_CC)" OPT="$(OPT)" SEPINITCODE="$(SEPINITCODE)" STC="$(STC)" STFILE=.stx_libbasic.svn $(C_RULE);
sed -i -e "s/\".stx_libbasic.svn.st\");/\"\stx_libbasic.st\");/g" .stx_libbasic.svn.c
$(MAKE) .stx_libbasic.svn.$(O)
- @mv .stx_libbasic.svn.$(O) stx_libbasic.$(O)
+ @mv .stx_libbasic.svn.$(O) stx_libbasic.$(O)
endif
@@ -445,6 +445,7 @@
$(OUTDIR)UnixOperatingSystem.$(O) UnixOperatingSystem.$(H): UnixOperatingSystem.st $(INCLUDE_TOP)/stx/libbasic/AbstractOperatingSystem.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic/OSFileHandle.$(H) $(INCLUDE_TOP)/stx/libbasic/OSHandle.$(H) $(INCLUDE_TOP)/stx/libbasic/ExternalAddress.$(H) $(STCHDR)
$(OUTDIR)XDGDesktop.$(O) XDGDesktop.$(H): XDGDesktop.st $(INCLUDE_TOP)/stx/libbasic/UnixDesktop.$(H) $(INCLUDE_TOP)/stx/libbasic/AbstractDesktop.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)GNOMEDesktop.$(O) GNOMEDesktop.$(H): GNOMEDesktop.st $(INCLUDE_TOP)/stx/libbasic/XDGDesktop.$(H) $(INCLUDE_TOP)/stx/libbasic/UnixDesktop.$(H) $(INCLUDE_TOP)/stx/libbasic/AbstractDesktop.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)MethodWithBreakpoints.$(O) MethodWithBreakpoints.$(H): MethodWithBreakpoints.st $(INCLUDE_TOP)/stx/libbasic/Method.$(H) $(INCLUDE_TOP)/stx/libbasic/CompiledCode.$(H) $(INCLUDE_TOP)/stx/libbasic/ExecutableFunction.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+
# ENDMAKEDEPEND --- do not remove this line
-
--- a/Make.spec Fri Sep 07 13:46:06 2012 +0100
+++ b/Make.spec Fri Sep 07 17:24:32 2012 +0100
@@ -376,6 +376,8 @@
FileDoesNotExistException \
MiniLogger \
PolymorphicInlineCache \
+ MethodWithBreakpoints \
+
WIN32_CLASSES= \
Win32Process \
@@ -716,6 +718,8 @@
$(OUTDIR)FileDoesNotExistException.$(O) \
$(OUTDIR)MiniLogger.$(O) \
$(OUTDIR)PolymorphicInlineCache.$(O) \
+ $(OUTDIR)MethodWithBreakpoints.$(O) \
+
WIN32_OBJS= \
$(OUTDIR)Win32Process.$(O) \
@@ -725,6 +729,3 @@
$(OUTDIR)Win32FILEHandle.$(O) \
$(OUTDIR)Win32Constants.$(O) \
$(OUTDIR)Win32OperatingSystem.$(O) \
-
-
-
--- a/Message.st Fri Sep 07 13:46:06 2012 +0100
+++ b/Message.st Fri Sep 07 17:24:32 2012 +0100
@@ -219,12 +219,25 @@
!Message methodsFor:'printing & storing'!
-displayString
- "return a string for display in inspectors etc."
+displayOn:aGCOrStream
+ "Compatibility
+ append a printed desription on some stream (Dolphin, Squeak)
+ OR:
+ display the receiver in a graphicsContext at 0@0 (ST80).
+ This method allows for any object to be displayed in some view
+ (although the fallBack is to display its printString ...)"
- ^ self class name , '(' , selector printString , ')'
+ "/ what a kludge - Dolphin and Squeak mean: printOn: a stream;
+ "/ ST/X (and some old ST80's) mean: draw-yourself on a GC.
+ aGCOrStream isStream ifFalse:[
+ ^ super displayOn:aGCOrStream.
+ ].
- "Modified: 28.10.1996 / 17:04:29 / cg"
+ aGCOrStream
+ nextPutAll:self class name;
+ nextPut:$(.
+ selector storeOn:aGCOrStream.
+ aGCOrStream nextPut:$)
!
printOn:aStream
@@ -258,11 +271,11 @@
!Message class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Message.st,v 1.33 2007/05/31 15:51:35 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Message.st,v 1.34 2012/08/03 15:52:57 stefan Exp $'
!
version_SVN
- ^ '$Id: Message.st 10761 2012-01-19 11:46:00Z vranyj1 $'
+ ^ '$Id: Message.st 10844 2012-09-07 16:24:32Z vranyj1 $'
! !
--- a/MessageSend.st Fri Sep 07 13:46:06 2012 +0100
+++ b/MessageSend.st Fri Sep 07 17:24:32 2012 +0100
@@ -269,10 +269,27 @@
!MessageSend methodsFor:'printing & storing'!
-displayString
- "return a string for display in inspectors etc."
+displayOn:aGCOrStream
+ "Compatibility
+ append a printed desription on some stream (Dolphin, Squeak)
+ OR:
+ display the receiver in a graphicsContext at 0@0 (ST80).
+ This method allows for any object to be displayed in some view
+ (although the fallBack is to display its printString ...)"
- ^ self class name , '(' , receiver displayString , '>>' , selector , ')'
+ "/ what a kludge - Dolphin and Squeak mean: printOn: a stream;
+ "/ ST/X (and some old ST80's) mean: draw-yourself on a GC.
+ aGCOrStream isStream ifFalse:[
+ ^ super displayOn:aGCOrStream.
+ ].
+
+ aGCOrStream
+ nextPutAll:self class name;
+ nextPut:$(.
+ receiver displayOn:aGCOrStream.
+ aGCOrStream nextPutAll:'>>'.
+ selector storeOn:aGCOrStream.
+ aGCOrStream nextPut:$)
!
printOn:aStream
@@ -289,15 +306,15 @@
!MessageSend class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/MessageSend.st,v 1.23 2010/12/22 12:50:41 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/MessageSend.st,v 1.24 2012/08/03 15:53:30 stefan Exp $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/MessageSend.st,v 1.23 2010/12/22 12:50:41 cg Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/MessageSend.st,v 1.24 2012/08/03 15:53:30 stefan Exp §'
!
version_SVN
- ^ '$Id: MessageSend.st 10761 2012-01-19 11:46:00Z vranyj1 $'
+ ^ '$Id: MessageSend.st 10844 2012-09-07 16:24:32Z vranyj1 $'
! !
--- a/Method.st Fri Sep 07 13:46:06 2012 +0100
+++ b/Method.st Fri Sep 07 17:24:32 2012 +0100
@@ -11,7 +11,7 @@
"
"{ Package: 'stx:libbasic' }"
-CompiledCode variableSubclass:#Method
+CompiledCode subclass:#Method
instanceVariableNames:'source sourcePosition category package mclass lookupObject
annotations'
classVariableNames:'PrivateMethodSignal LastFileReference LastSourceFileName
@@ -219,7 +219,6 @@
^ PrivateMethodSignal
! !
-
!Method class methodsFor:'cleanup'!
lowSpaceCleanup
@@ -414,20 +413,19 @@
^ self sends:aSelectorSymbol
! !
-
!Method methodsFor:'accessing'!
annotateWith: annotation
-
| index |
+
index := self annotationIndexOf: annotation key.
- index
- ifNil:
- [annotations := annotations
- ifNil:[Array with: annotation]
- ifNotNil:[annotations copyWith:annotation]]
- ifNotNil:
- [annotations at: index put: annotation].
+ index isNil ifTrue:[
+ annotations := annotations isNil
+ ifTrue:[Array with: annotation]
+ ifFalse:[annotations copyWith:annotation]
+ ] ifFalse:[
+ annotations at: index put: annotation
+ ].
"/ annotation annotatesMethod: self.
"
@@ -438,10 +436,10 @@
"Created: / 19-05-2010 / 16:20:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 20-05-2010 / 11:22:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified (format): / 26-07-2012 / 15:47:51 / cg"
!
annotationAt: key
-
| index |
index := self annotationIndexOf: key.
@@ -455,19 +453,21 @@
"Created: / 19-05-2010 / 16:16:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 02-07-2010 / 22:35:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 18-11-2011 / 14:46:21 / cg"
+ "Modified (format): / 26-07-2012 / 15:47:54 / cg"
!
annotations
- "Returns annotations"
+ "Returns the annotations (or an empty collection)"
annotations isNil ifTrue:[^#()].
"iterate over annotation array to
trigger lazy-loading"
- self annotationsDo:[:ignored].
+ self annotationsDo:[:ignored | ].
^ annotations
"Modified: / 11-07-2010 / 19:25:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 18-11-2011 / 14:46:56 / cg"
+ "Modified (comment): / 26-07-2012 / 15:50:26 / cg"
!
annotations: anObject
@@ -484,46 +484,50 @@
annotationsAt: key
- ^OrderedCollection streamContents:
- [:annotStream|
- self annotationsAt: key do:
- [:annot|annotStream nextPut: annot]]
+ ^OrderedCollection
+ streamContents:[:annotStream|
+ self annotationsAt: key do: [:annot| annotStream nextPut: annot]
+ ]
"Created: / 16-07-2010 / 11:41:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified (format): / 26-07-2012 / 15:46:56 / cg"
!
annotationsAt: key do: block
-
| annots |
+
annots := OrderedCollection new: 1.
- self annotationsDo:
- [:annot|
- annot key == key ifTrue:
- [block value: annot]]
+ self annotationsDo: [:annot|
+ annot key == key ifTrue:[block value: annot]
+ ]
"Created: / 16-07-2010 / 11:48:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified (format): / 26-07-2012 / 15:48:37 / cg"
!
annotationsAt: key1 orAt: key2
- ^OrderedCollection streamContents:
- [:annotStream|
- self annotationsAt: key1 orAt: key2 do:
- [:annot|annotStream nextPut: annot]]
+ ^OrderedCollection
+ streamContents:[:annotStream|
+ self annotationsAt: key1 orAt: key2 do: [:annot|annotStream nextPut: annot]
+ ]
"Created: / 16-07-2010 / 11:41:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified (format): / 26-07-2012 / 15:49:11 / cg"
!
annotationsAt: key1 orAt: key2 do: block
-
| annots |
+
annots := OrderedCollection new: 1.
- self annotationsDo:
- [:annot|
- (annot key == key1 or:[annot key == key2]) ifTrue:
- [block value: annot]]
+ self annotationsDo:[:annot |
+ (annot key == key1 or:[annot key == key2]) ifTrue:[
+ block value: annot
+ ]
+ ]
"Created: / 16-07-2010 / 11:47:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified (format): / 26-07-2012 / 15:49:30 / cg"
!
annotationsDo: aBlock
@@ -668,7 +672,6 @@
!
nameSpace
-
"Returns my namespace or nil. If no explicit method namespace
is set, my programmming language is used as default namespace
(for compatibility reasons, for smalltalk methods nil is returned,
@@ -676,6 +679,7 @@
"
| nsA lang |
+
nsA := self annotationAt: #namespace:.
nsA ifNotNil:[^nsA nameSpace].
@@ -691,14 +695,16 @@
"Created: / 26-04-2010 / 16:30:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 20-05-2010 / 09:38:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified (format): / 27-07-2012 / 14:17:09 / cg"
!
nameSpace: aNameSpace
- self annotateWith: (Annotation namespace: aNameSpace name)
+ self annotateWith: (Annotation nameSpace: aNameSpace name)
"Created: / 20-05-2010 / 10:05:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 20-05-2010 / 11:30:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 26-07-2012 / 23:08:48 / cg"
!
nameSpaceName
@@ -971,7 +977,6 @@
"Modified: 16.1.1997 / 01:28:25 / cg"
! !
-
!Method methodsFor:'accessing-visibility'!
isIgnored
@@ -1442,7 +1447,6 @@
^ temporaryMethod
! !
-
!Method methodsFor:'copying'!
copy
@@ -1859,7 +1863,6 @@
"Modified: 4.11.1996 / 22:58:28 / cg"
! !
-
!Method methodsFor:'printing & storing'!
printOn:aStream
@@ -1936,10 +1939,8 @@
!Method methodsFor:'private'!
annotationAtIndex: index
-
- "return annotation at given index.
- any raw annotation array is lazily
- initialized"
+ "return the annotation at given index.
+ any raw annotation array is lazily initialized"
| annotationOrArray annotation args |
@@ -1964,11 +1965,11 @@
"Created: / 02-07-2010 / 22:30:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 11-07-2010 / 19:39:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 18-11-2011 / 14:46:27 / cg"
+ "Modified (comment): / 26-07-2012 / 15:48:07 / cg"
!
annotationIndexOf: key
-
- "Returns index of annotation with given key
+ "Returns the index of annotation with given key
or nil if there is no such annotation"
annotations isNil ifTrue:[^nil].
@@ -1982,7 +1983,7 @@
"Created: / 19-05-2010 / 16:40:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 11-07-2010 / 19:23:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Modified (format): / 18-11-2011 / 14:46:45 / cg"
+ "Modified (comment): / 26-07-2012 / 15:48:14 / cg"
!
cacheSourceStream:aStream
@@ -2003,11 +2004,11 @@
!
getAnnotations
-
^annotations
"Created: / 10-07-2010 / 21:55:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 11-07-2010 / 19:30:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified (format): / 26-07-2012 / 15:49:38 / cg"
!
getLookupObject
@@ -2456,22 +2457,21 @@
!
hasAnnotation
- "Return true iff method has any annotation"
+ "Return true iff the method has any annotation"
^annotations notNil
"Created: / 11-07-2010 / 19:27:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Modified (format): / 07-09-2011 / 10:10:35 / cg"
+ "Modified (comment): / 26-07-2012 / 15:49:59 / cg"
!
hasAnnotation: key
-
- "Return true iff method is annotated with
- given key"
+ "Return true iff the method is annotated with the given key"
^(self annotationIndexOf: key) notNil
"Created: / 11-07-2010 / 19:28:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified (comment): / 26-07-2012 / 15:49:54 / cg"
!
hasAnyResource:aCollectionOfSymbols
@@ -2666,6 +2666,14 @@
^ true
!
+isMethodWithBreakpoints
+ "only redefined in MethodWithBreakpoints"
+
+ ^ false
+
+ "Created: / 01-08-2012 / 17:26:43 / cg"
+!
+
isOLECall
"return true, if the method is an ole call; false if not."
@@ -2963,6 +2971,7 @@
"/ is very common with the new browser's info displays, we cache a few
"/ of them. If the same is parsed soon after, we do not have to parse again.
LastParseTreeCache notNil ifTrue:[
+ "/ to flush: LastParseTreeCache removeAll.
cachedInfo := LastParseTreeCache at:self ifAbsent:nil.
cachedInfo notNil ifTrue:[
cachedInfo parserClass == parserClass ifTrue:[
@@ -2994,7 +3003,7 @@
"
"Modified: / 01-03-2012 / 14:30:50 / cg"
- "Modified (comment): / 06-03-2012 / 15:46:59 / cg"
+ "Modified (format): / 27-07-2012 / 18:32:58 / cg"
!
parseAnnotations
@@ -3045,28 +3054,34 @@
!
previousVersion
- "return the receivers previous versions source code"
-
- |sel cls previous|
-
- sel := self selector.
- sel isNil ifTrue:[ ^ nil ].
-
- cls := self mclass.
- cls isNil ifTrue:[ ^ nil ].
-
- ChangeSet current reverseDo:[:change |
- (change isMethodChange
- and:[ (change selector == sel)
- and:[ change changeClass == cls ]])
- ifTrue:[
- previous := change previousVersion.
- previous notNil ifTrue:[
- ^ previous
- ]
- ]
- ].
- ^ nil.
+ "return the receivers previous version's source code"
+
+ |previous|
+
+ previous := self previousVersions:2.
+ previous isEmptyOrNil ifTrue:[^ nil].
+ ^ previous first.
+
+"/ |sel cls previous|
+"/
+"/ sel := self selector.
+"/ sel isNil ifTrue:[ ^ nil ].
+"/
+"/ cls := self mclass.
+"/ cls isNil ifTrue:[ ^ nil ].
+"/
+"/ ChangeSet current reverseDo:[:change |
+"/ (change isMethodChange
+"/ and:[ (change selector == sel)
+"/ and:[ change changeClass == cls ]])
+"/ ifTrue:[
+"/ previous := change previousVersion.
+"/ previous notNil ifTrue:[
+"/ ^ previous
+"/ ]
+"/ ]
+"/ ].
+"/ ^ nil.
"/ history := Class methodHistory.
"/ history isNil ifTrue:[^ nil].
@@ -3086,7 +3101,7 @@
"/ ^ entry second.
"/ ^ history at:self ifAbsent:nil
- "Modified: 7.11.1996 / 19:06:22 / cg"
+ "Modified: / 26-07-2012 / 13:16:34 / cg"
!
previousVersionCode
@@ -3101,7 +3116,16 @@
!
previousVersions
- "return a collection of the receivers previous versions (sources)"
+ "return a collection of the receiver's previous versions (sources)"
+
+ ^ self previousVersions:nil
+
+ "Modified (comment): / 26-07-2012 / 12:04:15 / cg"
+!
+
+previousVersions:count
+ "return a collection of the receiver's count previous versions (sources).
+ A nil count will retrieve all versions"
|sel cls versions lastChange firstSrc last|
@@ -3114,12 +3138,15 @@
versions := OrderedCollection new.
ChangeSet current reverseDo:[:change |
- (change isMethodChange
- and:[ (change selector == sel)
- and:[ change changeClass == cls ]])
+ (change isMethodChange
+ and:[ (change selector == sel)
+ and:[ change changeClass == cls ]])
ifTrue:[
versions addFirst:change.
lastChange := change.
+ (count notNil and:[versions size == count]) ifTrue:[
+ ^ versions
+ ]
]
].
@@ -3138,6 +3165,12 @@
]
].
^ versions
+
+ "
+ (Method compiledMethodAt:#previousVersions:) previousVersions:nil
+ "
+
+ "Created: / 26-07-2012 / 11:59:57 / cg"
!
readsField:instVarIndex
@@ -3165,6 +3198,40 @@
"Created: / 23-07-2012 / 11:15:56 / cg"
!
+refersToLiteral: anObject
+ "redefined to search in annotations"
+
+ (super refersToLiteral: anObject) ifTrue:[^ true].
+
+ annotations notNil ifTrue:[
+ self annotationsDo:[:annot |
+ (annot refersToLiteral: anObject) ifTrue:[
+ self halt.
+ ^ true
+ ].
+ ].
+ ].
+ ^ false
+
+ "Created: / 26-07-2012 / 15:51:14 / cg"
+!
+
+refersToLiteralMatching: aMatchString
+ (super refersToLiteralMatching: aMatchString) ifTrue:[^ true].
+
+ annotations notNil ifTrue:[
+ self annotationsDo:[:annot |
+ (annot refersToLiteralMatching: aMatchString) ifTrue:[
+ self halt.
+ ^ true
+ ].
+ ].
+ ].
+ ^ false
+
+ "Created: / 26-07-2012 / 15:51:36 / cg"
+!
+
resourceType
"ST-80 compatibility:
return the methods first resource specs key.
@@ -3486,7 +3553,6 @@
"Created: / 23-07-2012 / 11:16:36 / cg"
! !
-
!Method methodsFor:'trap methods'!
makeInvalid
@@ -3723,15 +3789,15 @@
!Method class methodsFor:'documentation'!
version
- ^ '$Id: Method.st 10842 2012-09-07 10:49:18Z vranyj1 $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Method.st,v 1.394 2012/08/02 12:23:16 cg Exp $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/Method.st,v 1.388 2012/07/23 09:17:47 cg Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/Method.st,v 1.394 2012/08/02 12:23:16 cg Exp §'
!
version_SVN
- ^ '$Id:: Method.st 10842 2012-09-07 10:49:18Z vranyj1 $'
+ ^ '$ Id: Method.st 10648 2011-06-23 15:55:10Z vranyj1 $'
! !
Method initialize!
--- a/NameSpace.st Fri Sep 07 13:46:06 2012 +0100
+++ b/NameSpace.st Fri Sep 07 17:24:32 2012 +0100
@@ -593,17 +593,30 @@
!NameSpace class methodsFor:'printing & storing'!
-displayString
+displayOn:aGCOrStream
+ "Compatibility
+ append a printed desription on some stream (Dolphin, Squeak)
+ OR:
+ display the receiver in a graphicsContext at 0@0 (ST80).
+ This method allows for any object to be displayed in some view
+ (although the fallBack is to display its printString ...)"
+
+ "/ what a kludge - Dolphin and Squeak mean: printOn: a stream;
+ "/ ST/X (and some old ST80's) mean: draw-yourself on a GC.
+ aGCOrStream isStream ifFalse:[
+ ^ super displayOn:aGCOrStream.
+ ].
+
"return a printed represenation - here, a reminder is appended,
that this is not a regular class"
self == NameSpace ifTrue:[
- ^ super displayString
+ super displayOn:aGCOrStream.
+ ] ifFalse:[
+ aGCOrStream
+ nextPutAll:self name;
+ nextPutAll:' (* NameSpace *)'.
].
- ^ self name , ' (* NameSpace *)'
-
- "Created: 8.11.1996 / 21:37:24 / cg"
- "Modified: 20.12.1996 / 15:11:31 / cg"
! !
!NameSpace class methodsFor:'private'!
@@ -721,9 +734,9 @@
!NameSpace class methodsFor:'documentation'!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/NameSpace.st,v 1.73 2012/03/23 10:56:21 cg Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/NameSpace.st,v 1.74 2012/08/03 15:52:51 stefan Exp §'
!
version_SVN
- ^ '$Id: NameSpace.st 10804 2012-04-13 13:18:13Z vranyj1 $'
+ ^ '$Id: NameSpace.st 10844 2012-09-07 16:24:32Z vranyj1 $'
! !
--- a/Object.st Fri Sep 07 13:46:06 2012 +0100
+++ b/Object.st Fri Sep 07 17:24:32 2012 +0100
@@ -525,12 +525,6 @@
"Modified: 23.4.1996 / 16:00:07 / cg"
! !
-
-
-
-
-
-
!Object methodsFor:'Compatibility-Dolphin'!
stbFixup: anSTBInFiler at: newObjectIndex
@@ -553,7 +547,6 @@
self expressInterestIn:anAspect for:anObject sendBack:anAspect
! !
-
!Object methodsFor:'Compatibility-ST/V'!
triggerEvent:aSymbol
@@ -693,7 +686,6 @@
"
! !
-
!Object methodsFor:'accessing'!
_at:index
@@ -1703,8 +1695,6 @@
"Modified: / 18.2.2000 / 11:32:19 / cg"
! !
-
-
!Object methodsFor:'change & update'!
broadcast:aSelectorSymbol
@@ -1894,7 +1884,6 @@
^ self
! !
-
!Object methodsFor:'comparing'!
= anObject
@@ -3492,7 +3481,6 @@
"Modified: / 30.1.1998 / 14:04:01 / cg"
! !
-
!Object methodsFor:'dependents-st/v event simulation'!
removeActionsForEvent:eventName
@@ -3536,7 +3524,7 @@
"/ what a kludge - Dolphin and Squeak mean: printOn: a stream;
"/ ST/X (and some old ST80's) mean: draw-yourself on a GC.
- (aGCOrStream isStream or:[aGCOrStream == Transcript]) ifTrue:[
+ aGCOrStream isStream ifTrue:[
self printOn:aGCOrStream.
^ self
].
@@ -5142,7 +5130,6 @@
"Modified: / 26.7.1999 / 10:58:49 / stefan"
! !
-
!Object methodsFor:'message sending'!
perform:aSelector
@@ -7297,7 +7284,6 @@
^ self
! !
-
!Object methodsFor:'secure message sending'!
?: selector
@@ -7900,7 +7886,6 @@
"
! !
-
!Object methodsFor:'synchronized evaluation'!
freeSynchronizationSemaphore
@@ -9518,15 +9503,15 @@
!Object class methodsFor:'documentation'!
version
- ^ '$Id: Object.st 10838 2012-08-17 17:19:56Z vranyj1 $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Object.st,v 1.695 2012/08/03 18:59:52 stefan Exp $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/Object.st,v 1.691 2012/06/22 14:18:54 stefan Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/Object.st,v 1.695 2012/08/03 18:59:52 stefan Exp §'
!
version_SVN
- ^ '$Id: Object.st 10838 2012-08-17 17:19:56Z vranyj1 $'
+ ^ '$ Id: Object.st 10643 2011-06-08 21:53:07Z vranyj1 $'
! !
Object initialize!
--- a/PackageId.st Fri Sep 07 13:46:06 2012 +0100
+++ b/PackageId.st Fri Sep 07 17:24:32 2012 +0100
@@ -251,12 +251,14 @@
!
pathRelativeToTopDirectory
- ^ (self module asFilename construct:(self directory)) pathName.
+ ^ (self module asFilename construct:(self directory)) name.
"
'stx:libbasic' asPackageId pathRelativeToTopDirectory
'stx:goodies/net/ssl' asPackageId pathRelativeToTopDirectory
"
+
+ "Modified: / 25-07-2012 / 23:02:40 / cg"
!
pathRelativeToTopDirectory:aDirectory
@@ -291,15 +293,15 @@
!PackageId class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/PackageId.st,v 1.18 2011/09/21 16:22:00 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/PackageId.st,v 1.19 2012/07/25 23:15:55 cg Exp $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/PackageId.st,v 1.18 2011/09/21 16:22:00 cg Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/PackageId.st,v 1.19 2012/07/25 23:15:55 cg Exp §'
!
version_SVN
- ^ '$Id: PackageId.st 10761 2012-01-19 11:46:00Z vranyj1 $'
+ ^ '$Id: PackageId.st 10844 2012-09-07 16:24:32Z vranyj1 $'
! !
--- a/PluginSupport.st Fri Sep 07 13:46:06 2012 +0100
+++ b/PluginSupport.st Fri Sep 07 17:24:32 2012 +0100
@@ -91,7 +91,7 @@
view := applicationOrView window.
] ifFalse:[
applicationOrView := anApplicationClass new.
- (applicationOrView isKindOf:View) ifTrue:[
+ applicationOrView isView ifTrue:[
view := applicationOrView
] ifFalse:[
view := applicationOrView window.
@@ -192,9 +192,9 @@
!PluginSupport class methodsFor:'documentation'!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/PluginSupport.st,v 1.15 2011/07/04 13:00:52 cg Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/PluginSupport.st,v 1.16 2012/08/03 20:26:00 stefan Exp §'
!
version_SVN
- ^ '$Id: PluginSupport.st 10700 2011-09-29 15:44:37Z vranyj1 $'
+ ^ '$Id: PluginSupport.st 10844 2012-09-07 16:24:32Z vranyj1 $'
! !
--- a/ProgrammingLanguage.st Fri Sep 07 13:46:06 2012 +0100
+++ b/ProgrammingLanguage.st Fri Sep 07 17:24:32 2012 +0100
@@ -463,7 +463,12 @@
methodTemplate
"return a method definition template string (or nil)"
- ^ nil
+ |w|
+
+ (w := self sourceFileWriterClass) isNil ifTrue:[^ nil].
+ ^ w methodTemplate
+
+ "Modified: / 21-08-2012 / 19:44:41 / cg"
!
parenthesisSpecificationForEditor
@@ -472,6 +477,17 @@
"Created: / 01-06-2012 / 22:52:25 / cg"
!
+versionMethodTemplateForCVS
+ "raise an error: must be redefined in concrete subclass(es)"
+
+ |w|
+
+ (w := self sourceFileWriterClass) isNil ifTrue:[^ nil].
+ ^ w versionMethodTemplateForCVS
+
+ "Modified: / 21-08-2012 / 19:44:51 / cg"
+!
+
writeComment:aStringOrStringCollection on:aStream
"Utility method - writes a comment to a stream,
using proper syntax"
@@ -486,11 +502,11 @@
!ProgrammingLanguage class methodsFor:'documentation'!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/ProgrammingLanguage.st,v 1.17 2012/06/01 21:13:26 cg Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/ProgrammingLanguage.st,v 1.19 2012/08/21 17:51:30 cg Exp §'
!
version_SVN
- ^ '$Id: ProgrammingLanguage.st 10814 2012-06-05 13:35:12Z vranyj1 $'
+ ^ '$Id: ProgrammingLanguage.st 10844 2012-09-07 16:24:32Z vranyj1 $'
! !
ProgrammingLanguage initialize!
--- a/Project.st Fri Sep 07 13:46:06 2012 +0100
+++ b/Project.st Fri Sep 07 17:24:32 2012 +0100
@@ -976,8 +976,25 @@
!Project methodsFor:'printing & storing'!
-displayString
- ^ super displayString , '(''' , (name ? '<unnamed>') , ''')'
+displayOn:aGCOrStream
+ "Compatibility
+ append a printed desription on some stream (Dolphin, Squeak)
+ OR:
+ display the receiver in a graphicsContext at 0@0 (ST80).
+ This method allows for any object to be displayed in some view
+ (although the fallBack is to display its printString ...)"
+
+ "/ what a kludge - Dolphin and Squeak mean: printOn: a stream;
+ "/ ST/X (and some old ST80's) mean: draw-yourself on a GC.
+ aGCOrStream isStream ifFalse:[
+ ^ super displayOn:aGCOrStream.
+ ].
+
+ aGCOrStream
+ nextPutAll:self class name;
+ nextPut:$(;
+ nextPutAll:(name ? '<unnamed>');
+ nextPut:$).
! !
!Project methodsFor:'properties'!
@@ -1617,15 +1634,15 @@
!Project class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Project.st,v 1.208 2009/10/27 09:00:33 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Project.st,v 1.209 2012/08/03 15:53:25 stefan Exp $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/Project.st,v 1.208 2009/10/27 09:00:33 cg Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/Project.st,v 1.209 2012/08/03 15:53:25 stefan Exp §'
!
version_SVN
- ^ '$Id: Project.st 10761 2012-01-19 11:46:00Z vranyj1 $'
+ ^ '$Id: Project.st 10844 2012-09-07 16:24:32Z vranyj1 $'
! !
Project initialize!
--- a/ProjectDefinition.st Fri Sep 07 13:46:06 2012 +0100
+++ b/ProjectDefinition.st Fri Sep 07 17:24:32 2012 +0100
@@ -1067,7 +1067,6 @@
self classNamesAndAttributes:newSpec usingCompiler:compilerOrNil
! !
-
!ProjectDefinition class methodsFor:'accessing - tests'!
excludedFromTestSuite
@@ -1294,77 +1293,77 @@
newSpec := OrderedCollection new.
ignoreOldEntries ifFalse:[
- oldSpec do:[:oldEntry |
- |newEntry className cls |
-
- newEntry := oldEntry copy.
- className := newEntry first.
-
- (ignored includes:className) ifFalse:[
- cls := Smalltalk classNamed:className.
- ignoreOldDefinition ifTrue:[
- (cls notNil and:[cls isLoaded not]) ifTrue:[
- (newEntry includes:#autoload) ifFalse:[
- newEntry := newEntry copyWith:#autoload.
- ].
- ].
- ].
- cls notNil ifTrue:[
- "JV @ 2010-06-19
- Force merge default class attributes with existing ones"
- newEntry := self mergeDefaultClassAttributesFor: cls with: newEntry.
- ].
- newSpec add:newEntry.
- ]
- ].
- ].
+ oldSpec do:[:oldEntry |
+ |newEntry className cls |
+
+ newEntry := oldEntry copy.
+ className := newEntry first.
+
+ (ignored includes:className) ifFalse:[
+ cls := Smalltalk classNamed:className.
+ ignoreOldDefinition ifTrue:[
+ (cls notNil and:[cls isLoaded not]) ifTrue:[
+ (newEntry includes:#autoload) ifFalse:[
+ newEntry := newEntry copyWith:#autoload.
+ ].
+ ].
+ ].
+ cls notNil ifTrue:[
+ "JV @ 2010-06-19
+ Force merge default class attributes with existing ones"
+ newEntry := self mergeDefaultClassAttributesFor: cls with: newEntry.
+ ].
+ newSpec add:newEntry.
+ ]
+ ].
+ ].
self searchForClasses do:[:eachClass |
- |className attributes oldSpecEntry oldAttributes newEntry|
-
- className := eachClass name.
- (ignored includes:className) ifFalse:[
- oldSpecEntry := oldSpec detect:[:entry | entry first = className] ifNone:nil.
-
- (ignoreOldEntries or:[ oldSpecEntry isNil]) ifTrue:[
- (eachClass isLoaded not or:[eachClass isPrivate not]) ifTrue:[
- (self additionalClassNamesAndAttributes includes:className) ifFalse:[
- (oldSpecEntry size > 1) ifTrue:[
- oldAttributes := oldSpecEntry copyFrom:2.
- ].
-
- ignoreOldDefinition ifTrue:[
- "take autoload attribute from classes state in the image"
- oldAttributes notNil ifTrue:[
- attributes := oldAttributes copyWithout:#autoload.
- ] ifFalse:[
- attributes := #()
- ].
- eachClass isLoaded ifFalse:[
- attributes := attributes copyWith:#autoload.
- ].
- ] ifFalse:[
- "keep any existing attribute"
- oldAttributes notNil ifTrue:[
- attributes := oldAttributes.
- ] ifFalse:[
- attributes := eachClass isLoaded ifTrue:[ #() ] ifFalse:[ #(autoload) ].
- ].
- ].
- "JV @ 2010-06-19
- Support fo additional class attributes and programming language attribute"
- attributes := self mergeDefaultClassAttributesFor: eachClass with: attributes.
-
- newEntry := Array with:className.
- attributes notEmptyOrNil ifTrue:[
- newEntry := newEntry , attributes.
- ].
- newSpec add:newEntry
- ]
- ]
- ]
- ]
+ |className attributes oldSpecEntry oldAttributes newEntry|
+
+ className := eachClass name.
+ (ignored includes:className) ifFalse:[
+ oldSpecEntry := oldSpec detect:[:entry | entry first = className] ifNone:nil.
+
+ (ignoreOldEntries or:[ oldSpecEntry isNil]) ifTrue:[
+ (eachClass isLoaded not or:[eachClass isPrivate not]) ifTrue:[
+ (self additionalClassNamesAndAttributes includes:className) ifFalse:[
+ (oldSpecEntry size > 1) ifTrue:[
+ oldAttributes := oldSpecEntry copyFrom:2.
+ ].
+
+ ignoreOldDefinition ifTrue:[
+ "take autoload attribute from classes state in the image"
+ oldAttributes notNil ifTrue:[
+ attributes := oldAttributes copyWithout:#autoload.
+ ] ifFalse:[
+ attributes := #()
+ ].
+ eachClass isLoaded ifFalse:[
+ attributes := attributes copyWith:#autoload.
+ ].
+ ] ifFalse:[
+ "keep any existing attribute"
+ oldAttributes notNil ifTrue:[
+ attributes := oldAttributes.
+ ] ifFalse:[
+ attributes := eachClass isLoaded ifTrue:[ #() ] ifFalse:[ #(autoload) ].
+ ].
+ ].
+ "JV @ 2010-06-19
+ Support fo additional class attributes and programming language attribute"
+ attributes := self mergeDefaultClassAttributesFor: eachClass with: attributes.
+
+ newEntry := Array with:className.
+ attributes notEmptyOrNil ifTrue:[
+ newEntry := newEntry , attributes.
+ ].
+ newSpec add:newEntry
+ ]
+ ]
+ ]
+ ]
].
^ self classNamesAndAttributes_codeFor:newSpec
@@ -2347,7 +2346,6 @@
"Created: / 18-08-2006 / 12:51:38 / cg"
! !
-
!ProjectDefinition class methodsFor:'description - project information'!
applicationAdditionalIconFileNames
@@ -2761,7 +2759,8 @@
'abbrev.stc' #'generate_abbrev_dot_stc'
'bmake.bat' #'generate_bmake_dot_mak' "/ for bcc32
'vcmake.bat' #'generate_vcmake_dot_mak' "/ for msvc
- 'lcmake.bat' #'generate_lcmake_dot_mak' "/ for lcc
+ 'lccmake.bat' #'generate_lccmake_dot_mak' "/ for lcc
+ 'tccmake.bat' #'generate_tccmake_dot_mak' "/ for tcc
).
dict
@@ -2769,8 +2768,7 @@
^ dict.
- "Modified: / 21-12-2010 / 11:02:02 / cg"
- "Modified (comment): / 21-01-2012 / 12:32:45 / cg"
+ "Modified: / 03-09-2012 / 19:48:27 / cg"
!
fileNamesToGenerate
@@ -3014,10 +3012,12 @@
"Created: / 24-02-2011 / 11:38:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
-generate_lcmake_dot_mak
+generate_lccmake_dot_mak
^self replaceMappings: self bmake_dot_mak_mappings
- in: self lcmake_dot_mak
+ in: self lccmake_dot_mak
+
+ "Created: / 03-09-2012 / 19:49:56 / cg"
!
generate_loadAll
@@ -3185,6 +3185,14 @@
"Created: / 24-02-2011 / 22:32:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
+generate_tccmake_dot_mak
+
+ ^self replaceMappings: self bmake_dot_mak_mappings
+ in: self tccmake_dot_mak
+
+ "Created: / 03-09-2012 / 19:50:25 / cg"
+!
+
generate_vc_dot_def
^self replaceMappings: self vc_dot_def_mappings
@@ -3313,13 +3321,14 @@
bmake_dot_mak_mappings
^ (Dictionary new)
- at:'SUBPROJECT_BMAKE_CALLS' put:(self subProjectBmakeCalls);
- at:'SUBPROJECT_VCMAKE_CALLS' put:(self subProjectVCmakeCalls);
- at:'SUBPROJECT_LCMAKE_CALLS' put:(self subProjectLCmakeCalls);
- yourself
+ at:'SUBPROJECT_BMAKE_CALLS' put:(self subProjectBmakeCalls);
+ at:'SUBPROJECT_VCMAKE_CALLS' put:(self subProjectVCmakeCalls);
+ at:'SUBPROJECT_LCCMAKE_CALLS' put:(self subProjectLCCmakeCalls);
+ at:'SUBPROJECT_TCCMAKE_CALLS' put:(self subProjectTCCmakeCalls);
+ yourself
"Created: / 17-08-2006 / 21:41:56 / cg"
- "Modified: / 14-09-2006 / 18:55:33 / cg"
+ "Modified: / 03-09-2012 / 19:48:53 / cg"
!
builder_baseline_dot_rbspec_mappings
@@ -4145,10 +4154,12 @@
^ self subProjectMakeCallsUsing:'call bmake %1 %2'.
!
-subProjectLCmakeCalls
- "generate submake-calls for lc"
-
- ^ self subProjectMakeCallsUsing:'call lcmake %1 %2'.
+subProjectLCCmakeCalls
+ "generate submake-calls for lcc"
+
+ ^ self subProjectMakeCallsUsing:'call lccmake %1 %2'.
+
+ "Created: / 03-09-2012 / 19:49:08 / cg"
!
subProjectMakeCallsUsing:callString
@@ -4168,6 +4179,14 @@
"Modified: / 27-09-2011 / 19:36:12 / cg"
!
+subProjectTCCmakeCalls
+ "generate submake-calls for tcc"
+
+ ^ self subProjectMakeCallsUsing:'call tccmake %1 %2'.
+
+ "Created: / 03-09-2012 / 19:50:53 / cg"
+!
+
subProjectVCmakeCalls
"generate submake-calls for visual-C"
@@ -4351,19 +4370,21 @@
"Modified: / 08-08-2006 / 15:46:05 / fm"
!
-lcmake_dot_mak
- "the template code for the lcmake.bat file"
+lccmake_dot_mak
+ "the template code for the lccmake.bat file"
^
'@REM -------
@REM make using lcc compiler
-@REM type lcmake, and wait...
+@REM type lccmake, and wait...
@REM do not edit - automatically generated from ProjectDefinition
@REM -------
make.exe -N -f bc.mak USELCC=1 %%1 %%2
%(SUBPROJECT_LCCMAKE_CALLS)
'
+
+ "Created: / 03-09-2012 / 19:49:23 / cg"
!
make_dot_proto
@@ -4433,7 +4454,7 @@
"Created: / 08-08-2006 / 19:31:29 / fm"
"Modified: / 09-08-2006 / 15:10:57 / fm"
- "Modified: / 23-12-2011 / 15:07:23 / cg"
+ "Modified: / 26-07-2012 / 00:56:03 / cg"
!
makefile
@@ -4533,6 +4554,23 @@
"Created: / 24-02-2011 / 22:32:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
+tccmake_dot_mak
+ "the template code for the tccmake.bat file"
+
+ ^
+'@REM -------
+@REM make using tcc compiler
+@REM type tccmake, and wait...
+@REM do not edit - automatically generated from ProjectDefinition
+@REM -------
+make.exe -N -f bc.mak USETCC=1 %%1 %%2
+
+%(SUBPROJECT_TCCMAKE_CALLS)
+'
+
+ "Created: / 03-09-2012 / 19:50:41 / cg"
+!
+
vcmake_dot_mak
"the template code for the vcmake.bat file"
@@ -6789,15 +6827,15 @@
!ProjectDefinition class methodsFor:'documentation'!
version
- ^ '$Id: ProjectDefinition.st 10842 2012-09-07 10:49:18Z vranyj1 $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ProjectDefinition.st,v 1.387 2012/09/03 17:55:11 cg Exp $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/ProjectDefinition.st,v 1.385 2012/07/21 16:56:36 cg Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/ProjectDefinition.st,v 1.387 2012/09/03 17:55:11 cg Exp §'
!
version_SVN
- ^ '$Id:: ProjectDefinition.st 10842 2012-09-07 10:49:18Z vranyj1 $'
+ ^ '$ Id: ProjectDefinition.st 10645 2011-06-09 15:28:45Z vranyj1 $'
! !
ProjectDefinition initialize!
--- a/SequenceableCollection.st Fri Sep 07 13:46:06 2012 +0100
+++ b/SequenceableCollection.st Fri Sep 07 17:24:32 2012 +0100
@@ -680,6 +680,7 @@
^ self replaceFrom:start to:stop with:anArray startingAt:repStart
! !
+
!SequenceableCollection methodsFor:'accessing'!
after:anObject
@@ -2576,8 +2577,10 @@
^ cls decodeFromLiteralArray:self.
"
+ #(10 20) literalArrayEncoding
#(Array 10 20) decodeAsLiteralArray
- #(10 20) literalArrayEncoding
+ #() literalArrayEncoding
+ #(Array) decodeAsLiteralArray
"
"Modified: / 26-03-2007 / 13:57:10 / cg"
@@ -3402,7 +3405,13 @@
"
#(1 2 3 4 5 6 7 8 9 0) copyReplaceFrom:3 to:6 with:#(a b c d e f g h i j k)
'hello world' copyReplaceFrom:6 to:6 with:' there, '
- "
+ 'one two three' copyReplaceFrom:5 to:7 with:'zwei'
+
+ the following is something we want, not an unexpected side feature:
+ '12345' copyReplaceFrom:5 to:4 with:'xxx'
+ "
+
+ "Modified (comment): / 27-07-2012 / 16:39:17 / cg"
!
copyReplaceFrom:startIndex with:aCollection
@@ -8699,15 +8708,15 @@
!SequenceableCollection class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/SequenceableCollection.st,v 1.323 2012/07/23 09:19:11 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/SequenceableCollection.st,v 1.325 2012/08/23 13:25:43 cg Exp $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/SequenceableCollection.st,v 1.323 2012/07/23 09:19:11 stefan Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/SequenceableCollection.st,v 1.325 2012/08/23 13:25:43 cg Exp §'
!
version_SVN
- ^ '$Id: SequenceableCollection.st 10829 2012-07-25 08:45:15Z vranyj1 $'
+ ^ '$Id: SequenceableCollection.st 10844 2012-09-07 16:24:32Z vranyj1 $'
! !
SequenceableCollection initialize!
--- a/Set.st Fri Sep 07 13:46:06 2012 +0100
+++ b/Set.st Fri Sep 07 17:24:32 2012 +0100
@@ -25,6 +25,13 @@
privateIn:Set
!
+Object subclass:#NilKey
+ instanceVariableNames:''
+ classVariableNames:'TheOneAndOnlyInstance'
+ poolDictionaries:''
+ privateIn:Set
+!
+
!Set class methodsFor:'documentation'!
copyright
@@ -44,11 +51,11 @@
documentation
"
a Set is a collection where each element occurs at most once.
- The inclusion test is done using = for comparison;
+ The inclusion test is done using equality (=) for comparison;
see IdentitySet for sets using identity compare.
Keep in mind, that a regular Set therefore treats 3.0 and 3 as equal
and therefore:
- (Set with:3.0) includes:3
+ (Set with:3.0) includes:3
will return true (since 3.0 and 3 are equal).
In contrast, an IdentitySet will return false, because 3.0 and 3 are not
identical.
@@ -70,27 +77,28 @@
If you have a rough idea how big the set is going to grow,
create it using #new: instead of #new. Even if the size given is a
poor guess (say half of the real size), there is some 20-30% performance
- win to expect, since many resizing operations of the set are avoided.
+ win to expect, since many resizing operations of the set are avoided
+ (resizing is expensive, as the set does a rehash).
Examples:
- |s|
- s := Set new.
- s add:'hello'.
- s add:'world'.
- s add:#foo.
- s add:1.2345678.
- s add:'hello'.
+ |s|
+ s := Set new.
+ s add:'hello'.
+ s add:'world'.
+ s add:#foo.
+ s add:1.2345678.
+ s add:'hello'.
- s printCR.
- 's size -> ' print. s size printCR.
- '(s includes:''hello'') -> ' print. (s includes:'hello') printCR.
- '(s includes:#foo) -> ' print. (s includes:#foo) printCR.
- '(s includes:''foo'') -> ' print. (s includes:'foo') printCR.
- '(s includes:#bar) -> ' print. (s includes:#bar) printCR.
+ s printCR.
+ 's size -> ' print. s size printCR.
+ '(s includes:''hello'') -> ' print. (s includes:'hello') printCR.
+ '(s includes:#foo) -> ' print. (s includes:#foo) printCR.
+ '(s includes:''foo'') -> ' print. (s includes:'foo') printCR.
+ '(s includes:#bar) -> ' print. (s includes:#bar) printCR.
[author:]
- Claus Gittinger
+ Claus Gittinger
"
! !
@@ -100,10 +108,13 @@
"initialize the Set class"
DeletedEntry isNil ifTrue:[
- DeletedEntry := EmptySlot new
+ DeletedEntry := EmptySlot new.
+ NilEntry := NilKey new.
].
- "Set initialize"
+ "
+ Set initialize
+ "
"Modified: 24.1.1997 / 21:09:00 / cg"
! !
@@ -187,7 +198,6 @@
"Created: / 24.10.1997 / 23:13:44 / cg"
! !
-
!Set methodsFor:'Compatibility-ST80'!
initialIndexFor:hashKey boundedBy:length
@@ -298,13 +308,17 @@
This is the same functionality as provided by the goodies/KeyedSet
goody."
- |index "{ Class: SmallInteger }" |
+ |index "{ Class: SmallInteger }" ret|
- index := self find:anObject ifAbsent:0.
+ index := self find:(anObject ? NilEntry)ifAbsent:0.
index == 0 ifTrue:[
- ^ exceptionBlock value
+ ^ exceptionBlock value
].
- ^ keyArray basicAt:index
+ ret := keyArray basicAt:index.
+ ret == NilEntry ifTrue:[
+ ret := nil.
+ ].
+ ^ ret.
"Created: 20.3.1997 / 20:34:07 / cg"
"Modified: 20.3.1997 / 20:35:49 / cg"
@@ -327,81 +341,73 @@
!Set methodsFor:'adding & removing'!
-add:anObject
+add:keyArg
"add the argument, anObject to the receiver.
WARNING: do not add elements while iterating over the receiver.
Iterate over a copy to do this."
- |index "{ Class: SmallInteger }"|
+ |key index "{ Class: SmallInteger }"|
- anObject isNil ifTrue:[
- ^ self invalidElementError.
+ keyArg isNil ifTrue:[
+ key := NilEntry.
+ ] ifFalse:[
+ key := keyArg.
].
- index := self findKeyOrNil:anObject.
+ index := self findKeyOrNil:key.
(keyArray basicAt:index) isNil ifTrue:[
"/ not already there
- keyArray basicAt:index put:anObject.
+ keyArray basicAt:index put:key.
tally := tally + 1.
self fullCheck.
].
- ^ anObject
+ ^ keyArg
"Modified: 30.1.1997 / 14:58:08 / cg"
!
-addAllNonNilElements:aCollection
- "add all non-nil elements of the argument, aCollection to the receiver.
- Use this, when operating on a Set, that cannot hold nil.
- Answer the argument, aCollection (sigh)."
-
- aCollection do:[:eachElement |
- eachElement notNil ifTrue:[
- self add:eachElement
- ].
- ].
- ^ aCollection
-
- "
- #(1 2 3 4) asSet addAllNonNilElements:#(5 nil 6 7 8)
- "
-!
-
-remove:oldObject ifAbsent:exceptionBlock
+remove:oldObjectArg ifAbsent:exceptionBlock
"remove oldObject from the collection and return it.
If it was not in the collection return the value of exceptionBlock.
Notice, that the returned object could be non-identical to the argument
(although it will always be equal).
WARNING: do not remove elements while iterating over the receiver.
- See #saveRemove: to do this."
+ See #saveRemove: to do this."
+
+ |oldObject index next removedObject|
- |index next objectRemoved|
-
- oldObject isNil ifTrue:[^ exceptionBlock value].
+ oldObjectArg isNil ifTrue:[
+ oldObject := NilEntry.
+ ] ifFalse:[
+ oldObject := oldObjectArg.
+ ].
index := self find:oldObject ifAbsent:0.
index == 0 ifTrue:[^ exceptionBlock value].
- objectRemoved := keyArray basicAt:index.
+ removedObject := keyArray basicAt:index.
keyArray basicAt:index put:nil.
tally := tally - 1.
tally == 0 ifTrue:[
- keyArray := self keyContainerOfSize:(self class goodSizeFrom:0).
+ keyArray := self keyContainerOfSize:(self class goodSizeFrom:0).
] ifFalse:[
- index == keyArray basicSize ifTrue:[
- next := 1
- ] ifFalse:[
- next := index + 1.
- ].
- (keyArray basicAt:next) notNil ifTrue:[
- keyArray basicAt:index put:DeletedEntry.
- ].
- self emptyCheck
+ index == keyArray basicSize ifTrue:[
+ next := 1
+ ] ifFalse:[
+ next := index + 1.
+ ].
+ (keyArray basicAt:next) notNil ifTrue:[
+ keyArray basicAt:index put:DeletedEntry.
+ ].
+ self emptyCheck
].
- ^ objectRemoved
+ removedObject == NilEntry ifTrue:[
+ removedObject := nil.
+ ].
+ ^ removedObject
"Modified: / 16.11.2001 / 10:14:24 / cg"
!
@@ -422,6 +428,28 @@
In contrast to #remove:, this does not resize the underlying collection
and therefore does NOT rehash & change the elements order.
+ Therefor this can be used while enumerating the receiver,
+ which is not possible if #remove: is used.
+
+ WARNING: since no resizing is done, the physical amount of memory used
+ by the container remains the same, although the logical size shrinks.
+ You may want to manually resize the receiver using #emptyCheck.
+ (after the loop)"
+
+ ^ self saveRemove:oldObject ifAbsent:[].
+
+ "Created: / 16.11.2001 / 10:23:48 / cg"
+ "Modified: / 16.11.2001 / 10:24:03 / cg"
+!
+
+saveRemove:oldObjectArg ifAbsent:exceptionValueProvider
+ "remove the element, oldObject from the collection.
+ Return the element
+ (could be non-identical to oldObject, since I hash on equality, not on identity).
+ If it was not in the collection return the value of exceptionValueProvider.
+
+ In contrast to #remove:, this does not resize the underlying collection
+ and therefore does NOT rehash & change the elements order.
Therefore this can be used while enumerating the receiver,
which is not possible if #remove: is used.
@@ -430,14 +458,19 @@
You may want to manually resize the receiver using #emptyCheck.
(after the loop)"
- |index "{ Class:SmallInteger }"
+ |oldObject
+ index "{ Class:SmallInteger }"
next "{ Class:SmallInteger }"
removedObject|
- oldObject isNil ifTrue:[^ nil].
+ oldObjectArg isNil ifTrue:[
+ oldObject := NilEntry.
+ ] ifFalse:[
+ oldObject := oldObjectArg.
+ ].
index := self find:oldObject ifAbsent:0.
- index == 0 ifTrue:[^ nil].
+ index == 0 ifTrue:[^ exceptionValueProvider value].
removedObject := keyArray basicAt:index.
keyArray basicAt:index put:nil.
@@ -453,6 +486,9 @@
keyArray basicAt:index put:DeletedEntry
].
].
+ removedObject == NilEntry ifTrue:[
+ removedObject := nil.
+ ].
^ removedObject
"does NOT work:
@@ -503,7 +539,7 @@
"Modified: / 16.11.2001 / 10:22:59 / cg"
!
-testAndAdd:anObject
+testAndAdd:keyArg
"add the argument, anObject to the receiver.
Answer true, if the element did already exist in the collection,
false otherwise.
@@ -511,16 +547,18 @@
WARNING: do not add elements while iterating over the receiver.
Iterate over a copy to do this."
- |index "{ Class: SmallInteger }"|
+ |key index "{ Class: SmallInteger }"|
- anObject isNil ifTrue:[
- ^ self invalidElementError.
+ keyArg isNil ifTrue:[
+ key := NilEntry.
+ ] ifFalse:[
+ key := keyArg.
].
- index := self findKeyOrNil:anObject.
+ index := self findKeyOrNil:key.
(keyArray basicAt:index) isNil ifTrue:[
"/ not already there
- keyArray basicAt:index put:anObject.
+ keyArray basicAt:index put:key.
tally := tally + 1.
self fullCheck.
@@ -554,6 +592,7 @@
"
#(1 2 3 4 5) asSet = #(2 3 4 5 1) asSet
+ #(nil 1 2 3 4 5) asSet = #(2 3 4 5 1) asSet´
#(1 2 3 4 5) asSet = #(2 3 4 5 1.0) asSet
#(1 2 3 4 5) asSet = #(2 3 4 5 'one') asSet
"
@@ -662,17 +701,20 @@
"perform the block for all members in the collection.
WARNING: do not add/remove elements while iterating over the receiver.
- Iterate over a copy to do this."
+ Iterate over a copy to do this."
|sz "{ Class: SmallInteger }"
element|
sz := keyArray size.
1 to:sz do:[:index |
- element := keyArray at:index.
- (element notNil and:[element ~~ DeletedEntry]) ifTrue:[
- aBlock value:element
- ]
+ element := keyArray at:index.
+ (element notNil and:[element ~~ DeletedEntry]) ifTrue:[
+ element == NilEntry ifTrue:[
+ element := nil.
+ ].
+ aBlock value:element
+ ]
]
"Modified: 1.3.1996 / 21:41:13 / cg"
@@ -1115,12 +1157,7 @@
includes:anObject
"return true if the argument anObject is in the receiver"
- anObject isNil ifTrue:[
- "even if adding nil to a set is forbidden, asking for it should be ok!!"
- "self invalidElementError."
- ^ false
- ].
- ^ (self find:anObject ifAbsent:0) ~~ 0
+ ^ (self find:(anObject ? NilEntry) ifAbsent:0) ~~ 0
!
isEmpty
@@ -1148,13 +1185,7 @@
"return the number of occurrences of anObject in the receiver.
As I am a Set, this can only return 0 or 1."
- anObject isNil ifTrue:[
- "even if adding nil to a set is forbidden, asking for it should be ok!!"
- "self invalidElementError."
- ^ 0.
- ].
-
- (self find:anObject ifAbsent:0) == 0 ifTrue:[^ 0].
+ (self find:(anObject ? NilEntry) ifAbsent:0) == 0 ifTrue:[^ 0].
^ 1
"Modified: / 16.11.2001 / 10:30:14 / cg"
@@ -1200,21 +1231,29 @@
! !
+!Set::NilKey class methodsFor:'instance creation'!
+
+basicNew
+ TheOneAndOnlyInstance isNil ifTrue:[
+ TheOneAndOnlyInstance := super basicNew
+ ].
+ ^ TheOneAndOnlyInstance
+
+
+! !
+
!Set class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Set.st,v 1.110 2012/02/22 12:55:54 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Set.st,v 1.115 2012/08/13 17:11:21 stefan Exp $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/Set.st,v 1.110 2012/02/22 12:55:54 stefan Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/Set.st,v 1.115 2012/08/13 17:11:21 stefan Exp §'
!
version_SVN
- ^ '$Id: Set.st 10792 2012-03-21 17:45:38Z vranyj1 $'
+ ^ '$Id: Set.st 10844 2012-09-07 16:24:32Z vranyj1 $'
! !
Set initialize!
-
-
-
--- a/SharedPool.st Fri Sep 07 13:46:06 2012 +0100
+++ b/SharedPool.st Fri Sep 07 17:24:32 2012 +0100
@@ -228,14 +228,30 @@
!SharedPool class methodsFor:'printing & storing'!
-displayString
+displayOn:aGCOrStream
+ "Compatibility
+ append a printed desription on some stream (Dolphin, Squeak)
+ OR:
+ display the receiver in a graphicsContext at 0@0 (ST80).
+ This method allows for any object to be displayed in some view
+ (although the fallBack is to display its printString ...)"
+
+ "/ what a kludge - Dolphin and Squeak mean: printOn: a stream;
+ "/ ST/X (and some old ST80's) mean: draw-yourself on a GC.
+ aGCOrStream isStream ifFalse:[
+ ^ super displayOn:aGCOrStream.
+ ].
+
"return a printed represenation - here, a reminder is appended,
that this is not a regular class"
- self == SharedPool ifTrue:[
- ^ super displayString
+ self == NameSpace ifTrue:[
+ super displayOn:aGCOrStream.
+ ] ifFalse:[
+ aGCOrStream
+ nextPutAll:self name;
+ nextPutAll:' (* SharedPool *)'.
].
- ^ self name , ' (* SharedPool *)'
! !
!SharedPool class methodsFor:'queries'!
@@ -247,13 +263,13 @@
!SharedPool class methodsFor:'documentation'!
version
- ^ '$Id: SharedPool.st 10794 2012-03-27 15:32:25Z vranyj1 $'
+ ^ '$Header: /cvs/stx/stx/libbasic/SharedPool.st,v 1.21 2012/08/03 15:52:47 stefan Exp $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/SharedPool.st,v 1.20 2012/03/06 16:09:32 cg Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/SharedPool.st,v 1.21 2012/08/03 15:52:47 stefan Exp §'
!
version_SVN
- ^ '$Id: SharedPool.st 10794 2012-03-27 15:32:25Z vranyj1 $'
+ ^ '$Id: SharedPool.st 10844 2012-09-07 16:24:32Z vranyj1 $'
! !
--- a/Smalltalk.st Fri Sep 07 13:46:06 2012 +0100
+++ b/Smalltalk.st Fri Sep 07 17:24:32 2012 +0100
@@ -1058,7 +1058,6 @@
"Created: 20.6.1997 / 16:58:28 / cg"
! !
-
!Smalltalk class methodsFor:'browsing'!
browseAllCallsOn:aSelectorSymbol
@@ -2084,7 +2083,6 @@
]
! !
-
!Smalltalk class methodsFor:'message control'!
silentLoading
@@ -5041,6 +5039,30 @@
"Created: 17.10.1997 / 13:52:19 / cg"
!
+recursiveInstallAutoloadedClassesFrom:aTopDirectory
+ "scan all packages and install all classes found there as
+ autoloaded. This takes some time ..."
+
+ |dirsConsulted|
+
+ dirsConsulted := Set new.
+
+ self
+ recursiveInstallAutoloadedClassesFrom:aTopDirectory
+ rememberIn:dirsConsulted
+ maxLevels:15
+ noAutoload:false
+ packageTop:nil
+ showSplashInLevels:-1.
+
+
+ "
+ Smalltalk recursiveInstallAutoloadedClassesFrom:'..\..\..\cg\private\euler'
+ "
+
+ "Created: / 31-07-2012 / 15:27:40 / cg"
+!
+
recursiveInstallAutoloadedClassesFrom:aDirectory rememberIn:dirsConsulted maxLevels:maxLevels noAutoload:noAutoloadIn packageTop:packageTopPath
"read all abbrev.stc files from and under aDirectory
and install autoloaded classes.
@@ -5073,46 +5095,48 @@
maxLevels == 0 ifTrue:[
"/ 'Smalltalk [warning]: max directory nesting reached.' infoPrintCR.
- ^ self
+ ^ self
].
dir := aDirectory asFilename.
dirName := dir pathName.
(dirsConsulted includes:dirName) ifTrue:[
- ^ self
+ ^ self
].
dirsConsulted add:dirName.
(dir / 'NOPACKAGES') exists ifTrue:[
- ^ self.
+ ^ self.
].
(dir / 'NOSUBAUTOLOAD') exists ifTrue:[
- ^ self.
+ ^ self.
].
noAutoloadHere := noAutoloadIn.
noAutoloadHere ifFalse:[
- (dir / 'NOAUTOLOAD') exists ifTrue:[
- noAutoloadHere := true.
- ].
+ (dir / 'NOAUTOLOAD') exists ifTrue:[
+ noAutoloadHere := true.
+ ].
] ifTrue:[
- (dir / 'AUTOLOAD') exists ifTrue:[
- noAutoloadHere := false.
- ].
+ (dir / 'AUTOLOAD') exists ifTrue:[
+ noAutoloadHere := false.
+ ].
].
((dir / 'loadAll') exists or:[(dir / 'abbrev.stc') exists]) ifTrue:[
- KnownPackages isNil ifTrue:[
- KnownPackages := Set new.
- ].
- pkgName := dirName copyFrom:(packageTopPath asFilename pathName) size + 1 + 1.
- KnownPackages add:pkgName
+ packageTopPath notNil ifTrue:[
+ KnownPackages isNil ifTrue:[
+ KnownPackages := Set new.
+ ].
+ pkgName := dirName copyFrom:(packageTopPath asFilename pathName) size + 1 + 1.
+ KnownPackages add:pkgName
+ ].
].
showSplashInLevels >= 0 ifTrue:[
- self showSplashMessage:('Smalltalk [info]: installing autoloaded classes found under "%1"...'
- bindWith:(dirName contractAtBeginningTo:35)).
+ self showSplashMessage:('Smalltalk [info]: installing autoloaded classes found under "%1"...'
+ bindWith:(dirName contractAtBeginningTo:35)).
].
"/
@@ -5120,64 +5144,64 @@
"/ below; however, still traverse the directories to find packages ...
"/
noAutoloadHere ifFalse:[
- [
- self installAutoloadedClassesFromAbbrevFile:(dir / 'abbrev.stc').
- ] on:FileStream openErrorSignal do:[:ex| "ignore this file"].
+ [
+ self installAutoloadedClassesFromAbbrevFile:(dir / 'abbrev.stc').
+ ] on:FileStream openErrorSignal do:[:ex| "ignore this file"].
].
[
- directoryContents := dir directoryContents asSet. "asSet to speed up remove"
+ directoryContents := dir directoryContents asSet. "asSet to speed up remove"
] on:FileStream openErrorSignal do:[:ex|
- "non-accessable directory: we are done"
- ^ self
+ "non-accessable directory: we are done"
+ ^ self
].
directoryContents removeAllFoundIn:#(
- 'objbc'
- 'objvc'
- 'doc'
- 'CVS'
- 'bitmaps'
- 'resources'
- 'source'
- 'not_delivered'
- 'not_ported'
- ).
+ 'objbc'
+ 'objvc'
+ 'doc'
+ 'CVS'
+ 'bitmaps'
+ 'resources'
+ 'source'
+ 'not_delivered'
+ 'not_ported'
+ ).
dir baseName = 'stx' ifTrue:[
- directoryContents removeAllFoundIn:#(
- 'configurations'
- 'include'
- 'rules'
- 'stc'
- 'support'
- ).
+ directoryContents removeAllFoundIn:#(
+ 'configurations'
+ 'include'
+ 'rules'
+ 'stc'
+ 'support'
+ ).
].
directoryContents do:[:eachFilenameString |
- |f|
-
- f := dir / eachFilenameString.
- f isDirectory ifTrue:[
- self
- recursiveInstallAutoloadedClassesFrom:f
- rememberIn:dirsConsulted
- maxLevels:maxLevels-1
- noAutoload:noAutoloadHere
- packageTop:packageTopPath
- showSplashInLevels:showSplashInLevels - 1.
- ]
+ |f|
+
+ f := dir / eachFilenameString.
+ f isDirectory ifTrue:[
+ self
+ recursiveInstallAutoloadedClassesFrom:f
+ rememberIn:dirsConsulted
+ maxLevels:maxLevels-1
+ noAutoload:noAutoloadHere
+ packageTop:packageTopPath
+ showSplashInLevels:showSplashInLevels - 1.
+ ]
].
showSplashInLevels >= 0 ifTrue:[
- self showSplashMessage:('Smalltalk [info]: installing autoloaded classes from "%1"...'
- bindWith:(dirName contractAtBeginningTo:35)).
+ self showSplashMessage:('Smalltalk [info]: installing autoloaded classes from "%1"...'
+ bindWith:(dirName contractAtBeginningTo:35)).
].
"
Smalltalk installAutoloadedClasses
"
- "Modified: / 29-07-2011 / 20:40:51 / cg"
+ "Modified: / 31-07-2012 / 15:26:54 / cg"
!
replaceReferencesTo:anObject with:newRef
@@ -7791,13 +7815,13 @@
!Smalltalk class methodsFor:'documentation'!
version
- ^ '$Id: Smalltalk.st 10837 2012-08-16 23:23:48Z vranyj1 $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.992 2012/07/31 14:00:53 cg Exp $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.991 2012/07/18 17:09:50 cg Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.992 2012/07/31 14:00:53 cg Exp §'
!
version_SVN
- ^ '$Id: Smalltalk.st 10837 2012-08-16 23:23:48Z vranyj1 $'
+ ^ '$ Id: Smalltalk.st 10648 2011-06-23 15:55:10Z vranyj1 $'
! !
--- a/SmalltalkChunkFileSourceWriter.st Fri Sep 07 13:46:06 2012 +0100
+++ b/SmalltalkChunkFileSourceWriter.st Fri Sep 07 17:24:32 2012 +0100
@@ -34,6 +34,58 @@
"
! !
+!SmalltalkChunkFileSourceWriter class methodsFor:'utilities - source code'!
+
+methodTemplate
+ "return a method definition template string"
+
+ |s|
+
+ s := TextStream on:''.
+ s nextPutAll:
+'message selector and argument names
+ "comment stating purpose of this message"
+
+ |temporaries|
+
+ statement.
+ statement.
+
+ "
+ optional: comment giving example use
+ "
+'.
+ s cr.
+ s emphasis:(UserPreferences current commentEmphasisAndColor).
+ s nextPutAll:
+'"
+ change the above template into real code;
+ remove this comment.
+ Then `accept'' either via the menu
+ or via the keyboard (usually CMD-A).
+
+ You do not need this template; you can also
+ select any existing methods code, change it,
+ and finally `accept''. The method will then be
+ installed under the selector as defined in the
+ actual text - no matter which method is selected
+ in the browser.
+
+ Or clear this text, type in the method from scratch
+ and install it with `accept''.
+"
+'.
+ ^ s contents
+!
+
+versionMethodTemplateForCVS
+ "careful to avoid expansion by cvs here!!"
+
+ ^ ('version\ ^ ''$' , 'Header$''') withCRs
+
+ "Created: / 21-08-2012 / 11:52:27 / cg"
+! !
+
!SmalltalkChunkFileSourceWriter methodsFor:'source writing'!
fileOut:aClass on:outStreamArg withTimeStamp:stampIt withInitialize:initIt withDefinition:withDefinition methodFilter:methodFilter encoder:encoderOrNil
@@ -522,9 +574,9 @@
!SmalltalkChunkFileSourceWriter class methodsFor:'documentation'!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/SmalltalkChunkFileSourceWriter.st,v 1.15 2011/09/29 12:56:36 cg Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/SmalltalkChunkFileSourceWriter.st,v 1.16 2012/08/21 17:48:17 cg Exp §'
!
version_SVN
- ^ '$Id: SmalltalkChunkFileSourceWriter.st 10842 2012-09-07 10:49:18Z vranyj1 $'
+ ^ '$Id: SmalltalkChunkFileSourceWriter.st 10844 2012-09-07 16:24:32Z vranyj1 $'
! !
--- a/SmalltalkLanguage.st Fri Sep 07 13:46:06 2012 +0100
+++ b/SmalltalkLanguage.st Fri Sep 07 17:24:32 2012 +0100
@@ -67,7 +67,7 @@
!SmalltalkLanguage methodsFor:'accessing - classes'!
codeGeneratorClass
- "Answers a class that can generate smalltalk code"
+ "Answers a class that can generate code"
^ SmalltalkCodeGeneratorTool
@@ -173,62 +173,18 @@
"Created: / 16-08-2009 / 09:01:38 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !
-!SmalltalkLanguage methodsFor:'utilities - source code'!
-
-methodTemplate
- "return a method definition template string"
-
- |s|
-
- s := TextStream on:''.
- s nextPutAll:
-'message selector and argument names
- "comment stating purpose of this message"
-
- |temporaries|
-
- statement.
- statement.
-
- "
- optional: comment giving example use
- "
-'.
- s cr.
- s emphasis:(UserPreferences current commentEmphasisAndColor).
- s nextPutAll:
-'"
- change the above template into real code;
- remove this comment.
- Then `accept'' either via the menu
- or via the keyboard (usually CMD-A).
-
- You do not need this template; you can also
- select any existing methods code, change it,
- and finally `accept''. The method will then be
- installed under the selector as defined in the
- actual text - no matter which method is selected
- in the browser.
-
- Or clear this text, type in the method from scratch
- and install it with `accept''.
-"
-'.
- ^ s contents
-! !
-
!SmalltalkLanguage class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/SmalltalkLanguage.st,v 1.16 2012/04/01 11:21:32 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/SmalltalkLanguage.st,v 1.19 2012/08/21 17:54:48 cg Exp $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/SmalltalkLanguage.st,v 1.16 2012/04/01 11:21:32 cg Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/SmalltalkLanguage.st,v 1.19 2012/08/21 17:54:48 cg Exp §'
!
version_SVN
- ^'$Id: SmalltalkLanguage.st 10804 2012-04-13 13:18:13Z vranyj1 $'
+ ^'$Id: SmalltalkLanguage.st 10844 2012-09-07 16:24:32Z vranyj1 $'
! !
--- a/SortedCollection.st Fri Sep 07 13:46:06 2012 +0100
+++ b/SortedCollection.st Fri Sep 07 17:24:32 2012 +0100
@@ -62,6 +62,9 @@
... be aware, that the sortBlock has an effect on a few algorithms
found here; especially #indexForInserting is critical.)
+ [caveat:]
+ a balanced tree may be a better choice, as inserting may be slow when
+ elements have to be shifted.
[author:]
Claus Gittinger
@@ -324,96 +327,6 @@
^ self withAll:aCollection sortBlock:aBlock
! !
-!SortedCollection class methodsFor:'helpers'!
-
-binarySearch:aSortedArray for:anObject
- "search for an existing element; return true if found.
- by checking if the element at the returned index is the one we look for.
- Uses a binarySearch since we can depend on the elements being on sorted order.
- The returned index is a physical one, for accessing contentsArray.
- This is only to be used for arrays which are known to be sorted."
-
- |idx|
-
- idx := self
- binarySearch:aSortedArray
- forIndexOf:anObject.
- ^ idx <= aSortedArray size
- and:[ (aSortedArray at:idx) = anObject ].
-
- "
- SortedCollection
- binarySearch:#(1 2 3 4 7 99 1313 981989 898989898)
- for:898989898
- "
-!
-
-binarySearch:aSortedArray forIndexOf:anObject
- "search the index at which to insert anObject.
- Can also be used to search for an existing element
- by checking if the element at the returned index is the one we look for.
- Uses a binarySearch since we can depend on the elements being on sorted order.
- The returned index is a physical one, for accessing contentsArray.
- This is only to be used for arrays which are known to be sorted."
-
- ^ self
- binarySearch:aSortedArray
- from:1 to:(aSortedArray size)
- forIndexOf:anObject
- usingSortBlock:[:a :b | a < b ]
-
- "
- SortedCollection
- binarySearch:#(1 2 3 4 7 99 1313 981989 898989898)
- from:1 to:9
- forIndexOf:99
- usingSortBlock:[:a :b | a < b ]
- "
-
- "Modified: 12.4.1996 / 13:22:03 / cg"
-!
-
-binarySearch:aSortedArray from:firstIndex to:lastIndex forIndexOf:anObject usingSortBlock:sortBlock
- "search the index at which to insert anObject.
- Can also be used to search for an existing element
- by checking if the element at the returned index is the one we look for.
- Uses a binarySearch since we can depend on the elements being on sorted order.
- The returned index is a physical one, for accessing contentsArray.
- This is only to be used for arrays which are known to be sorted."
-
- |low "{ Class: SmallInteger}"
- high "{ Class: SmallInteger}"
- middle "{ Class: SmallInteger}"
- element|
-
- "
- we can of course use a binary search - since the elements are sorted
- "
- low := firstIndex.
- high := lastIndex.
- [low > high] whileFalse:[
- middle := (low + high) // 2.
- element := aSortedArray at:middle.
- (sortBlock value:element value:anObject) ifTrue:[
- "middleelement is smaller than object"
- low := middle + 1
- ] ifFalse:[
- high := middle - 1
- ]
- ].
- ^ low
-
- "
- SortedCollection
- binarySearch:#(1 2 3 4 7 99 1313 981989 898989898)
- from:1 to:9
- forIndexOf:99
- usingSortBlock:[:a :b | a < b ]
- "
-
- "Modified: 12.4.1996 / 13:22:03 / cg"
-! !
-
!SortedCollection methodsFor:'accessing'!
largest:n
@@ -589,7 +502,9 @@
Notice, that quicksort degenerates to a veeery slow bubble-like
sort when a collection of already sorted elements is given to it.
Therefore, adding chunks is better done by sorting the chunk and merging
- it in, instead of resorting the receiver."
+ it in, instead of resorting the receiver.
+
+ aSortedCollection must be sorted by the same sortBlock as myself!!"
|newContentsArray
contentsArray2
@@ -603,32 +518,30 @@
end1Reached end2Reached
el1 el2 |
+ n2 := aSortedCollection size.
+ n2 == 0 ifTrue:[
+ ^ self.
+ ].
+
+ aSortedCollection isSortedCollection ifTrue:[
+ contentsArray2 := aSortedCollection contentsArray.
+ srcIndex2 := aSortedCollection firstIndex.
+ ] ifFalse:[
+ contentsArray2 := aSortedCollection.
+ srcIndex2 := 1.
+ ].
+
n1 := self size.
- n2 := aSortedCollection size.
-
n1 == 0 ifTrue:[
- ^ aSortedCollection.
- ].
- n2 == 0 ifTrue:[
+ firstIndex := srcIndex2.
+ lastIndex := firstIndex + n2 - 1.
+ contentsArray := contentsArray2 copy.
^ self.
].
newContentsArray := Array new:(n1 + n2).
destIndex := 1.
- (aSortedCollection isSortedBy:sortBlock) ifTrue:[
- aSortedCollection isSortedCollection ifTrue:[
- contentsArray2 := aSortedCollection contentsArray.
- srcIndex2 := aSortedCollection firstIndex.
- ] ifFalse:[
- contentsArray2 := aSortedCollection.
- srcIndex2 := 1.
- ]
- ] ifFalse:[
- contentsArray2 := aSortedCollection.
- srcIndex2 := 1.
- ].
-
last2 := srcIndex2 + n2 -1.
srcIndex1 := firstIndex.
@@ -844,13 +757,30 @@
"search the index at which to insert anObject.
Can also be used to search for an existing element
by checking if the element at the returned index is the one we look for.
- Uses a binarySearch since we can depend on the elements being on sorted order.
+ Uses a binarySearch since we can depend on the elements being in sorted order.
The returned index is a physical one, for accessing contentsArray."
- ^ self class
- binarySearch:contentsArray
- from:firstIndex to:lastIndex
- forIndexOf:anObject usingSortBlock:sortBlock
+ |low "{ Class: SmallInteger}"
+ high "{ Class: SmallInteger}"
+ middle "{ Class: SmallInteger}"
+ element|
+
+ "
+ we can of course use a binary search - since the elements are sorted
+ "
+ low := firstIndex.
+ high := lastIndex.
+ [low > high] whileFalse:[
+ middle := (low + high) // 2.
+ element := contentsArray at:middle.
+ (sortBlock value:element value:anObject) ifTrue:[
+ "middleelement is smaller than object"
+ low := middle + 1
+ ] ifFalse:[
+ high := middle - 1
+ ]
+ ].
+ ^ low
"
#(1 2 3 4 7 99 1313 981989 898989898) asSortedCollection indexForInserting:50
@@ -1060,11 +990,15 @@
!SortedCollection class methodsFor:'documentation'!
version
- ^ '$Id: SortedCollection.st 10836 2012-08-10 16:46:49Z vranyj1 $'
+ ^ '$Header: /cvs/stx/stx/libbasic/SortedCollection.st,v 1.76 2012/08/10 19:28:52 stefan Exp $'
+!
+
+version_CVS
+ ^ '§Header: /cvs/stx/stx/libbasic/SortedCollection.st,v 1.76 2012/08/10 19:28:52 stefan Exp §'
!
version_SVN
- ^ '$Id: SortedCollection.st 10836 2012-08-10 16:46:49Z vranyj1 $'
+ ^ '$Id: SortedCollection.st 10844 2012-09-07 16:24:32Z vranyj1 $'
! !
SortedCollection initialize!
--- a/StandaloneStartup.st Fri Sep 07 13:46:06 2012 +0100
+++ b/StandaloneStartup.st Fri Sep 07 17:24:32 2012 +0100
@@ -470,6 +470,8 @@
|path relPathName applicationEntry softwareEntry|
+ OperatingSystem isMSWINDOWSlike ifFalse:[^ nil].
+
path := self applicationRegistryPath.
relPathName := path asStringWith:$\.
applicationEntry := Win32OperatingSystem registryEntry key:'HKEY_CURRENT_USER\Software\',relPathName.
@@ -1152,15 +1154,15 @@
!StandaloneStartup class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/StandaloneStartup.st,v 1.68 2012/03/06 15:26:54 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/StandaloneStartup.st,v 1.69 2012/08/14 08:21:54 stefan Exp $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/StandaloneStartup.st,v 1.68 2012/03/06 15:26:54 stefan Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/StandaloneStartup.st,v 1.69 2012/08/14 08:21:54 stefan Exp §'
!
version_SVN
- ^ '$Id: StandaloneStartup.st 10792 2012-03-21 17:45:38Z vranyj1 $'
+ ^ '$Id: StandaloneStartup.st 10844 2012-09-07 16:24:32Z vranyj1 $'
! !
StandaloneStartup initialize!
--- a/Stream.st Fri Sep 07 13:46:06 2012 +0100
+++ b/Stream.st Fri Sep 07 17:24:32 2012 +0100
@@ -194,8 +194,6 @@
^ ChunkSeparator
! !
-
-
!Stream methodsFor:'accessing'!
contents
@@ -1919,6 +1917,14 @@
"Created: / 29.5.1998 / 16:57:48 / cg"
!
+size
+ "return the number of elements in the streamed collection."
+
+ self subclassResponsibility
+
+ "Created: / 05-08-2012 / 18:38:12 / cg"
+!
+
terminalType
^ 'dump'
! !
@@ -2555,7 +2561,6 @@
"Modified: / 19.5.1998 / 17:26:25 / cg"
! !
-
!Stream methodsFor:'testing'!
atEnd
@@ -2866,6 +2871,20 @@
"Modified: 11.7.1996 / 10:00:32 / cg"
!
+nextPutAllLines:aCollectionOfStrings
+ "put all elements of the argument, aCollection as individual lines
+ onto the receiver, append a cr (carriage return) after each.
+ This is only useful with character streams in textMode,
+ and only allowed, if the receiver supports writing."
+
+ aCollectionOfStrings do:[:eachLine |
+ self nextPutLine:eachLine.
+ ].
+
+ "Modified: / 08-11-1996 / 23:53:41 / cg"
+ "Created: / 27-07-2012 / 09:26:09 / cg"
+!
+
nextPutAllText:aText
"normal streams can not handle text/emphasis, so convert aText to the string"
@@ -3230,18 +3249,15 @@
!Stream class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Stream.st,v 1.190 2012/04/05 09:58:52 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Stream.st,v 1.192 2012/08/05 16:38:41 cg Exp $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/Stream.st,v 1.190 2012/04/05 09:58:52 stefan Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/Stream.st,v 1.192 2012/08/05 16:38:41 cg Exp §'
!
version_SVN
- ^ '$Id: Stream.st 10804 2012-04-13 13:18:13Z vranyj1 $'
+ ^ '$Id: Stream.st 10844 2012-09-07 16:24:32Z vranyj1 $'
! !
Stream initialize!
-
-
-
--- a/String.st Fri Sep 07 13:46:06 2012 +0100
+++ b/String.st Fri Sep 07 17:24:32 2012 +0100
@@ -13,7 +13,7 @@
CharacterArray variableByteSubclass:#String
instanceVariableNames:''
- classVariableNames:'CRLF LF'
+ classVariableNames:'CRLF CR LF TAB'
poolDictionaries:''
category:'Collections-Text'
!
@@ -440,7 +440,10 @@
cr
"return a string consisting of the cr-Character"
- ^ Character return asString
+ CR isNil ifTrue:[
+ CR := String with:Character return
+ ].
+ ^ CR
"Modified: / 13.11.1999 / 13:53:36 / cg"
!
@@ -484,7 +487,10 @@
tab
"return a string consisting of the tab-Character"
- ^ Character tab asString
+ TAB isNil ifTrue:[
+ TAB := String with:Character tab
+ ].
+ ^ TAB
! !
@@ -1116,7 +1122,7 @@
'hello world' indexOfAny:'AOE' startingAt:1
'hello world' indexOfAny:'o' startingAt:6
'hello world' indexOfAny:'o' startingAt:6
- 'hello world§' indexOfAny:'#§$' startingAt:6
+ 'hello world' indexOfAny:'#$' startingAt:6
"
!
@@ -1895,7 +1901,7 @@
!
asByteArray
- "this is faster than Collectzion>>#asByteArray"
+ "this is faster than Collection>>#asByteArray"
|bytes sz|
@@ -1907,6 +1913,8 @@
"
'fooBar' asByteArray.
"
+
+ "Modified (comment): / 26-07-2012 / 22:55:26 / cg"
!
asExternalBytes
@@ -2052,7 +2060,7 @@
asUUID
"return self as a UUID"
- ^ UUID fromString:self
+ ^ UUID readFrom:self
"
'{EAB22AC0-30C1-11CF-A7EB-0000C05BAE0B}' asUUID
@@ -3400,6 +3408,7 @@
unsigned char *x = __stringVal(aSubString);
int m = __stringSize(aSubString);
int n = __stringSize(self);
+# define MAX_PATTERN_SIZE 128
# define XSIZE 256
# define ASIZE 256
# define MAX(a,b) (a>b ? a : b)
@@ -3414,7 +3423,10 @@
#endif
}
if (m <= XSIZE) {
- int i, j, bmGs[XSIZE+1], bmBc[ASIZE];
+ int i, j;
+ static int lastPatternSize = 0;
+ static char lastPattern[MAX_PATTERN_SIZE+1] = { 0 };
+ static int bmGs[XSIZE+1], bmBc[ASIZE];
# define preBmBc(x, m, bmBc) { \
int i; \
@@ -3461,9 +3473,22 @@
bmGs[m - 1 - suff[i]] = m - 1 - i; \
}
- /* Preprocessing */
- preBmGs(x, m, bmGs);
- preBmBc(x, m, bmBc);
+ /* tables only depend on pattern; so we can cache them in case the same string is searched again */
+ if ((m == lastPatternSize)
+ && (strcmp(lastPattern, x) == 0)) {
+ /* tables are still valid */
+ // printf("valid: \"%s\"\n", lastPattern);
+ } else {
+ /* Preprocessing */
+ // printf("compute: \"%s\"\n", lastPattern);
+ preBmGs(x, m, bmGs);
+ preBmBc(x, m, bmBc);
+ if (m <= MAX_PATTERN_SIZE) {
+ // printf("cache for: \"%s\"\n", lastPattern);
+ strcpy(lastPattern, x);
+ lastPatternSize = m;
+ }
+ }
/* Searching */
j = __intVal(startIndex) - 1;
@@ -3486,6 +3511,8 @@
^ exceptionValue value.
].
^ super indexOfSubCollection:aSubString startingAt:startIndex ifAbsent:exceptionValue caseSensitive:caseSensitive
+
+ "Modified: / 05-08-2012 / 12:27:31 / cg"
! !
!String methodsFor:'testing'!
@@ -3843,13 +3870,13 @@
!String class methodsFor:'documentation'!
version
- ^ '$Id: String.st 10842 2012-09-07 10:49:18Z vranyj1 $'
+ ^ '$Header: /cvs/stx/stx/libbasic/String.st,v 1.290 2012/08/23 15:47:22 cg Exp $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/String.st,v 1.286 2012/07/19 13:23:22 stefan Exp §'
+ ^ 'Header: /cvs/stx/stx/libbasic/String.st,v 1.290 2012/08/23 15:47:22 cg Exp '
!
version_SVN
- ^ '$Id:: String.st 10842 2012-09-07 10:49:18Z vranyj1 $'
+ ^ '$Id:: String.st 10844 2012-09-07 16:24:32Z vranyj1 $'
! !
--- a/StringCollection.st Fri Sep 07 13:46:06 2012 +0100
+++ b/StringCollection.st Fri Sep 07 17:24:32 2012 +0100
@@ -79,6 +79,8 @@
"return a new text object with lines taken from the argument, aString"
^ (self new:1) fromString:aString
+
+ "Modified: / 25-07-2012 / 18:52:47 / cg"
!
new:size
@@ -106,9 +108,11 @@
!
asStringCollection
- "return the receiver as a stringCollection - thats easy"
+ "return the receiver as a stringCollection - that's easy"
^ self
+
+ "Modified (comment): / 25-07-2012 / 18:11:14 / cg"
!
asStringWithoutEmphasis
@@ -136,41 +140,62 @@
!
encodeFrom:oldEncoding into:newEncoding
+ "encode each line"
+
|enc|
enc := CharacterEncoder encoderToEncodeFrom:oldEncoding into:newEncoding.
- ^ self collect:[:line |
- line isNil
- ifTrue:[ nil ]
- ifFalse:[ enc encodeString:line]
- ]
+ ^ self
+ collect:[:line |
+ line isNil
+ ifTrue:[ nil ]
+ ifFalse:[ enc encodeString:line]
+ ]
+
+ "Modified (comment): / 25-07-2012 / 18:09:40 / cg"
!
from:aString
+ "setup my contents from the argument, aString"
+
<resource: #obsolete>
- "setup my contents from the argument, aString"
self obsoleteMethodWarning:'use #fromString:'.
^ self fromString:aString
+
+ "Modified (format): / 25-07-2012 / 18:02:34 / cg"
!
fromString:aString
- "setup my contents from the argument, aString"
+ "setup my contents from the argument, aString.
+ AString should be delimited by newline characters"
|numberOfLines "{ Class:SmallInteger }"
start "{ Class:SmallInteger }"
- stop "{ Class:SmallInteger }"
+ stop "{ Class:SmallInteger }"
+ delimiter
|
- numberOfLines := aString occurrencesOf:(Character cr).
- (aString endsWith:(Character cr)) ifFalse:[
+ aString isEmpty ifTrue:[self grow:0. ^ self ].
+
+ delimiter := Character cr.
+
+ numberOfLines := aString occurrencesOf:delimiter.
+ numberOfLines == 0 ifTrue:[
+ "/ check if its a return-delimited string
+ (aString occurrencesOf:(Character return)) > 0 ifTrue:[
+ delimiter := Character return.
+ ].
+ ].
+ aString last == delimiter ifFalse:[
numberOfLines := numberOfLines + 1.
].
+
self grow:numberOfLines.
start := 1.
1 to:numberOfLines do:[:lineNr |
- stop := aString indexOf:(Character cr) startingAt:start.
+ stop := aString indexOf:delimiter startingAt:start.
stop == 0 ifTrue:[
self at:lineNr put:(aString copyFrom:start).
self from:lineNr+1 to:numberOfLines put:''.
@@ -181,7 +206,7 @@
start := stop + 1
]
- "Modified: / 12.11.2001 / 18:18:42 / cg"
+ "Modified: / 25-07-2012 / 18:52:58 / cg"
! !
!StringCollection methodsFor:'copying'!
@@ -287,15 +312,23 @@
!StringCollection methodsFor:'queries'!
encoding
+ "the encoding; ask my first line"
+
self do:[:l | l notNil ifTrue:[^ l encoding]].
"/ sigh
^ #unicode
+
+ "Modified (comment): / 25-07-2012 / 18:09:15 / cg"
!
stringSize
+ "the size of the string if I was converted"
+
^ self inject:0 into:[:sizeSoFar :eachLine |
sizeSoFar + eachLine size + 1
]
+
+ "Modified (comment): / 25-07-2012 / 18:02:19 / cg"
! !
!StringCollection methodsFor:'searching'!
@@ -409,15 +442,15 @@
!StringCollection class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/StringCollection.st,v 1.44 2012/07/12 12:31:46 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/StringCollection.st,v 1.46 2012/07/25 17:12:38 cg Exp $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/StringCollection.st,v 1.44 2012/07/12 12:31:46 cg Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/StringCollection.st,v 1.46 2012/07/25 17:12:38 cg Exp §'
!
version_SVN
- ^ '$Id: StringCollection.st 10824 2012-07-18 16:55:48Z vranyj1 $'
+ ^ '$Id: StringCollection.st 10844 2012-09-07 16:24:32Z vranyj1 $'
! !
--- a/UserNotification.st Fri Sep 07 13:46:06 2012 +0100
+++ b/UserNotification.st Fri Sep 07 17:24:32 2012 +0100
@@ -87,6 +87,16 @@
notify:aString
self raiseErrorString:aString
+!
+
+notify: message progress: progress
+
+ ^ProgressNotification new
+ messageText: message;
+ parameter: progress;
+ raiseRequest
+
+ "Created: / 31-07-2012 / 15:18:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!UserNotification class methodsFor:'testing'!
@@ -143,15 +153,15 @@
!UserNotification class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/UserNotification.st,v 1.15 2009/10/14 17:34:46 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/UserNotification.st,v 1.16 2012/07/31 14:18:45 vrany Exp $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/UserNotification.st,v 1.15 2009/10/14 17:34:46 cg Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/UserNotification.st,v 1.16 2012/07/31 14:18:45 vrany Exp §'
!
version_SVN
- ^ '$Id: UserNotification.st 10761 2012-01-19 11:46:00Z vranyj1 $'
+ ^ '$Id: UserNotification.st 10844 2012-09-07 16:24:32Z vranyj1 $'
! !
UserNotification initialize!
--- a/UserPreferences.st Fri Sep 07 13:46:06 2012 +0100
+++ b/UserPreferences.st Fri Sep 07 17:24:32 2012 +0100
@@ -300,248 +300,246 @@
"a temporary kludge for old classVariable-based settings
- all of those MUST go into the user-preferences dictionary eventually"
- |s screen|
-
- s := fileName asFilename writeStream.
+ |screen|
screen := Screen current.
- s nextPutLine:'"/ ST/X saved settings';
- nextPutLine:'"/ DO NOT MODIFY MANUALLY';
- nextPutLine:'"/ (modifications would be lost with next save-settings)';
- nextPutLine:'"/';
- nextPutLine:'"/ this file was automatically generated by the';
- nextPutLine:'"/ ''save settings'' function of the SettingsDialog';
- nextPutLine:'"/'.
- s cr.
-
- s nextPutLine:'"/'.
- s nextPutLine:'"/ saved by ' , OperatingSystem getLoginName , '@' , OperatingSystem getHostName , ' at ' , Timestamp now printString.
- s nextPutLine:'"/'.
- s cr.
-
- s nextPutLine:'"/'.
- s nextPutLine:'"/ Display settings:'.
- s nextPutLine:'"/'.
- s nextPutLine:'"/ only restore the display settings, if on the same Display ...'.
- s nextPutLine:'Display notNil ifTrue:['.
- s nextPutLine:' Display displayName = ' , (screen displayName storeString) , ' ifTrue:['.
- screen fixColors notNil ifTrue:[
- s nextPutLine:' Image flushDeviceImages.'.
- s nextPutLine:' Color colorAllocationFailSignal catch:['.
- s nextPutLine:' Color getColorsRed:6 green:6 blue:4 on:Display'.
- s nextPutLine:' ].'.
- ] ifFalse:[
- s nextPutLine:' Display releaseFixColors.'.
- ].
- s nextPutLine:' Display hasColors: ' , (screen hasColors storeString) , '.'.
- s nextPutLine:' Display widthInMillimeter: ' , (screen widthInMillimeter storeString) , '.'.
- s nextPutLine:' Display heightInMillimeter: ' , (screen heightInMillimeter storeString) , '.'.
- s nextPutLine:' Display supportsDeepIcons: ' , (screen supportsDeepIcons storeString) , '.'.
- s nextPutLine:' Image ditherAlgorithm: ' , (Image ditherAlgorithm storeString) , '.'.
- s nextPutLine:' View defaultStyle:' , View defaultStyle storeString , '.'.
- s nextPutLine:' ].'.
- s nextPutLine:'].'.
- s cr.
-
- s nextPutLine:'"/'.
- s nextPutLine:'"/ Parser/Compiler settings:'.
- s nextPutLine:'"/'.
- s nextPutLine:'ParserFlags warnSTXSpecials: ' , (ParserFlags warnSTXSpecials storeString) , '.';
- nextPutLine:'ParserFlags warnings: ' , (ParserFlags warnings storeString) , '.';
- nextPutLine:'ParserFlags warnUnderscoreInIdentifier: ' , (ParserFlags warnUnderscoreInIdentifier storeString) , '.';
- nextPutLine:'ParserFlags warnOldStyleAssignment: ' , (ParserFlags warnOldStyleAssignment storeString) , '.';
- nextPutLine:'ParserFlags warnCommonMistakes: ' , (ParserFlags warnCommonMistakes storeString) , '.';
- nextPutLine:'ParserFlags warnPossibleIncompatibilities: ' , (ParserFlags warnPossibleIncompatibilities storeString) , '.';
- nextPutLine:'ParserFlags allowUnderscoreInIdentifier: ' , (ParserFlags allowUnderscoreInIdentifier storeString) , '.';
- nextPutLine:'ParserFlags allowSqueakExtensions: ' , (ParserFlags allowSqueakExtensions storeString) , '.';
- nextPutLine:'ParserFlags allowDolphinExtensions: ' , (ParserFlags allowDolphinExtensions storeString) , '.';
- nextPutLine:'ParserFlags allowQualifiedNames: ' , (ParserFlags allowQualifiedNames storeString) , '.';
- nextPutLine:'ParserFlags arraysAreImmutable: ' , (ParserFlags arraysAreImmutable storeString) , '.';
- nextPutLine:'Compiler lineNumberInfo: ' , (Compiler lineNumberInfo storeString) , '.';
-
- nextPutLine:'Compiler foldConstants: ' , (Compiler foldConstants storeString) , '.';
- nextPutLine:'ParserFlags stcCompilation: ' , (ParserFlags stcCompilation storeString) , '.';
- nextPutLine:'OperatingSystem getOSType = ' , (OperatingSystem getOSType storeString) , ' ifTrue:[';
- nextPutLine:' ParserFlags stcCompilationIncludes: ' , (ParserFlags stcCompilationIncludes storeString) , '.';
- nextPutLine:' ParserFlags stcCompilationDefines: ' , (ParserFlags stcCompilationDefines storeString) , '.';
- nextPutLine:' ParserFlags stcCompilationOptions: ' , (ParserFlags stcCompilationOptions storeString) , '.';
- nextPutLine:' ' , (ParserFlags stcModulePath storeString) , ' asFilename exists ifTrue:[';
- nextPutLine:' ParserFlags stcModulePath: ' , (ParserFlags stcModulePath storeString) , '.';
- nextPutLine:' ].';
- nextPutLine:' ParserFlags stcPath: ' , (ParserFlags stcPath storeString) , '.';
- nextPutLine:' ParserFlags ccCompilationOptions: ' , (ParserFlags ccCompilationOptions storeString) , '.';
- nextPutLine:' ParserFlags ccPath: ' , (ParserFlags ccPath storeString) , '.';
- nextPutLine:' ParserFlags linkArgs: ' , (ParserFlags linkArgs storeString) , '.';
- nextPutLine:' ParserFlags linkSharedArgs: ' , (ParserFlags linkSharedArgs storeString) , '.';
- nextPutLine:' ParserFlags linkCommand: ' , (ParserFlags linkCommand storeString) , '.';
- nextPutLine:' ParserFlags makeCommand: ' , (ParserFlags makeCommand storeString) , '.';
- nextPutLine:' ParserFlags libPath: ' , (ParserFlags libPath storeString) , '.';
- nextPutLine:' ParserFlags searchedLibraries: ' , (ParserFlags searchedLibraries storeString) , '.';
- nextPutLine:'].';
-
- nextPutLine:'ObjectMemory justInTimeCompilation: ' , (ObjectMemory justInTimeCompilation storeString) , '.';
- nextPutLine:'ObjectMemory fullSingleStepSupport: ' , (ObjectMemory fullSingleStepSupport storeString) , '.'.
-
- HistoryManager notNil ifTrue:[
- HistoryManager isActive ifTrue:[
- s nextPutLine:'HistoryManager notNil ifTrue:[HistoryManager activate].'.
- s nextPutLine:'HistoryManager notNil ifTrue:[HistoryManager fullHistoryUpdate:' , HistoryManager fullHistoryUpdate storeString , '].'.
+ fileName asFilename writingFileDo:[:s|
+ s nextPutLine:'"/ ST/X saved settings';
+ nextPutLine:'"/ DO NOT MODIFY MANUALLY';
+ nextPutLine:'"/ (modifications would be lost with next save-settings)';
+ nextPutLine:'"/';
+ nextPutLine:'"/ this file was automatically generated by the';
+ nextPutLine:'"/ ''save settings'' function of the SettingsDialog';
+ nextPutLine:'"/'.
+ s cr.
+
+ s nextPutLine:'"/'.
+ s nextPutLine:'"/ saved by ' , OperatingSystem getLoginName , '@' , OperatingSystem getHostName , ' at ' , Timestamp now printString.
+ s nextPutLine:'"/'.
+ s cr.
+
+ s nextPutLine:'"/'.
+ s nextPutLine:'"/ Display settings:'.
+ s nextPutLine:'"/'.
+ s nextPutLine:'"/ only restore the display settings, if on the same Display ...'.
+ s nextPutLine:'Display notNil ifTrue:['.
+ s nextPutLine:' Display displayName = ' , (screen displayName storeString) , ' ifTrue:['.
+ screen fixColors notNil ifTrue:[
+ s nextPutLine:' Image flushDeviceImages.'.
+ s nextPutLine:' Color colorAllocationFailSignal catch:['.
+ s nextPutLine:' Color getColorsRed:6 green:6 blue:4 on:Display'.
+ s nextPutLine:' ].'.
+ ] ifFalse:[
+ s nextPutLine:' Display releaseFixColors.'.
+ ].
+ s nextPutLine:' Display hasColors: ' , (screen hasColors storeString) , '.'.
+ s nextPutLine:' Display widthInMillimeter: ' , (screen widthInMillimeter storeString) , '.'.
+ s nextPutLine:' Display heightInMillimeter: ' , (screen heightInMillimeter storeString) , '.'.
+ s nextPutLine:' Display supportsDeepIcons: ' , (screen supportsDeepIcons storeString) , '.'.
+ s nextPutLine:' Image ditherAlgorithm: ' , (Image ditherAlgorithm storeString) , '.'.
+ s nextPutLine:' View defaultStyle:' , View defaultStyle storeString , '.'.
+ s nextPutLine:' ].'.
+ s nextPutLine:'].'.
+ s cr.
+
+ s nextPutLine:'"/'.
+ s nextPutLine:'"/ Parser/Compiler settings:'.
+ s nextPutLine:'"/'.
+ s nextPutLine:'ParserFlags warnSTXSpecials: ' , (ParserFlags warnSTXSpecials storeString) , '.';
+ nextPutLine:'ParserFlags warnings: ' , (ParserFlags warnings storeString) , '.';
+ nextPutLine:'ParserFlags warnUnderscoreInIdentifier: ' , (ParserFlags warnUnderscoreInIdentifier storeString) , '.';
+ nextPutLine:'ParserFlags warnOldStyleAssignment: ' , (ParserFlags warnOldStyleAssignment storeString) , '.';
+ nextPutLine:'ParserFlags warnCommonMistakes: ' , (ParserFlags warnCommonMistakes storeString) , '.';
+ nextPutLine:'ParserFlags warnPossibleIncompatibilities: ' , (ParserFlags warnPossibleIncompatibilities storeString) , '.';
+ nextPutLine:'ParserFlags allowUnderscoreInIdentifier: ' , (ParserFlags allowUnderscoreInIdentifier storeString) , '.';
+ nextPutLine:'ParserFlags allowSqueakExtensions: ' , (ParserFlags allowSqueakExtensions storeString) , '.';
+ nextPutLine:'ParserFlags allowDolphinExtensions: ' , (ParserFlags allowDolphinExtensions storeString) , '.';
+ nextPutLine:'ParserFlags allowQualifiedNames: ' , (ParserFlags allowQualifiedNames storeString) , '.';
+ nextPutLine:'ParserFlags arraysAreImmutable: ' , (ParserFlags arraysAreImmutable storeString) , '.';
+ nextPutLine:'Compiler lineNumberInfo: ' , (Compiler lineNumberInfo storeString) , '.';
+
+ nextPutLine:'Compiler foldConstants: ' , (Compiler foldConstants storeString) , '.';
+ nextPutLine:'ParserFlags stcCompilation: ' , (ParserFlags stcCompilation storeString) , '.';
+ nextPutLine:'OperatingSystem getOSType = ' , (OperatingSystem getOSType storeString) , ' ifTrue:[';
+ nextPutLine:' ParserFlags stcCompilationIncludes: ' , (ParserFlags stcCompilationIncludes storeString) , '.';
+ nextPutLine:' ParserFlags stcCompilationDefines: ' , (ParserFlags stcCompilationDefines storeString) , '.';
+ nextPutLine:' ParserFlags stcCompilationOptions: ' , (ParserFlags stcCompilationOptions storeString) , '.';
+ nextPutLine:' ' , (ParserFlags stcModulePath storeString) , ' asFilename exists ifTrue:[';
+ nextPutLine:' ParserFlags stcModulePath: ' , (ParserFlags stcModulePath storeString) , '.';
+ nextPutLine:' ].';
+ nextPutLine:' ParserFlags stcPath: ' , (ParserFlags stcPath storeString) , '.';
+ nextPutLine:' ParserFlags ccCompilationOptions: ' , (ParserFlags ccCompilationOptions storeString) , '.';
+ nextPutLine:' ParserFlags ccPath: ' , (ParserFlags ccPath storeString) , '.';
+ nextPutLine:' ParserFlags linkArgs: ' , (ParserFlags linkArgs storeString) , '.';
+ nextPutLine:' ParserFlags linkSharedArgs: ' , (ParserFlags linkSharedArgs storeString) , '.';
+ nextPutLine:' ParserFlags linkCommand: ' , (ParserFlags linkCommand storeString) , '.';
+ nextPutLine:' ParserFlags makeCommand: ' , (ParserFlags makeCommand storeString) , '.';
+ nextPutLine:' ParserFlags libPath: ' , (ParserFlags libPath storeString) , '.';
+ nextPutLine:' ParserFlags searchedLibraries: ' , (ParserFlags searchedLibraries storeString) , '.';
+ nextPutLine:'].';
+
+ nextPutLine:'ObjectMemory justInTimeCompilation: ' , (ObjectMemory justInTimeCompilation storeString) , '.';
+ nextPutLine:'ObjectMemory fullSingleStepSupport: ' , (ObjectMemory fullSingleStepSupport storeString) , '.'.
+
+ HistoryManager notNil ifTrue:[
+ HistoryManager isActive ifTrue:[
+ s nextPutLine:'HistoryManager notNil ifTrue:[HistoryManager activate].'.
+ s nextPutLine:'HistoryManager notNil ifTrue:[HistoryManager fullHistoryUpdate:' , HistoryManager fullHistoryUpdate storeString , '].'.
+ ] ifFalse:[
+ s nextPutLine:'HistoryManager notNil ifTrue:[HistoryManager deactivate].'.
+ ].
+ ].
+
+ s nextPutLine:'Class catchMethodRedefinitions: ' , (Class catchMethodRedefinitions storeString) , '.'.
+ s nextPutLine:'ClassCategoryReader sourceMode: ' , (ClassCategoryReader sourceMode storeString) , '.'.
+
+ s cr.
+ s nextPutLine:'"/'.
+ s nextPutLine:'"/ Info & Debug Messages:'.
+ s nextPutLine:'"/'.
+ s nextPutLine:'Smalltalk hasNoConsole ifFalse:[ ObjectMemory infoPrinting: ' , (ObjectMemory infoPrinting storeString) , '].';
+ nextPutLine:'ObjectMemory debugPrinting: ' , (ObjectMemory debugPrinting storeString) , '.';
+ nextPutLine:'Smalltalk hasNoConsole ifFalse:[ Object infoPrinting: ' , (Object infoPrinting storeString) , '].';
+ nextPutLine:'DeviceWorkstation errorPrinting: ' , (DeviceWorkstation errorPrinting storeString) , '.'.
+
+ "/ FlyByHelp isActive ifTrue:[
+ "/ s nextPutLine:'FlyByHelp start.'
+ "/ ].
+
+ s cr.
+ s nextPutLine:'"/'.
+ s nextPutLine:'"/ Edit settings:'.
+ s nextPutLine:'"/'.
+ "/ s nextPutLine:'EditTextView st80Mode: ' , (EditTextView st80Mode storeString) , '.'.
+ s nextPutLine:'TextView st80SelectMode: ' , (TextView st80SelectMode storeString) , '.'.
+ s nextPutLine:'UserPreferences current syntaxColoring: ' , (userPrefs syntaxColoring storeString) , '.'.
+ (ListView userDefaultTabPositions = ListView tab4Positions) ifTrue:[
+ s nextPutLine:'ListView userDefaultTabPositions:(ListView tab4Positions).'.
] ifFalse:[
- s nextPutLine:'HistoryManager notNil ifTrue:[HistoryManager deactivate].'.
+ s nextPutLine:'ListView userDefaultTabPositions:(ListView tab8Positions).'.
+ ].
+
+ s nextPutLine:'"/'.
+ s nextPutLine:'"/ User preference values:'.
+ s nextPutLine:'"/'.
+ userPrefs keysAndValuesDo:[:k :v |
+ |putSelector|
+
+ putSelector := (k , ':') asSymbolIfInterned.
+ (UserPreferences includesSelector:putSelector) ifTrue:[
+ s nextPutAll:'UserPreferences current ';
+ nextPutAll:putSelector.
+ ] ifFalse:[
+ s nextPutAll:'UserPreferences current at:'.
+ k storeOn:s.
+ s nextPutAll:' put:'.
+ ].
+ v storeOn:s.
+ s nextPut:$.; cr.
+ ].
+
+ s cr.
+ s nextPutLine:'"/'.
+ s nextPutLine:'"/ GC settings:'.
+ s nextPutLine:'"/'.
+ s nextPutLine:'ObjectMemory newSpaceSize: ' , (ObjectMemory newSpaceSize storeString) , '.';
+ nextPutLine:'ObjectMemory dynamicCodeGCTrigger: ' , (ObjectMemory dynamicCodeGCTrigger storeString) , '.';
+ nextPutLine:'ObjectMemory freeSpaceGCAmount: ' , (ObjectMemory freeSpaceGCAmount storeString) , '.';
+ nextPutLine:'ObjectMemory freeSpaceGCLimit: ' , (ObjectMemory freeSpaceGCLimit storeString) , '.';
+ nextPutLine:'ObjectMemory incrementalGCLimit: ' , (ObjectMemory incrementalGCLimit storeString) , '.';
+ nextPutLine:'ObjectMemory oldSpaceCompressLimit: ' , (ObjectMemory oldSpaceCompressLimit storeString) , '.';
+ nextPutLine:'ObjectMemory oldSpaceIncrement: ' , (ObjectMemory oldSpaceIncrement storeString) , '.'.
+
+ s cr.
+ s nextPutLine:'"/'.
+ s nextPutLine:'"/ Misc settings:'.
+ s nextPutLine:'"/'.
+ s nextPutLine:'Class keepMethodHistory: ' , (Class methodHistory notNil storeString) , '.';
+ nextPutLine:'Smalltalk logDoits: ' , (Smalltalk logDoits storeString) , '.';
+ nextPutLine:'Autoload compileLazy: ' , (Autoload compileLazy storeString) , '.';
+ nextPutLine:'Smalltalk loadBinaries: ' , (Smalltalk loadBinaries storeString) , '.';
+ nextPutLine:'StandardSystemView includeHostNameInLabel: ' , (StandardSystemView includeHostNameInLabel storeString) , '.';
+
+ "/ claus - I dont think its a good idea to save those ...
+ "/ nextPutLine:'"/ Class updateChanges: ' , (Class updatingChanges storeString) , '.';
+ "/ nextPutLine:'"/ ObjectMemory nameForChanges: ' , (ObjectMemory nameForChanges storeString) , '.';
+
+ nextPutLine:'StandardSystemView returnFocusWhenClosingModalBoxes: ' , (StandardSystemView returnFocusWhenClosingModalBoxes storeString) , '.';
+ nextPutLine:'StandardSystemView takeFocusWhenMapped: ' , (StandardSystemView takeFocusWhenMapped storeString) , '.';
+ nextPutLine:'Display notNil ifTrue:[';
+ nextPutLine:' Display activateOnClick: ' , ((screen activateOnClick:nil) storeString) , '.';
+ nextPutLine:'].';
+ nextPutLine:'MenuView showAcceleratorKeys: ' , (MenuView showAcceleratorKeys storeString) , '.';
+ nextPutLine:'Class tryLocalSourceFirst: ' , (Class tryLocalSourceFirst storeString) , '.'.
+ (NoHandlerError emergencyHandler == AbstractLauncherApplication notifyingEmergencyHandler) ifTrue:[
+ s nextPutLine:'NoHandlerError emergencyHandler:(AbstractLauncherApplication notifyingEmergencyHandler).'.
+ ].
+ Processor isTimeSlicing ifTrue:[
+ s nextPutLine:'Processor startTimeSlicing.'.
+ s nextPutLine:('Processor supportDynamicPriorities:' , (Processor supportDynamicPriorities ? false) storeString , '.').
+ ] ifFalse:[
+ s nextPutLine:'Processor stopTimeSlicing.'.
+ ].
+
+ s cr.
+ s nextPutLine:'"/'.
+ s nextPutLine:'"/ Printer settings:'.
+ s nextPutLine:'"/'.
+ Printer notNil ifTrue:[
+ s nextPutLine:'Printer := ' , (Printer name) , '.'.
+ Printer supportsPrintingToCommand ifTrue:[
+ s nextPutLine:'Printer printCommand: ' , (Printer printCommand storeString) , '.'.
+ ].
+ Printer supportsPageSizes ifTrue:[
+ s nextPutLine:'Printer pageFormat: ' , (Printer pageFormat storeString) , '.'.
+ s nextPutLine:'Printer landscape: ' , (Printer landscape storeString) , '.'.
+ ].
+ Printer supportsMargins ifTrue:[
+ s nextPutLine:'Printer topMargin: ' , (Printer topMargin storeString) , '.'.
+ s nextPutLine:'Printer leftMargin: ' , (Printer leftMargin storeString) , '.'.
+ s nextPutLine:'Printer rightMargin: ' , (Printer rightMargin storeString) , '.'.
+ s nextPutLine:'Printer bottomMargin: ' , (Printer bottomMargin storeString) , '.'.
+ ].
+ Printer supportsPostscript ifTrue:[
+ s nextPutLine:'Printer supportsColor: ' , (Printer supportsColor storeString) , '.'.
+ ].
+ ].
+ s cr.
+ s nextPutLine:'"/'.
+ s nextPutLine:'"/ Font settings:'.
+ s nextPutLine:'"/ (only restored, if image is restarted on the same display)'.
+ s nextPutLine:'"/'.
+ s nextPutLine:'Display notNil ifTrue:['.
+ s nextPutLine:' Display displayName = ' , (screen displayName storeString) , ' ifTrue:['.
+ s nextPutLine:' View defaultFont: ' , (View defaultFont storeString) , '.'.
+ s nextPutLine:' Label defaultFont: ' , (Label defaultFont storeString) , '.'.
+ s nextPutLine:' Button defaultFont: ' , (Button defaultFont storeString) , '.'.
+ s nextPutLine:' Toggle defaultFont: ' , (Toggle defaultFont storeString) , '.'.
+ s nextPutLine:' SelectionInListView defaultFont: ' , (SelectionInListView defaultFont storeString) , '.'.
+ s nextPutLine:' MenuView defaultFont: ' , (MenuView defaultFont storeString) , '.'.
+ s nextPutLine:' MenuPanel defaultFont: ' , (MenuPanel defaultFont storeString) , '.'.
+ s nextPutLine:' NoteBookView defaultFont: ' , (NoteBookView defaultFont storeString) , '.'.
+ s nextPutLine:' PullDownMenu defaultFont: ' , (PullDownMenu defaultFont storeString) , '.'.
+ s nextPutLine:' TextView defaultFont: ' , (TextView defaultFont storeString) , '.'.
+ s nextPutLine:' EditTextView defaultFont: ' , (EditTextView defaultFont storeString) , '.'.
+ s nextPutLine:' CodeView defaultFont: ' , (CodeView defaultFont storeString) , '.'.
+ s nextPutLine:' ].'.
+ s nextPutLine:'].'.
+
+ s cr.
+ s nextPutLine:'"/'.
+ s nextPutLine:'"/ SourceCodeManager settings:'.
+ s nextPutLine:'"/ (repositories are networked nowadays, so the settings are host independent)'.
+ s nextPutLine:'"/'.
+ s nextPutLine:'Class tryLocalSourceFirst:' , Class tryLocalSourceFirst storeString , '.'.
+ s nextPutLine:'AbstractSourceCodeManager cacheDirectoryName:' , AbstractSourceCodeManager cacheDirectoryName storeString , '.'.
+
+ AbstractSourceCodeManager availableManagers do:[:eachManager |
+ eachManager savePreferencesOn:s
].
].
- s nextPutLine:'Class catchMethodRedefinitions: ' , (Class catchMethodRedefinitions storeString) , '.'.
- s nextPutLine:'ClassCategoryReader sourceMode: ' , (ClassCategoryReader sourceMode storeString) , '.'.
-
- s cr.
- s nextPutLine:'"/'.
- s nextPutLine:'"/ Info & Debug Messages:'.
- s nextPutLine:'"/'.
- s nextPutLine:'Smalltalk hasNoConsole ifFalse:[ ObjectMemory infoPrinting: ' , (ObjectMemory infoPrinting storeString) , '].';
- nextPutLine:'ObjectMemory debugPrinting: ' , (ObjectMemory debugPrinting storeString) , '.';
- nextPutLine:'Smalltalk hasNoConsole ifFalse:[ Object infoPrinting: ' , (Object infoPrinting storeString) , '].';
- nextPutLine:'DeviceWorkstation errorPrinting: ' , (DeviceWorkstation errorPrinting storeString) , '.'.
-
-"/ FlyByHelp isActive ifTrue:[
-"/ s nextPutLine:'FlyByHelp start.'
-"/ ].
-
- s cr.
- s nextPutLine:'"/'.
- s nextPutLine:'"/ Edit settings:'.
- s nextPutLine:'"/'.
- "/ s nextPutLine:'EditTextView st80Mode: ' , (EditTextView st80Mode storeString) , '.'.
- s nextPutLine:'TextView st80SelectMode: ' , (TextView st80SelectMode storeString) , '.'.
- s nextPutLine:'UserPreferences current syntaxColoring: ' , (userPrefs syntaxColoring storeString) , '.'.
- (ListView userDefaultTabPositions = ListView tab4Positions) ifTrue:[
- s nextPutLine:'ListView userDefaultTabPositions:(ListView tab4Positions).'.
- ] ifFalse:[
- s nextPutLine:'ListView userDefaultTabPositions:(ListView tab8Positions).'.
- ].
-
- s nextPutLine:'"/'.
- s nextPutLine:'"/ User preference values:'.
- s nextPutLine:'"/'.
- userPrefs keysAndValuesDo:[:k :v |
- |putSelector|
-
- putSelector := (k , ':') asSymbolIfInterned.
- (UserPreferences includesSelector:putSelector) ifTrue:[
- s nextPutAll:'UserPreferences current ';
- nextPutAll:putSelector.
- ] ifFalse:[
- s nextPutAll:'UserPreferences current at:'.
- k storeOn:s.
- s nextPutAll:' put:'.
- ].
- v storeOn:s.
- s nextPut:$.; cr.
- ].
-
- s cr.
- s nextPutLine:'"/'.
- s nextPutLine:'"/ GC settings:'.
- s nextPutLine:'"/'.
- s nextPutLine:'ObjectMemory newSpaceSize: ' , (ObjectMemory newSpaceSize storeString) , '.';
- nextPutLine:'ObjectMemory dynamicCodeGCTrigger: ' , (ObjectMemory dynamicCodeGCTrigger storeString) , '.';
- nextPutLine:'ObjectMemory freeSpaceGCAmount: ' , (ObjectMemory freeSpaceGCAmount storeString) , '.';
- nextPutLine:'ObjectMemory freeSpaceGCLimit: ' , (ObjectMemory freeSpaceGCLimit storeString) , '.';
- nextPutLine:'ObjectMemory incrementalGCLimit: ' , (ObjectMemory incrementalGCLimit storeString) , '.';
- nextPutLine:'ObjectMemory oldSpaceCompressLimit: ' , (ObjectMemory oldSpaceCompressLimit storeString) , '.';
- nextPutLine:'ObjectMemory oldSpaceIncrement: ' , (ObjectMemory oldSpaceIncrement storeString) , '.'.
-
- s cr.
- s nextPutLine:'"/'.
- s nextPutLine:'"/ Misc settings:'.
- s nextPutLine:'"/'.
- s nextPutLine:'Class keepMethodHistory: ' , (Class methodHistory notNil storeString) , '.';
- nextPutLine:'Smalltalk logDoits: ' , (Smalltalk logDoits storeString) , '.';
- nextPutLine:'Autoload compileLazy: ' , (Autoload compileLazy storeString) , '.';
- nextPutLine:'Smalltalk loadBinaries: ' , (Smalltalk loadBinaries storeString) , '.';
- nextPutLine:'StandardSystemView includeHostNameInLabel: ' , (StandardSystemView includeHostNameInLabel storeString) , '.';
-
- "/ claus - I dont think its a good idea to save those ...
-"/ nextPutLine:'"/ Class updateChanges: ' , (Class updatingChanges storeString) , '.';
-"/ nextPutLine:'"/ ObjectMemory nameForChanges: ' , (ObjectMemory nameForChanges storeString) , '.';
-
- nextPutLine:'StandardSystemView returnFocusWhenClosingModalBoxes: ' , (StandardSystemView returnFocusWhenClosingModalBoxes storeString) , '.';
- nextPutLine:'StandardSystemView takeFocusWhenMapped: ' , (StandardSystemView takeFocusWhenMapped storeString) , '.';
- nextPutLine:'Display notNil ifTrue:[';
- nextPutLine:' Display activateOnClick: ' , ((screen activateOnClick:nil) storeString) , '.';
- nextPutLine:'].';
- nextPutLine:'MenuView showAcceleratorKeys: ' , (MenuView showAcceleratorKeys storeString) , '.';
- nextPutLine:'Class tryLocalSourceFirst: ' , (Class tryLocalSourceFirst storeString) , '.'.
- (NoHandlerError emergencyHandler == AbstractLauncherApplication notifyingEmergencyHandler) ifTrue:[
- s nextPutLine:'NoHandlerError emergencyHandler:(AbstractLauncherApplication notifyingEmergencyHandler).'.
- ].
- Processor isTimeSlicing ifTrue:[
- s nextPutLine:'Processor startTimeSlicing.'.
- s nextPutLine:('Processor supportDynamicPriorities:' , (Processor supportDynamicPriorities ? false) storeString , '.').
- ] ifFalse:[
- s nextPutLine:'Processor stopTimeSlicing.'.
- ].
-
- s cr.
- s nextPutLine:'"/'.
- s nextPutLine:'"/ Printer settings:'.
- s nextPutLine:'"/'.
- Printer notNil ifTrue:[
- s nextPutLine:'Printer := ' , (Printer name) , '.'.
- Printer supportsPrintingToCommand ifTrue:[
- s nextPutLine:'Printer printCommand: ' , (Printer printCommand storeString) , '.'.
- ].
- Printer supportsPageSizes ifTrue:[
- s nextPutLine:'Printer pageFormat: ' , (Printer pageFormat storeString) , '.'.
- s nextPutLine:'Printer landscape: ' , (Printer landscape storeString) , '.'.
- ].
- Printer supportsMargins ifTrue:[
- s nextPutLine:'Printer topMargin: ' , (Printer topMargin storeString) , '.'.
- s nextPutLine:'Printer leftMargin: ' , (Printer leftMargin storeString) , '.'.
- s nextPutLine:'Printer rightMargin: ' , (Printer rightMargin storeString) , '.'.
- s nextPutLine:'Printer bottomMargin: ' , (Printer bottomMargin storeString) , '.'.
- ].
- Printer supportsPostscript ifTrue:[
- s nextPutLine:'Printer supportsColor: ' , (Printer supportsColor storeString) , '.'.
- ].
- ].
- s cr.
- s nextPutLine:'"/'.
- s nextPutLine:'"/ Font settings:'.
- s nextPutLine:'"/ (only restored, if image is restarted on the same display)'.
- s nextPutLine:'"/'.
- s nextPutLine:'Display notNil ifTrue:['.
- s nextPutLine:' Display displayName = ' , (screen displayName storeString) , ' ifTrue:['.
- s nextPutLine:' View defaultFont: ' , (View defaultFont storeString) , '.'.
- s nextPutLine:' Label defaultFont: ' , (Label defaultFont storeString) , '.'.
- s nextPutLine:' Button defaultFont: ' , (Button defaultFont storeString) , '.'.
- s nextPutLine:' Toggle defaultFont: ' , (Toggle defaultFont storeString) , '.'.
- s nextPutLine:' SelectionInListView defaultFont: ' , (SelectionInListView defaultFont storeString) , '.'.
- s nextPutLine:' MenuView defaultFont: ' , (MenuView defaultFont storeString) , '.'.
- s nextPutLine:' MenuPanel defaultFont: ' , (MenuPanel defaultFont storeString) , '.'.
- s nextPutLine:' NoteBookView defaultFont: ' , (NoteBookView defaultFont storeString) , '.'.
- s nextPutLine:' PullDownMenu defaultFont: ' , (PullDownMenu defaultFont storeString) , '.'.
- s nextPutLine:' TextView defaultFont: ' , (TextView defaultFont storeString) , '.'.
- s nextPutLine:' EditTextView defaultFont: ' , (EditTextView defaultFont storeString) , '.'.
- s nextPutLine:' CodeView defaultFont: ' , (CodeView defaultFont storeString) , '.'.
- s nextPutLine:' ].'.
- s nextPutLine:'].'.
-
- s cr.
- s nextPutLine:'"/'.
- s nextPutLine:'"/ SourceCodeManager settings:'.
- s nextPutLine:'"/ (repositories are networked nowadays, so the settings are host independent)'.
- s nextPutLine:'"/'.
- s nextPutLine:'Class tryLocalSourceFirst:' , Class tryLocalSourceFirst storeString , '.'.
- s nextPutLine:'AbstractSourceCodeManager cacheDirectoryName:' , AbstractSourceCodeManager cacheDirectoryName storeString , '.'.
-
- AbstractSourceCodeManager availableManagers do:[:eachManager |
- eachManager savePreferencesOn:s
- ].
-
- s close.
-
"
Transcript topView application saveSettings
"
@@ -662,6 +660,75 @@
"Modified: / 22-02-2012 / 13:22:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+!UserPreferences methodsFor:'accessing-misc'!
+
+selectorNamespacesEnabled
+ "Return true, if selector namespaces support is enabled
+ for this system. Note, that this method may return true
+ even if selector namespaces are not supported by this system.
+
+ This is rather user setting. To ask whether the selector namespaces
+ support should be used, use:
+
+ UserPreferences current selectorNamespacesSupportedAndEnabled
+ "
+
+ ^self at:#selectorNamespacesEnabled ifAbsent:[false].
+
+ "
+ UserPreferences current selectorNamespacesEnabled
+ UserPreferences current selectorNamespacesSupportedAndEnabled
+
+ UserPreferences current selectorNamespacesEnabled: true.
+ UserPreferences current selectorNamespacesEnabled: false.
+ "
+
+ "Created: / 19-07-2012 / 15:26:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+selectorNamespacesEnabled: aBoolean
+ "Enables/disables selector namespaces support for this system.
+ Please note that even if selector namespaces are enabled here,
+ they may not be supported by the system/VM.
+
+ This is rather user setting. To ask whether the selector namespaces
+ are supported use
+
+ ConfigurableFeatures includesFeature:#SelectorNamespaces
+ "
+
+ self at:#selectorNamespacesEnabled put: aBoolean
+
+ "
+ UserPreferences current selectorNamespacesEnabled
+ UserPreferences current selectorNamespacesSupportedAndEnabled
+
+ UserPreferences current selectorNamespacesEnabled: true.
+ UserPreferences current selectorNamespacesEnabled: false.
+ "
+
+ "Created: / 19-07-2012 / 15:27:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+selectorNamespacesSupportedAndEnabled
+ "Return true, if selector namespaces are both enabled
+ and supported by this system/VM, false otherwise
+ "
+
+ ^ (ConfigurableFeatures includesFeature:#SelectorNamespaces)
+ and:[self selectorNamespacesEnabled]
+
+ "
+ UserPreferences current selectorNamespacesEnabled
+ UserPreferences current selectorNamespacesSupportedAndEnabled
+
+ UserPreferences current selectorNamespacesEnabled: true.
+ UserPreferences current selectorNamespacesEnabled: false.
+ "
+
+ "Created: / 19-07-2012 / 15:32:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
!UserPreferences methodsFor:'accessing-misc-communication'!
dotNetBridgeRunsInIDE
@@ -812,6 +879,15 @@
^ ChangeSetBrowser.
"/^ Tools::ChangeSetBrowser2 ? ChangeSetBrowser
+ self useNewChangeSetBrowser ifTrue:[
+ ^ Tools::ChangeSetBrowser2 ? ChangeSetBrowser
+ ].
+ ^ ChangeSetBrowser
+
+ "
+ self current changeSetBrowserClass
+ "
+
"Created: / 01-07-2011 / 16:33:13 / cg"
"Modified: / 25-07-2011 / 12:21:42 / sr"
"Modified: / 25-01-2012 / 17:11:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
@@ -945,16 +1021,34 @@
"Modified: / 24-08-2010 / 17:02:13 / sr"
!
+useNewChangeSetBrowser
+ "using old or jan's changeSetBrowser for package diffs"
+
+ ^ self at:#useNewChangeSetBrowser ifAbsent:false
+
+ "Modified: / 13-10-1998 / 15:53:05 / cg"
+ "Created: / 26-07-2012 / 15:06:31 / cg"
+!
+
+useNewChangeSetBrowser:aBoolean
+ "using old or jan's changeSetBrowser for package diffs"
+
+ ^ self at:#useNewChangeSetBrowser put:aBoolean
+
+ "Created: / 26-07-2012 / 15:06:50 / cg"
+!
+
useNewChangesBrowser
- "using new or old change browser"
+ "using new or old change browser for the changes file"
^ self at:#useNewChangesBrowser ifAbsent:false
- "Modified: / 13.10.1998 / 15:53:05 / cg"
+ "Modified: / 13-10-1998 / 15:53:05 / cg"
+ "Modified (comment): / 26-07-2012 / 15:04:37 / cg"
!
useNewChangesBrowser:aBoolean
- "using new or old changeBrowser"
+ "using new or old changeBrowser for the changes file"
self at:#useNewChangesBrowser put:aBoolean
@@ -962,7 +1056,8 @@
UserPreferences current useNewChangesBrowser
"
- "Modified: / 13.10.1998 / 15:53:21 / cg"
+ "Modified: / 13-10-1998 / 15:53:21 / cg"
+ "Modified (comment): / 26-07-2012 / 15:04:39 / cg"
!
useNewFileBrowser
@@ -1334,10 +1429,6 @@
"Created: / 29-11-2010 / 19:47:36 / cg"
!
-
-
-
-
expandSelectionOnMouseMoveWithButtonPressed
"expand the selection in a selectionInListView if the mouse is pressed while moving over
more lines. Default is not FALSE !!"
@@ -3997,13 +4088,13 @@
!UserPreferences class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/UserPreferences.st,v 1.309 2012/06/10 19:25:07 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/UserPreferences.st,v 1.313 2012/08/10 10:50:13 stefan Exp $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/UserPreferences.st,v 1.309 2012/06/10 19:25:07 cg Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/UserPreferences.st,v 1.313 2012/08/10 10:50:13 stefan Exp §'
!
version_SVN
- ^ '$Id: UserPreferences.st 10824 2012-07-18 16:55:48Z vranyj1 $'
+ ^ '$ Id: UserPreferences.st 10648 2011-06-23 15:55:10Z vranyj1 $'
! !
--- a/WeakDependencyDictionary.st Fri Sep 07 13:46:06 2012 +0100
+++ b/WeakDependencyDictionary.st Fri Sep 07 17:24:32 2012 +0100
@@ -55,12 +55,10 @@
"return a container for keys of size n.
use WeakArrays here."
- |w|
+ ^ WeakArray new:n.
- w := WeakArray new:n.
- ^ w
-
- "Modified: 7.1.1997 / 17:01:15 / stefan"
+ "Modified: / 07-01-1997 / 17:01:15 / stefan"
+ "Modified: / 04-08-2012 / 14:55:53 / cg"
! !
!WeakDependencyDictionary methodsFor:'special dependency support'!
@@ -165,11 +163,11 @@
!WeakDependencyDictionary class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/WeakDependencyDictionary.st,v 1.13 2011/09/29 11:19:05 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/WeakDependencyDictionary.st,v 1.14 2012/08/06 12:38:10 cg Exp $'
!
version_SVN
- ^ '$Id: WeakDependencyDictionary.st 10761 2012-01-19 11:46:00Z vranyj1 $'
+ ^ '$Id: WeakDependencyDictionary.st 10844 2012-09-07 16:24:32Z vranyj1 $'
! !
--- a/WeakIdentitySet.st Fri Sep 07 13:46:06 2012 +0100
+++ b/WeakIdentitySet.st Fri Sep 07 17:24:32 2012 +0100
@@ -104,6 +104,9 @@
element notNil ifTrue:[
element ~~ 0 ifTrue:[
element ~~ DeletedEntry ifTrue:[
+ element == NilEntry ifTrue:[
+ element := nil.
+ ].
^ element
]
]
@@ -296,11 +299,11 @@
!WeakIdentitySet class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/WeakIdentitySet.st,v 1.37 2011/09/29 11:19:18 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/WeakIdentitySet.st,v 1.38 2012/08/13 16:45:53 stefan Exp $'
!
version_SVN
- ^ '$Id: WeakIdentitySet.st 10761 2012-01-19 11:46:00Z vranyj1 $'
+ ^ '$Id: WeakIdentitySet.st 10844 2012-09-07 16:24:32Z vranyj1 $'
! !
--- a/WeakValueDictionary.st Fri Sep 07 13:46:06 2012 +0100
+++ b/WeakValueDictionary.st Fri Sep 07 17:24:32 2012 +0100
@@ -200,7 +200,7 @@
Definition of 'too empty' is 'filled less than 12.5% (i.e. 1/8th)'"
self clearDeadSlots.
- ^super emptyCheck
+ super emptyCheck
!
slotIsEmpty:probe
@@ -263,11 +263,11 @@
!WeakValueDictionary class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/WeakValueDictionary.st,v 1.18 2011/09/29 11:19:01 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/WeakValueDictionary.st,v 1.19 2012/08/13 11:13:51 stefan Exp $'
!
version_SVN
- ^ '$Id: WeakValueDictionary.st 10761 2012-01-19 11:46:00Z vranyj1 $'
+ ^ '$Id: WeakValueDictionary.st 10844 2012-09-07 16:24:32Z vranyj1 $'
! !
--- a/abbrev.stc Fri Sep 07 13:46:06 2012 +0100
+++ b/abbrev.stc Fri Sep 07 17:24:32 2012 +0100
@@ -390,3 +390,4 @@
MiniLogger MiniLogger stx:libbasic 'System-Debugging-Support' 0
PolymorphicInlineCache PolymorphicInlineCache stx:libbasic 'Kernel-Classes' 0
CharacterEncoderImplementations::ISO10646_to_XMLUTF8 CharacterEncoderImplementations__ISO10646_to_XMLUTF8 stx:libbasic 'Collections-Text-Encodings' 0
+MethodWithBreakpoints MethodWithBreakpoints stx:libbasic 'Kernel-Methods' 0
--- a/bc.mak Fri Sep 07 13:46:06 2012 +0100
+++ b/bc.mak Fri Sep 07 17:24:32 2012 +0100
@@ -15,7 +15,7 @@
# bmake clobber - clean all
#
# Historic Note:
-# this used to contain only rules to make with borland
+# this used to contain only rules to make with borland
# (called via bmake, by "make.exe -f bc.mak")
# this has changed; it is now also possible to build using microsoft visual c
# (called via vcmake, by "make.exe -f bc.mak -DUSEVC")
@@ -385,5 +385,6 @@
$(OUTDIR)Win32FILEHandle.$(O) Win32FILEHandle.$(H): Win32FILEHandle.st $(STCHDR)
$(OUTDIR)Win32Constants.$(O) Win32Constants.$(H): Win32Constants.st $(STCHDR)
$(OUTDIR)Win32OperatingSystem.$(O) Win32OperatingSystem.$(H): Win32OperatingSystem.st $(STCHDR)
+$(OUTDIR)MethodWithBreakpoints.$(O) MethodWithBreakpoints.$(H): MethodWithBreakpoints.st $(INCLUDE_TOP)\stx\libbasic\Method.$(H) $(INCLUDE_TOP)\stx\libbasic\CompiledCode.$(H) $(INCLUDE_TOP)\stx\libbasic\ExecutableFunction.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
# ENDMAKEDEPEND --- do not remove this line
--- a/libInit.cc Fri Sep 07 13:46:06 2012 +0100
+++ b/libInit.cc Fri Sep 07 17:24:32 2012 +0100
@@ -345,6 +345,7 @@
_PipeStream_Init(pass,__pRT__,snd);
_Symbol_Init(pass,__pRT__,snd);
_Unicode16String_Init(pass,__pRT__,snd);
+_MethodWithBreakpoints_Init(pass,__pRT__,snd);
#ifdef UNIX
_UnixDesktop_Init(pass,__pRT__,snd);
_XDGDesktop_Init(pass,__pRT__,snd);
--- a/libbasic.rc Fri Sep 07 13:46:06 2012 +0100
+++ b/libbasic.rc Fri Sep 07 17:24:32 2012 +0100
@@ -3,8 +3,8 @@
// automagically generated from the projectDefinition: stx_libbasic.
//
VS_VERSION_INFO VERSIONINFO
- FILEVERSION 6,2,0,1
- PRODUCTVERSION 6,2,3,1
+ FILEVERSION 6,2,1,101
+ PRODUCTVERSION 6,2,2,1
#if (__BORLANDC__)
FILEFLAGSMASK VS_FF_DEBUG | VS_FF_PRERELEASE
FILEFLAGS VS_FF_PRERELEASE | VS_FF_SPECIALBUILD
@@ -20,12 +20,12 @@
BEGIN
VALUE "CompanyName", "eXept Software AG\0"
VALUE "FileDescription", "Smalltalk/X Basic Classes (LIB)\0"
- VALUE "FileVersion", "6.2.0.1\0"
+ VALUE "FileVersion", "6.2.1.101\0"
VALUE "InternalName", "stx:libbasic\0"
VALUE "LegalCopyright", "Copyright Claus Gittinger 1988-2012\nCopyright eXept Software AG 1998-2012\0"
VALUE "ProductName", "Smalltalk/X\0"
- VALUE "ProductVersion", "6.2.3.1\0"
- VALUE "ProductDate", "Fri, 07 Sep 2012 10:46:20 GMT\0"
+ VALUE "ProductVersion", "6.2.2.1\0"
+ VALUE "ProductDate", "Thu, 02 Aug 2012 19:44:35 GMT\0"
END
END
--- a/stx_libbasic.st Fri Sep 07 13:46:06 2012 +0100
+++ b/stx_libbasic.st Fri Sep 07 17:24:32 2012 +0100
@@ -506,6 +506,7 @@
MiniLogger
PolymorphicInlineCache
(#'CharacterEncoderImplementations::ISO10646_to_XMLUTF8' autoload)
+ MethodWithBreakpoints
)
!
@@ -572,7 +573,7 @@
!stx_libbasic class methodsFor:'documentation'!
version
- ^ '$Id: stx_libbasic.st 10842 2012-09-07 10:49:18Z vranyj1 $'
+ ^ '$Id: stx_libbasic.st 10844 2012-09-07 16:24:32Z vranyj1 $'
!
version_CVS
@@ -580,5 +581,5 @@
!
version_SVN
- ^ '$Id:: stx_libbasic.st 10842 2012-09-07 10:49:18Z vranyj1 $'
+ ^ '$Id:: stx_libbasic.st 10844 2012-09-07 16:24:32Z vranyj1 $'
! !