--- a/.hgtags Tue Apr 30 10:54:00 2013 +0100
+++ b/.hgtags Tue May 21 21:58:09 2013 +0100
@@ -26,6 +26,7 @@
498aaf09d52bbd5b750814e7e4452c8b9fbaa9b4 expecco_1_7_0b2
4cfcb1c3d0cc3098ffb5af37a66b5789b3c9e14a rel5_1_3
4cfcb1c3d0cc3098ffb5af37a66b5789b3c9e14a stx_513
+64d7fa3c9c63367e0a96cd8bcfba3ac77fc97bda expecco_2_5_0
6516bfb2ae56ebcb9dee9ca2ccd2acb80a9a1e88 expecco_1_0_3
66c655c1a7cbe4cff09bf03fd379abed2ee0c539 expecco_1_5_0
6dcd44bc2ff92d95c87750dece318217585ea275 expeccoNET_1_4_0rc1
--- a/AbstractOperatingSystem.st Tue Apr 30 10:54:00 2013 +0100
+++ b/AbstractOperatingSystem.st Tue May 21 21:58:09 2013 +0100
@@ -1169,228 +1169,230 @@
terminateLock := Semaphore forMutualExclusion.
((externalInStream := anInStream) notNil
and:[externalInStream isExternalStream not]) ifTrue:[
- pIn := NonPositionableExternalStream makePipe.
- inStreamToClose := externalInStream := pIn at:1.
- shuffledInStream := pIn at:2.
- anInStream isBinary ifTrue:[
- shuffledInStream binary
- ].
- lineWise ifFalse:[
- shuffledInStream blocking:false.
- ].
-
- "/ start a reader process, shuffling data from the given
- "/ inStream to the pipe (which is connected to the commands input)
- inputShufflerProcess :=
- [
- [
- [anInStream atEnd] whileFalse:[
- self shuffleFrom:anInStream to:shuffledInStream lineWise:lineWise.
- shuffledInStream flush
- ]
- ] ensure:[
- shuffledInStream close
- ]
- ] newProcess
- name:'cmd input shuffler';
+ pIn := NonPositionableExternalStream makePipe.
+ inStreamToClose := externalInStream := pIn at:1.
+ shuffledInStream := pIn at:2.
+ anInStream isBinary ifTrue:[
+ shuffledInStream binary
+ ].
+ lineWise ifFalse:[
+ shuffledInStream blocking:false.
+ ].
+
+ "/ start a reader process, shuffling data from the given
+ "/ inStream to the pipe (which is connected to the commands input)
+ inputShufflerProcess :=
+ [
+ [
+ [anInStream atEnd] whileFalse:[
+ self shuffleFrom:anInStream to:shuffledInStream lineWise:lineWise.
+ shuffledInStream flush
+ ]
+ ] ensure:[
+ shuffledInStream close
+ ]
+ ] newProcess
+ name:'cmd input shuffler';
"/ beSystemProcess;
- resume.
+ resume.
].
((externalOutStream := anOutStream) notNil
and:[externalOutStream isExternalStream not]) ifTrue:[
- pOut := NonPositionableExternalStream makePipe.
- shuffledOutStream := (pOut at:1).
- anOutStream isBinary ifTrue:[
- shuffledOutStream binary
- ].
- outStreamToClose := externalOutStream := pOut at:2.
- outputShufflerProcess :=
- [
- WriteError handle:[:ex |
- "/ ignored
- ] do:[
- self shuffleAllFrom:shuffledOutStream to:anOutStream lineWise:lineWise lockWith:terminateLock.
- ].
- ] newProcess
- name:'cmd output shuffler';
+ pOut := NonPositionableExternalStream makePipe.
+ shuffledOutStream := (pOut at:1).
+ anOutStream isBinary ifTrue:[
+ shuffledOutStream binary
+ ].
+ outStreamToClose := externalOutStream := pOut at:2.
+ outputShufflerProcess :=
+ [
+ WriteError handle:[:ex |
+ "/ ignored
+ ] do:[
+ self shuffleAllFrom:shuffledOutStream to:anOutStream lineWise:lineWise lockWith:terminateLock.
+ ].
+ ] newProcess
+ priority:(Processor userSchedulingPriority + 1);
+ name:'cmd output shuffler';
"/ beSystemProcess;
- resume.
+ resume.
].
(externalErrStream := anErrStream) notNil ifTrue:[
- anErrStream == anOutStream ifTrue:[
- externalErrStream := externalOutStream
- ] ifFalse:[
- anErrStream isExternalStream ifFalse:[
- pErr := NonPositionableExternalStream makePipe.
- shuffledErrStream := (pErr at:1).
- anErrStream isBinary ifTrue:[
- shuffledErrStream binary
- ].
- errStreamToClose := externalErrStream := pErr at:2.
- errorShufflerProcess :=
- [
- self shuffleAllFrom:shuffledErrStream to:anErrStream lineWise:lineWise lockWith:terminateLock.
- ] newProcess
- name:'cmd err-output shuffler';
+ anErrStream == anOutStream ifTrue:[
+ externalErrStream := externalOutStream
+ ] ifFalse:[
+ anErrStream isExternalStream ifFalse:[
+ pErr := NonPositionableExternalStream makePipe.
+ shuffledErrStream := (pErr at:1).
+ anErrStream isBinary ifTrue:[
+ shuffledErrStream binary
+ ].
+ errStreamToClose := externalErrStream := pErr at:2.
+ errorShufflerProcess :=
+ [
+ self shuffleAllFrom:shuffledErrStream to:anErrStream lineWise:lineWise lockWith:terminateLock.
+ ] newProcess
+ priority:(Processor userSchedulingPriority + 2);
+ name:'cmd err-output shuffler';
"/ beSystemProcess;
- resume.
- ]
- ]
+ resume.
+ ]
+ ]
].
((externalAuxStream := anAuxStream) notNil
and:[externalAuxStream isExternalStream not]) ifTrue:[
- pAux := NonPositionableExternalStream makePipe.
- auxStreamToClose := externalAuxStream := pAux at:1.
- shuffledAuxStream := pAux at:2.
- shuffledAuxStream blocking:false.
- anAuxStream isBinary ifTrue:[
- shuffledAuxStream binary
- ].
-
- "/ start a reader process, shuffling data from the given
- "/ auxStream to the pipe (which is connected to the commands aux)
- auxShufflerProcess :=
- [
- [
- [anAuxStream atEnd] whileFalse:[
- self shuffleFrom:anAuxStream to:shuffledAuxStream lineWise:false.
- shuffledAuxStream flush
- ]
- ] ensure:[
- shuffledAuxStream close
- ]
- ] newProcess
- name:'cmd aux shuffler';
+ pAux := NonPositionableExternalStream makePipe.
+ auxStreamToClose := externalAuxStream := pAux at:1.
+ shuffledAuxStream := pAux at:2.
+ shuffledAuxStream blocking:false.
+ anAuxStream isBinary ifTrue:[
+ shuffledAuxStream binary
+ ].
+
+ "/ start a reader process, shuffling data from the given
+ "/ auxStream to the pipe (which is connected to the commands aux)
+ auxShufflerProcess :=
+ [
+ [
+ [anAuxStream atEnd] whileFalse:[
+ self shuffleFrom:anAuxStream to:shuffledAuxStream lineWise:false.
+ shuffledAuxStream flush
+ ]
+ ] ensure:[
+ shuffledAuxStream close
+ ]
+ ] newProcess
+ name:'cmd aux shuffler';
"/ beSystemProcess;
- resume.
+ resume.
].
stopShufflers := [:shuffleRest |
- inputShufflerProcess notNil ifTrue:[
- terminateLock critical:[inputShufflerProcess terminate].
- inputShufflerProcess waitUntilTerminated
- ].
- auxShufflerProcess notNil ifTrue:[
- terminateLock critical:[auxShufflerProcess terminate].
- auxShufflerProcess waitUntilTerminated
- ].
- outputShufflerProcess notNil ifTrue:[
- terminateLock critical:[outputShufflerProcess terminate].
- outputShufflerProcess waitUntilTerminated.
- shuffleRest ifTrue:[ self shuffleRestFrom:shuffledOutStream to:anOutStream lineWise:lineWise ].
- shuffledOutStream close.
- ].
- errorShufflerProcess notNil ifTrue:[
- terminateLock critical:[errorShufflerProcess terminate].
- errorShufflerProcess waitUntilTerminated.
- shuffleRest ifTrue:[ self shuffleRestFrom:shuffledErrStream to:anErrStream lineWise:lineWise ].
- shuffledErrStream close.
- ].
+ inputShufflerProcess notNil ifTrue:[
+ terminateLock critical:[inputShufflerProcess terminate].
+ inputShufflerProcess waitUntilTerminated
+ ].
+ auxShufflerProcess notNil ifTrue:[
+ terminateLock critical:[auxShufflerProcess terminate].
+ auxShufflerProcess waitUntilTerminated
+ ].
+ outputShufflerProcess notNil ifTrue:[
+ terminateLock critical:[outputShufflerProcess terminate].
+ outputShufflerProcess waitUntilTerminated.
+ shuffleRest ifTrue:[ self shuffleRestFrom:shuffledOutStream to:anOutStream lineWise:lineWise ].
+ shuffledOutStream close.
+ ].
+ errorShufflerProcess notNil ifTrue:[
+ terminateLock critical:[errorShufflerProcess terminate].
+ errorShufflerProcess waitUntilTerminated.
+ shuffleRest ifTrue:[ self shuffleRestFrom:shuffledErrStream to:anErrStream lineWise:lineWise ].
+ shuffledErrStream close.
+ ].
].
closeStreams := [
- inStreamToClose notNil ifTrue:[
- inStreamToClose close
- ].
- errStreamToClose notNil ifTrue:[
- errStreamToClose close
- ].
- outStreamToClose notNil ifTrue:[
- outStreamToClose close
- ].
- auxStreamToClose notNil ifTrue:[
- auxStreamToClose close
- ].
+ inStreamToClose notNil ifTrue:[
+ inStreamToClose close
+ ].
+ errStreamToClose notNil ifTrue:[
+ errStreamToClose close
+ ].
+ outStreamToClose notNil ifTrue:[
+ outStreamToClose close
+ ].
+ auxStreamToClose notNil ifTrue:[
+ auxStreamToClose close
+ ].
].
sema := Semaphore new name:'OS command wait'.
[
- pid := Processor
- monitor:[
- self
- startProcess:aCommandString
- inputFrom:externalInStream
- outputTo:externalOutStream
- errorTo:externalErrStream
- auxFrom:externalAuxStream
- environment:environmentDictionary
- inDirectory:dirOrNil
- ]
- action:[:status |
- status stillAlive ifFalse:[
- exitStatus := status.
- sema signal.
- self closePid:pid
- ]
- ].
-
- pid isNil ifTrue:[
- exitStatus := self osProcessStatusClass processCreationFailure
- ] ifFalse:[
- sema wait.
- ].
+ pid := Processor
+ monitor:[
+ self
+ startProcess:aCommandString
+ inputFrom:externalInStream
+ outputTo:externalOutStream
+ errorTo:externalErrStream
+ auxFrom:externalAuxStream
+ environment:environmentDictionary
+ inDirectory:dirOrNil
+ ]
+ action:[:status |
+ status stillAlive ifFalse:[
+ exitStatus := status.
+ sema signal.
+ self closePid:pid
+ ]
+ ].
+
+ pid isNil ifTrue:[
+ exitStatus := self osProcessStatusClass processCreationFailure
+ ] ifFalse:[
+ sema wait.
+ ].
] ifCurtailed:[
- closeStreams value.
- pid notNil ifTrue:[
- "/ terminate the os-command (and all of its forked commands)
- self terminateProcessGroup:pid.
- self terminateProcess:pid.
- self closePid:pid.
- ].
- stopShufflers value:false.
+ closeStreams value.
+ pid notNil ifTrue:[
+ "/ terminate the os-command (and all of its forked commands)
+ self terminateProcessGroup:pid.
+ self terminateProcess:pid.
+ self closePid:pid.
+ ].
+ stopShufflers value:false.
].
closeStreams value.
stopShufflers value:true.
exitStatus success ifFalse:[
- ^ aBlock value:exitStatus
+ ^ aBlock value:exitStatus
].
^ true
"
- |outStream errStream|
-
- outStream := '' writeStream.
-
- OperatingSystem executeCommand:'ls -l'
- inputFrom:'abc' readStream
- outputTo:outStream
- errorTo:nil
- inDirectory:nil
- lineWise:true
- onError:[:exitStatus | ^ false].
- outStream contents
- "
-
- "
- |outStream errStream|
-
- outStream := #[] writeStream.
-
- OperatingSystem executeCommand:'cat'
- inputFrom:(ByteArray new:5000000) readStream
- outputTo:outStream
- errorTo:nil
- inDirectory:nil
- lineWise:false
- onError:[:exitStatus | ^ false].
- outStream size
- "
-
- "
- |outStream errStream|
-
- outStream := '' writeStream.
-
- OperatingSystem executeCommand:'gpg -s --batch --no-tty --passphrase-fd 0 /tmp/passwd'
- inputFrom:'bla' readStream
- outputTo:outStream
- errorTo:nil
- inDirectory:nil
- lineWise:true
- onError:[:exitStatus | false].
- outStream contents
+ |outStream errStream|
+
+ outStream := '' writeStream.
+
+ OperatingSystem executeCommand:'ls -l'
+ inputFrom:'abc' readStream
+ outputTo:outStream
+ errorTo:nil
+ inDirectory:nil
+ lineWise:true
+ onError:[:exitStatus | ^ false].
+ outStream contents
+ "
+
+ "
+ |outStream errStream|
+
+ outStream := #[] writeStream.
+
+ OperatingSystem executeCommand:'cat'
+ inputFrom:(ByteArray new:5000000) readStream
+ outputTo:outStream
+ errorTo:nil
+ inDirectory:nil
+ lineWise:false
+ onError:[:exitStatus | ^ false].
+ outStream size
+ "
+
+ "
+ |outStream errStream|
+
+ outStream := '' writeStream.
+
+ OperatingSystem executeCommand:'gpg -s --batch --no-tty --passphrase-fd 0 /tmp/passwd'
+ inputFrom:'bla' readStream
+ outputTo:outStream
+ errorTo:nil
+ inDirectory:nil
+ lineWise:true
+ onError:[:exitStatus | false].
+ outStream contents
"
"Modified: / 11-02-2007 / 20:54:39 / cg"
@@ -1909,11 +1911,11 @@
|path|
path := self pathOfCommand:(self nameOfSTXExecutable).
- self assert:(path notNil).
+ self assert:(path notNil) message:'cannot figure out my executable''s path'.
^ path
"
- OperatingSystem pathOfSTXExecutable
+ OperatingSystem pathOfSTXExecutable
"
"Modified: / 20-01-2012 / 12:52:46 / cg"
@@ -7186,11 +7188,11 @@
!AbstractOperatingSystem class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/AbstractOperatingSystem.st,v 1.235 2013-04-25 11:22:42 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/AbstractOperatingSystem.st,v 1.236 2013-05-05 13:44:56 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/AbstractOperatingSystem.st,v 1.235 2013-04-25 11:22:42 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/AbstractOperatingSystem.st,v 1.236 2013-05-05 13:44:56 cg Exp $'
! !
--- a/ApplicationDefinition.st Tue Apr 30 10:54:00 2013 +0100
+++ b/ApplicationDefinition.st Tue May 21 21:58:09 2013 +0100
@@ -40,8 +40,8 @@
how to build executables and class libraries and how to load/unload packages.
Actually, subclasses MUST be subclasses of the two abstract classes LibraryDefinition or
ApplicationDefinition. These two know how to generate all required help files for the
- making/building/loading processa.
- The makefile creation is driven by file templates which are expanded using strings from the file mappings.
+ make/build/load process.
+ File creation is driven by file templates which are expanded using strings from the file mappings.
Concrete definition classes MUST redefine:
classNamesAndAttributes
@@ -359,8 +359,19 @@
!ApplicationDefinition class methodsFor:'description'!
-additionalFilesToInstall
+additionalFilesToInstall_unix
"application-specific files to be installed.
+ Each entry gives a pattern of a file to be copied and a destination directory.
+ Can be redefined in subclasses."
+
+ ^ #()
+
+ "Created: / 01-03-2007 / 20:02:21 / cg"
+!
+
+additionalFilesToInstall_win32
+ "application-specific files to be installed.
+ Each line defines an entry in the NSI file, for a pattern of a file to be copied.
Can be redefined in subclasses."
^ #()
@@ -608,8 +619,25 @@
"Modified: / 30-08-2006 / 19:29:25 / cg"
!
-commonFilesToInstall
- "files installed for applications - used only for NSIS installuer under WIN3.
+commonFilesToInstall_unix
+ "files installed for applications.
+ Each entry gives a pattern of a file to be copied and a destination directory.
+ Do not redefine - see additionalFilesToInstall for a redefinable variant of this"
+
+ ^ #(
+ ('*.so' 'bin')
+ ('symbols.stc' 'bin')
+ ('*.stx' 'bin')
+ ('*.rc' 'bin')
+ ('resources' 'bin')
+ )
+
+ "Created: / 01-03-2007 / 20:05:40 / cg"
+!
+
+commonFilesToInstall_win32
+ "files installed for applications - used only for NSIS installer under WIN32.
+ Each line defines an entry in the NSI file, for a pattern of a file to be copied.
Do not redefine - see additionalFilesToInstall for a redefinable variant of this"
^ #(
@@ -778,7 +806,7 @@
additionalFilesToInstall_dot_nsi:bindings
^ String
streamContents:[:s |
- self additionalFilesToInstall do:[:pattern |
+ self additionalFilesToInstall_win32 do:[:pattern |
s nextPutLine:((self installFileLine_nsi_for:pattern)
expandPlaceholdersWith:bindings)
].
@@ -938,7 +966,7 @@
commonFilesToInstall_dot_nsi:bindings
^ String
streamContents:[:s |
- self commonFilesToInstall do:[:pattern |
+ self commonFilesToInstall_win32 do:[:pattern |
s nextPutLine:((self installFileLine_nsi_for:pattern)
expandPlaceholdersWith:bindings)
].
@@ -955,6 +983,51 @@
RMDir /r "$INSTDIR"'
!
+dmgImageSetupLines
+ "generate (unix) copy commands to generate a directory holding the dmg prototype image directory.
+ This is used to generate a macOS deployable package"
+
+ |genLine product dmgVolume dmgDir appDir contentsDir macOSDir resourcesDir dirsMade|
+
+ product := self productName.
+
+ dmgVolume := product,'.dmg'.
+ dmgDir := product,'_dmg'.
+ appDir := dmgDir,'/',product,'.app'.
+ contentsDir := appDir,'/Contents'.
+ macOSDir := contentsDir,'/MacOS'.
+ resourcesDir := contentsDir,'/Resources'.
+ dirsMade := Set new.
+
+ genLine :=
+ [:s :d :srcAndDest |
+ |sourcePattern relPath destination|
+
+ sourcePattern := srcAndDest first.
+ relPath := srcAndDest second.
+ (relPath startsWith:'bin') ifTrue:[
+ relPath := '.',(relPath copyFrom:4)
+ ].
+ destination := contentsDir,'/',d,'/',relPath.
+ (dirsMade includes:destination) ifFalse:[
+ s tab; nextPutLine:'@-mkdir ',destination.
+ dirsMade add:destination.
+ ].
+ s tab; nextPutLine:('-cp -r %1 "%2"' bindWith:sourcePattern with:destination).
+ ].
+
+ ^ String streamContents:[:s |
+ s tab; nextPutLine:('@-rm -rf "%1"' bindWith:dmgDir).
+ s tab; nextPutLine:('@-mkdir "%1"' bindWith:dmgDir).
+ s tab; nextPutLine:('@-mkdir "%1"' bindWith:appDir).
+ s tab; nextPutLine:('@-mkdir "%1"' bindWith:contentsDir).
+ s tab; nextPutLine:('@-mkdir "%1"' bindWith:macOSDir).
+ s tab; nextPutLine:('cp "',self applicationName,'" "',macOSDir,'/',product,'"').
+ self commonFilesToInstall_unix do:[:eachPair | genLine value:s value:'MacOS' value:eachPair].
+ self additionalFilesToInstall_unix do:[:eachPair | genLine value:s value:'MacOS' value:eachPair].
+ ].
+!
+
fileExtensionDefinitionLines_dot_nsi:bindings
^ String streamContents:[:s |
self documentExtensions do:[:ext |
@@ -995,6 +1068,14 @@
at: 'DEPENDENCIES' put: (self generateDependencies_unix);
at: 'SUBPROJECTS_LIBS' put: (self generateSubProjectLines_make_dot_proto );
at: 'REQUIRED_SUPPORT_DIRS' put: (self extraTargets asStringWith:' ');
+ at: 'PRODUCT_NAME' put: (self productName);
+ at: 'PRODUCT_FILENAME' put: (self productFilename);
+ at: 'PRODUCT_VERSION' put: (self productVersion);
+ at: 'PRODUCT_DATE' put: (self productDate);
+ at: 'PRODUCT_PUBLISHER' put: (self productPublisher);
+ at: 'PRODUCT_WEBSITE' put: (self productWebSite);
+ at: 'PRODUCT_INSTALLDIR' put: (self productInstallDir);
+ at: 'DMG_IMAGE_SETUP' put: (self dmgImageSetupLines);
at: 'BUILD_TARGET' put: (self buildTarget ).
self offerSmalltalkSourceCode ifTrue:[
@@ -1071,7 +1152,7 @@
nsiDeliveredExecutables
"by default, an executable named after the application.
- Redefine, if thats not the case. If multiple have to be delivered,
+ Redefine, if that's not the case. If multiple have to be delivered,
return a string containing each individually double-quoted."
|s|
@@ -1617,10 +1698,11 @@
# An old file, used as a dummy target for FORCE if we do not want
# re-make libraries. Windows make does not work if we redefine FORCE= (empty string)
-OLD_FILE=bmake.bat
-
+# OLD_FILE=bmake.bat
+OLD_FILE="c:\windows\win.ini"
+
+#dummy target to force a build
!!ifndef FORCE
-# dummy target to force a build
FORCE=$(OLD_FILE)
!!endif
@@ -2236,7 +2318,7 @@
all:: prereq ALL_NP
# like ALL, but not prereqs
-ALL_NP:: exe $(REQUIRED_SUPPORT_DIRS) setup
+ALL_NP:: exe $(REQUIRED_SUPPORT_DIRS) $(SETUP_RULE)
exe: %(APPLICATION)
@@ -2260,14 +2342,38 @@
prereq:
$(MAKE) FORCE=@@@FORCE-BUILD@@@ $(REQUIRED_LIBOBJS)
+#
+# a self installable delivery
+#
+# backward compatible fallback
setup::
@if test -d autopackage; then \
makepackage; \
else \
- echo "Error: make setup not yet available in linux/unix"; \
+ echo "Error: make setup not yet available in this unix"; \
exit 1; \
fi
+#
+# for linux, this uses autopackage
+#
+setup_linux:
+ @if test -d autopackage; then \
+ makepackage; \
+ else \
+ echo "Error: missing autopackage directory"; \
+ exit 1; \
+ fi
+
+#
+# for mac, a dmg is generated
+#
+setup_macosx: "%(PRODUCT_NAME)_dmg"
+ hdiutil create -fs HFSX -layout SPUD "%(PRODUCT_NAME).dmg" -srcfolder "%(PRODUCT_NAME)_dmg" -format UDZO -volname "%(PRODUCT_NAME)" -quiet
+
+"%(PRODUCT_NAME)_dmg":
+%(DMG_IMAGE_SETUP)
+
SOURCEFILES: %(APPLICATION)_SOURCES \
stx_SOURCES
@@ -2362,7 +2468,8 @@
!
make_dot_proto_stx_resource_rules
- self isGUIApplication ifTrue:[
+ self isGUIApplication ifFalse:[
+ "/ non-GUI app: only include libbasic resources (for Date)
^ '
stx_RESOURCES: \
libbasic_RESOURCES
@@ -2377,6 +2484,7 @@
'
].
+ "/ GUI app: include all resources and rc files
^ '
stx_RESOURCES: \
@@ -2936,14 +3044,14 @@
!ApplicationDefinition class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/ApplicationDefinition.st,v 1.234 2013-04-25 13:11:29 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ApplicationDefinition.st,v 1.242 2013-05-07 17:56:48 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/ApplicationDefinition.st,v 1.234 2013-04-25 13:11:29 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ApplicationDefinition.st,v 1.242 2013-05-07 17:56:48 cg Exp $'
!
version_SVN
- ^ '§ Id: ApplicationDefinition.st 10645 2011-06-09 15:28:45Z vranyj1 §'
+ ^ '$ Id: ApplicationDefinition.st 10645 2011-06-09 15:28:45Z vranyj1 $'
! !
--- a/Behavior.st Tue Apr 30 10:54:00 2013 +0100
+++ b/Behavior.st Tue May 21 21:58:09 2013 +0100
@@ -12,10 +12,10 @@
"{ Package: 'stx:libbasic' }"
Object subclass:#Behavior
- instanceVariableNames: 'superclass flags methodDictionary lookupObject instSize'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Kernel-Classes'
+ instanceVariableNames:'superclass flags methodDictionary lookupObject instSize'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Kernel-Classes'
!
!Behavior class methodsFor:'documentation'!
@@ -300,7 +300,6 @@
"
! !
-
!Behavior class methodsFor:'creating new classes'!
new
@@ -338,7 +337,6 @@
"Modified: 7.6.1996 / 15:38:58 / stefan"
! !
-
!Behavior class methodsFor:'flag bit constants'!
flagAlien
@@ -824,7 +822,6 @@
%}
! !
-
!Behavior class methodsFor:'helpers'!
classesSortedByLoadOrder2:aCollectionOfClasses
@@ -834,9 +831,9 @@
This is an alternate algorithm showing cycles"
- |classes orderedTuples|
-
- orderedTuples := OrderedCollection new:classes size.
+ |orderedTuples|
+
+ orderedTuples := OrderedCollection new:aCollectionOfClasses size.
aCollectionOfClasses do:[:eachClass|
|sharedPools|
orderedTuples add:(Array with:eachClass with:eachClass superclass).
@@ -1011,7 +1008,6 @@
"Modified: 5.9.1996 / 19:34:41 / cg"
! !
-
!Behavior class methodsFor:'misc'!
autoload
@@ -1021,7 +1017,6 @@
! !
-
!Behavior class methodsFor:'queries'!
definitionSelectorFirstParts
@@ -1101,7 +1096,6 @@
"Created: / 01-06-2012 / 20:37:46 / cg"
! !
-
!Behavior methodsFor:'Compatibility-Dolphin'!
allSubinstances
@@ -1143,7 +1137,6 @@
^ self compiledMethodAt:selector
! !
-
!Behavior methodsFor:'Compatibility-Squeak'!
classComment:comment stamp:commentStamp
@@ -1196,7 +1189,6 @@
"Modified (comment): / 20-08-2011 / 16:35:07 / cg"
! !
-
!Behavior methodsFor:'Compatibility-VW'!
>> aSelector
@@ -1258,7 +1250,6 @@
^ self nameWithoutPrefix
! !
-
!Behavior methodsFor:'accessing'!
addSelector:newSelector withMethod:newMethod
@@ -1499,7 +1490,6 @@
^ superclass
! !
-
!Behavior methodsFor:'autoload check'!
autoload
@@ -1527,7 +1517,6 @@
"Created: 16.4.1996 / 16:27:16 / cg"
! !
-
!Behavior methodsFor:'compiler interface'!
browserClass
@@ -1610,7 +1599,6 @@
^ self class syntaxHighlighterClass.
! !
-
!Behavior methodsFor:'compiling'!
compile:code
@@ -1640,7 +1628,6 @@
"Created: 1.4.1997 / 23:43:43 / stefan"
! !
-
!Behavior methodsFor:'copying'!
canCloneFrom:anObject
@@ -1736,7 +1723,6 @@
^ self
! !
-
!Behavior methodsFor:'dummy changes management'!
addChangeRecordForClassRemove:aClassName
@@ -1749,7 +1735,6 @@
"Modified: 16.4.1996 / 18:10:35 / cg"
! !
-
!Behavior methodsFor:'dummy fileOut'!
fileOutDefinitionOn:aStream
@@ -1762,7 +1747,6 @@
"Created: 16.4.1996 / 16:28:01 / cg"
! !
-
!Behavior methodsFor:'enumerating'!
allDerivedInstancesDo:aBlock
@@ -2033,7 +2017,6 @@
"
! !
-
!Behavior methodsFor:'error handling'!
abstractClassInstantiationError
@@ -2044,7 +2027,6 @@
"Created: / 02-11-2012 / 10:07:01 / cg"
! !
-
!Behavior methodsFor:'initialization'!
deinitialize
@@ -2105,7 +2087,6 @@
^ self
! !
-
!Behavior methodsFor:'instance creation'!
basicNew
@@ -2135,121 +2116,119 @@
nextPtr = ((char *)newobj) + instsize;
/*
- * dont argue about the goto and the arrangement below - it saves
+ * don't argue about the goto and the arrangement below - it saves
* an extra nil-compare and branch in the common case ...
* (i.e. if no GC is needed, we fall through without a branch)
*/
- if (nextPtr < __newEndPtr) {
- _objPtr(newobj)->o_size = instsize;
- /* o_allFlags(newobj) = 0; */
- /* _objPtr(newobj)->o_space = __newSpace; */
- o_setAllFlags(newobj, __newSpace);
+ if (nextPtr < (char *)__newEndPtr) {
+ _objPtr(newobj)->o_size = instsize;
+ /* o_allFlags(newobj) = 0; */
+ /* _objPtr(newobj)->o_space = __newSpace; */
+ o_setAllFlags(newobj, __newSpace);
#ifdef __HAS_ALIGN4__
- /*
- * if the alignment is 4, we are already sat,
- * since a non-indexed object always has a word-aligned size.
- */
- __newNextPtr = nextPtr;
+ /*
+ * if the alignment is 4, we are already sat,
+ * since a non-indexed object always has a word-aligned size.
+ */
+ __newNextPtr = nextPtr;
#else
- if (instsize & (__ALIGN__-1)) {
- __newNextPtr = (char *)newobj + (instsize & ~(__ALIGN__-1)) + __ALIGN__;
- } else {
- __newNextPtr = nextPtr;
- }
+ if (instsize & (__ALIGN__-1)) {
+ __newNextPtr = (char *)newobj + (instsize & ~(__ALIGN__-1)) + __ALIGN__;
+ } else {
+ __newNextPtr = nextPtr;
+ }
#endif
ok:
- __InstPtr(newobj)->o_class = self;
- __qSTORE(newobj, self);
-
- if (nInstVars) {
+ __InstPtr(newobj)->o_class = self;
+ __qSTORE(newobj, self);
+
+ if (nInstVars) {
#if defined(memset4) && defined(FAST_OBJECT_MEMSET4) || defined(FAST_MEMSET4)
- memset4(__InstPtr(newobj)->i_instvars, nil, nInstVars);
+ memset4(__InstPtr(newobj)->i_instvars, nil, nInstVars);
#else
- REGISTER OBJ *op;
-
- op = __InstPtr(newobj)->i_instvars;
-
- /*
- * knowing that nil is 0
- */
+ REGISTER OBJ *op = __InstPtr(newobj)->i_instvars;
+
+ /*
+ * knowing that nil is 0
+ */
# if defined(FAST_OBJECT_MEMSET_DOUBLES_UNROLLED)
- if (nInstVars > 8) {
- *op++ = nil; /* for alignment */
- nInstVars--;
- while (nInstVars >= 8) {
- *(double *)op = 0.0;
- ((double *)op)[1] = 0.0;
- ((double *)op)[2] = 0.0;
- ((double *)op)[3] = 0.0;
- op += 8;
- nInstVars -= 8;
- }
- }
- while (nInstVars != 0) {
- *op++ = 0;
- nInstVars--;
- }
+ if (nInstVars > 8) {
+ *op++ = nil; /* for alignment */
+ nInstVars--;
+ while (nInstVars >= 8) {
+ *(double *)op = 0.0;
+ ((double *)op)[1] = 0.0;
+ ((double *)op)[2] = 0.0;
+ ((double *)op)[3] = 0.0;
+ op += 8;
+ nInstVars -= 8;
+ }
+ }
+ while (nInstVars != 0) {
+ *op++ = 0;
+ nInstVars--;
+ }
# else
# if defined(FAST_OBJECT_MEMSET_LONGLONG_UNROLLED)
- if (nInstVars > 8) {
- *op++ = nil; /* for alignment */
- nInstVars--;
- while (nInstVars >= 8) {
- *(long long *)op = 0;
- ((long long *)op)[1] = 0;
- ((long long *)op)[2] = 0;
- ((long long *)op)[3] = 0;
- op += 8;
- nInstVars -= 8;
- }
- }
- while (nInstVars != 0) {
- *op++ = 0;
- nInstVars--;
- }
+ if (nInstVars > 8) {
+ *op++ = nil; /* for alignment */
+ nInstVars--;
+ while (nInstVars >= 8) {
+ *(long long *)op = 0;
+ ((long long *)op)[1] = 0;
+ ((long long *)op)[2] = 0;
+ ((long long *)op)[3] = 0;
+ op += 8;
+ nInstVars -= 8;
+ }
+ }
+ while (nInstVars != 0) {
+ *op++ = 0;
+ nInstVars--;
+ }
# else
# if defined(FAST_OBJECT_MEMSET_WORDS_UNROLLED)
- while (nInstVars >= 8) {
- *op = nil;
- *(op+1) = nil;
- *(op+2) = nil;
- *(op+3) = nil;
- *(op+4) = nil;
- *(op+5) = nil;
- *(op+6) = nil;
- *(op+7) = nil;
- op += 8;
- nInstVars -= 8;
- }
- while (nInstVars != 0) {
- *op++ = nil;
- nInstVars--;
- }
+ while (nInstVars >= 8) {
+ *op = nil;
+ *(op+1) = nil;
+ *(op+2) = nil;
+ *(op+3) = nil;
+ *(op+4) = nil;
+ *(op+5) = nil;
+ *(op+6) = nil;
+ *(op+7) = nil;
+ op += 8;
+ nInstVars -= 8;
+ }
+ while (nInstVars != 0) {
+ *op++ = nil;
+ nInstVars--;
+ }
# else
# if defined(FAST_MEMSET)
- memset(__InstPtr(newobj)->i_instvars, 0, instsize-OHDR_SIZE);
+ memset(__InstPtr(newobj)->i_instvars, 0, instsize-OHDR_SIZE);
# else
- while (nInstVars >= 8) {
- nInstVars -= 8;
- op[0] = nil; op[1] = nil;
- op[2] = nil; op[3] = nil;
- op[4] = nil; op[5] = nil;
- op[6] = nil; op[7] = nil;
- op += 8;
- }
- while (nInstVars != 0) {
- *op++ = nil;
- nInstVars--;
- }
+ while (nInstVars >= 8) {
+ nInstVars -= 8;
+ op[0] = nil; op[1] = nil;
+ op[2] = nil; op[3] = nil;
+ op[4] = nil; op[5] = nil;
+ op[6] = nil; op[7] = nil;
+ op += 8;
+ }
+ while (nInstVars != 0) {
+ *op++ = nil;
+ nInstVars--;
+ }
# endif
# endif
# endif
# endif
#endif
- }
- RETURN ( newobj );
+ }
+ RETURN ( newobj );
}
/*
@@ -2892,7 +2871,6 @@
^ self basicNew:anInteger
! !
-
!Behavior methodsFor:'misc'!
browse
@@ -2957,7 +2935,6 @@
"Created: / 19.6.1998 / 02:14:02 / cg"
! !
-
!Behavior methodsFor:'printing & storing'!
displayOn:aGCOrStream
@@ -2983,7 +2960,6 @@
aStream nextPutAll:(self name).
! !
-
!Behavior methodsFor:'private-accessing'!
flags:aNumber
@@ -3029,17 +3005,17 @@
|dict oldMethod|
newMethod isNil ifTrue:[
- self error:'invalid method'.
+ self error:'invalid method'.
].
- (Smalltalk
- changeRequest:#methodInClass
- with:(Array with:self with:aSelector with:oldMethod)) ifFalse:[
- ^ false
- ].
- "/ oldMethod := self compiledMethodAt:aSelector.
dict := self methodDictionary.
- "/ oldMethod := dict at:aSelector ifAbsent:nil.
+ oldMethod := dict at:aSelector ifAbsent:nil.
+
+ (Smalltalk
+ changeRequest:#methodInClass
+ with:(Array with:self with:aSelector with:oldMethod)) ifFalse:[
+ ^ false
+ ].
self setMethodDictionary:(dict at:aSelector putOrAppend:newMethod).
newMethod mclass:self.
@@ -3126,7 +3102,6 @@
"Modified: 22.1.1997 / 18:42:12 / cg"
! !
-
!Behavior methodsFor:'private-helpers'!
addAllClassVarNamesTo:aCollection
@@ -3200,7 +3175,6 @@
"Modified: / 22-07-2010 / 18:10:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
-
!Behavior methodsFor:'queries'!
category
@@ -3548,7 +3522,6 @@
"Modified: 3.1.1997 / 19:18:49 / cg"
! !
-
!Behavior methodsFor:'queries-inheritance'!
allSubclasses
@@ -3792,7 +3765,6 @@
"
! !
-
!Behavior methodsFor:'queries-instances'!
allDerivedInstances
@@ -3995,7 +3967,6 @@
"
! !
-
!Behavior methodsFor:'queries-instlayout'!
elementByteSize
@@ -4317,7 +4288,6 @@
%}
! !
-
!Behavior methodsFor:'queries-protocol'!
allSelectors
@@ -4614,17 +4584,17 @@
cls := self.
[cls notNil] whileTrue:[
- m := cls compiledMethodAt:aSelector.
- m notNil ifTrue:[^ m].
- cls hasMultipleSuperclasses ifTrue:[
- cls superclasses do:[:aSuperClass |
- m := aSuperClass lookupMethodFor:aSelector.
- m notNil ifTrue:[^ m].
- ].
- ^ nil
- ] ifFalse:[
- cls := cls superclass
- ]
+ m := cls compiledMethodAt:aSelector.
+ m notNil ifTrue:[^ m].
+ cls hasMultipleSuperclasses ifTrue:[
+ cls superclasses do:[:aSuperClass |
+ m := aSuperClass lookupMethodFor:aSelector.
+ m notNil ifTrue:[^ m].
+ ].
+ ^ nil
+ ] ifFalse:[
+ cls := cls superclass
+ ]
].
^ nil
@@ -4737,7 +4707,6 @@
"
! !
-
!Behavior methodsFor:'queries-variables'!
allClassVarNames
@@ -4975,7 +4944,6 @@
"Modified: / 23-07-2012 / 11:21:17 / cg"
! !
-
!Behavior methodsFor:'snapshots'!
postSnapshot
@@ -4994,7 +4962,6 @@
"Modified: 16.4.1996 / 18:12:14 / cg"
! !
-
!Behavior methodsFor:'tracing'!
traceInto:aRequestor level:level from:referrer
@@ -5005,7 +4972,6 @@
! !
-
!Behavior methodsFor:'visiting'!
acceptVisitor:aVisitor with:aParameter
@@ -5013,14 +4979,13 @@
^ aVisitor visitBehavior:self with:aParameter
! !
-
!Behavior class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.340 2013-04-19 11:32:07 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.342 2013-05-08 07:54:34 stefan Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.340 2013-04-19 11:32:07 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.342 2013-05-08 07:54:34 stefan Exp $'
! !
--- a/BlockContext.st Tue Apr 30 10:54:00 2013 +0100
+++ b/BlockContext.st Tue May 21 21:58:09 2013 +0100
@@ -127,15 +127,13 @@
|con h|
- home isNil ifTrue:[^ nil]. "XXX will change soon"
home isContext ifFalse:[^ nil]. "copying blocks have no method home"
- con := self.
h := home.
- [h notNil] whileTrue:[
- con := h.
- h := con home
- ].
+ [
+ con := h.
+ h := con home
+ ] doWhile:[h notNil].
^ con
!
@@ -169,7 +167,7 @@
|cls who mHome m className sel homeSel|
- (home isNil or:[home isContext not]) ifTrue:[
+ home isContext ifFalse:[
"
mhmh - an optimized blocks context
should get the block here, and get the method from
@@ -254,9 +252,10 @@
!BlockContext class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/BlockContext.st,v 1.35 2012-07-19 09:24:00 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/BlockContext.st,v 1.36 2013-05-07 13:23:42 stefan Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/BlockContext.st,v 1.35 2012-07-19 09:24:00 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/BlockContext.st,v 1.36 2013-05-07 13:23:42 stefan Exp $'
! !
+
--- a/CharacterArray.st Tue Apr 30 10:54:00 2013 +0100
+++ b/CharacterArray.st Tue May 21 21:58:09 2013 +0100
@@ -283,7 +283,6 @@
"Created: 3.8.1997 / 18:16:40 / cg"
! !
-
!CharacterArray class methodsFor:'cleanup'!
lowSpaceCleanup
@@ -327,7 +326,6 @@
"
! !
-
!CharacterArray class methodsFor:'pattern matching'!
matchEscapeCharacter
@@ -679,7 +677,6 @@
^ self == CharacterArray
! !
-
!CharacterArray methodsFor:'Compatibility-ANSI'!
addLineDelimiters
@@ -1571,7 +1568,6 @@
! !
-
!CharacterArray methodsFor:'character searching'!
includesMatchCharacters
@@ -3950,8 +3946,6 @@
! !
-
-
!CharacterArray methodsFor:'matching - glob expressions'!
compoundMatch:aString
@@ -4396,7 +4390,6 @@
! !
-
!CharacterArray methodsFor:'padded copying'!
centerPaddedTo:newSize
@@ -4921,7 +4914,6 @@
"Modified: 17.4.1997 / 12:50:23 / cg"
! !
-
!CharacterArray methodsFor:'special string converting'!
expandPlaceholders:escapeCharacter with:argArrayOrDictionary
@@ -4968,7 +4960,8 @@
dict at:$a put:'AAAAA'.
dict at:$b put:[ Time now ].
dict at:'foo' put:[ Date today ].
- 'hello $1 %a $b %(foo)' expandPlaceholders:$$ with:dict
+ 'hello $1 %a $b %(foo) $foo ' expandPlaceholders:$$ with:dict.
+ 'hello $1 %a $b %(foo) $foo ' expandPlaceholders:$% with:dict.
"
"Modified: 1.7.1997 / 00:53:24 / cg"
@@ -5864,7 +5857,6 @@
"
! !
-
!CharacterArray methodsFor:'substring searching'!
findRangeOfString:subString
@@ -6088,6 +6080,36 @@
"
"Created: 25.11.1995 / 11:04:18 / cg"
+!
+
+splitAtString:subString withoutSeparators:strip
+ "If the receiver is of the form:
+ <left><subString><right>
+ return a collection containing left and right only.
+ If strip is true, remove whiteSpace in the returned substrings."
+
+ |idx left right|
+
+ (idx := self indexOfSubCollection:subString) ~~ 0 ifTrue:[
+ left := self copyTo:(idx - 1).
+ right := self copyFrom:(idx + subString size).
+ strip ifTrue:[
+ left := left withoutSeparators.
+ right := right withoutSeparators.
+ ].
+ ^ StringCollection with:left with:right
+ ].
+ self error:'substring not present in receiver' mayProceed:true.
+ ^ self
+
+ "
+ 'hello -> world' splitAtString:'->' withoutSeparators:false
+ 'hello -> world' splitAtString:'->' withoutSeparators:true
+ 'hello -> ' splitAtString:'->' withoutSeparators:true
+ 'hello > error' splitAtString:'->' withoutSeparators:true
+ "
+
+ "Created: 25.11.1995 / 11:04:18 / cg"
! !
!CharacterArray methodsFor:'testing'!
@@ -6386,11 +6408,11 @@
!CharacterArray class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/CharacterArray.st,v 1.500 2013-04-25 13:12:04 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/CharacterArray.st,v 1.502 2013-05-06 09:55:08 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/CharacterArray.st,v 1.500 2013-04-25 13:12:04 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/CharacterArray.st,v 1.502 2013-05-06 09:55:08 cg Exp $'
! !
--- a/ClassDescription.st Tue Apr 30 10:54:00 2013 +0100
+++ b/ClassDescription.st Tue May 21 21:58:09 2013 +0100
@@ -654,7 +654,6 @@
"Modified: 23.4.1996 / 15:56:54 / cg"
! !
-
!ClassDescription methodsFor:'Compatibility-Dolphin'!
categoriesFor:aMethodSelector
@@ -1979,10 +1978,14 @@
"return a ClassCategoryReader to read in and compile methods for me.
This was added to allow squeak code to be filedIn."
+ Squeak::ClassCommentReader isNil ifTrue:[
+ Smalltalk loadPackage:'stx:libcompat'
+ ].
+
^ Squeak::ClassCommentReader new
- class:self
- category:#Comment
- changeStamp:aStamp
+ class:self
+ category:#Comment
+ changeStamp:aStamp
"Modified: / 6.6.1998 / 01:47:06 / cg"
!
@@ -4227,11 +4230,11 @@
!ClassDescription class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/ClassDescription.st,v 1.235 2013-04-17 20:23:53 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ClassDescription.st,v 1.236 2013-05-02 17:14:23 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/ClassDescription.st,v 1.235 2013-04-17 20:23:53 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ClassDescription.st,v 1.236 2013-05-02 17:14:23 cg Exp $'
! !
--- a/Date.st Tue Apr 30 10:54:00 2013 +0100
+++ b/Date.st Tue May 21 21:58:09 2013 +0100
@@ -2958,6 +2958,10 @@
Date today printOn:Transcript format:'%d%m%Y' (millenium bug format - danger)
Date today printOn:Transcript format:'Today is the %(weekDay) day of the week'
"
+ "short form (as in blogs like www.stackoverflow, www.superuser etc.)
+ Date today printOn:Transcript format:'%(MonthName) %D ''%Y'
+ Timestamp now printOn:Transcript format:'%(MonthName) %D ''%Y at %h:%m'
+ "
"
String streamContents:[:s |
Date today printOn:s format:#(1 2 3 $/ 1 2)
@@ -3154,11 +3158,11 @@
!Date class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Date.st,v 1.145 2013-01-25 13:34:56 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Date.st,v 1.146 2013-05-02 17:18:48 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Date.st,v 1.145 2013-01-25 13:34:56 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Date.st,v 1.146 2013-05-02 17:18:48 cg Exp $'
! !
--- a/Filename.st Tue Apr 30 10:54:00 2013 +0100
+++ b/Filename.st Tue May 21 21:58:09 2013 +0100
@@ -1334,17 +1334,11 @@
GUESS:
does it strip off any volume characters and make a path relative ?"
- |sep|
-
self isAbstract ifTrue:[
^ ConcreteClass localNameStringFrom:aString
].
- sep := self separatorString.
- (aString startsWith:sep) ifTrue:[
- ^ aString copyFrom:sep size + 1
- ].
- ^ aString
+ ^ aString withoutPrefix:self separatorString
"Modified: 7.9.1995 / 10:44:56 / claus"
"Modified: 8.9.1997 / 00:33:51 / cg"
@@ -5937,11 +5931,11 @@
!Filename class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Filename.st,v 1.392 2013-04-27 12:58:11 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Filename.st,v 1.393 2013-05-07 15:29:20 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Filename.st,v 1.392 2013-04-27 12:58:11 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Filename.st,v 1.393 2013-05-07 15:29:20 cg Exp $'
! !
--- a/MiniDebugger.st Tue Apr 30 10:54:00 2013 +0100
+++ b/MiniDebugger.st Tue May 21 21:58:09 2013 +0100
@@ -285,6 +285,8 @@
].
(leaveCmd == $c) ifTrue: [
traceBlock := nil.
+ ObjectMemory flushInlineCaches.
+ ObjectMemory stepInterruptHandler:nil.
stillHere := false.
stepping := false.
tracing := false.
@@ -293,6 +295,8 @@
].
(leaveCmd == $a) ifTrue: [
"abort"
+ ObjectMemory flushInlineCaches.
+ ObjectMemory stepInterruptHandler:nil.
stepping := false.
tracing := false.
StepInterruptPending := nil.
@@ -748,6 +752,11 @@
(cmd == $L) ifTrue:[self printDotsMethodSource:true. ^ false ].
(cmd == $-) ifTrue:[self moveDotUp. self printDot. ^ false ].
(cmd == $+) ifTrue:[self moveDotDown. self printDot. ^ false ].
+ (cmd == $?) ifTrue:[
+ commandArg notEmpty ifTrue:[
+ self helpOn:commandArg. ^ false
+ ]
+ ].
"/ avoid usage print if return was typed ...
((cmd == Character return)
@@ -824,6 +833,57 @@
"Modified: / 31.7.1998 / 16:11:01 / cg"
!
+helpOn:commandArg
+ |args className sym val match showMethod|
+
+ commandArg withoutSeparators isEmpty ifTrue:[
+ 'usage: H className [methodPattern]' printCR.
+ ^self
+ ].
+ args := commandArg asCollectionOfWords.
+ className := args first.
+
+ (sym := className asSymbolIfInterned) isNil ifTrue:[
+ 'no such class' printCR.
+ ^ self.
+ ].
+ val := Smalltalk at:sym ifAbsent:['no such class' printCR. ^ self.].
+ val isBehavior ifFalse:[
+ 'not a class: ' print. className printCR.
+ val := val class.
+ 'showing help for ' print. val name printCR.
+ ].
+ args size > 1 ifTrue:[
+ match := args at:2
+ ] ifFalse:[
+ match := '*'
+ ].
+
+ showMethod :=
+ [:sel :cls |
+ |mthd|
+
+ ((match includesMatchCharacters and:[ sel matches:match ignoreCase:true])
+ or:[ sel asLowercase startsWith:match asLowercase ]) ifTrue:[
+ mthd := cls compiledMethodAt:sel.
+ mthd category ~= 'documentation' ifTrue:[
+ sel printCR.
+ (mthd comment ? '') asStringCollection do:[:l |
+ ' ' print. l withoutSeparators printCR.
+ ].
+ '' printCR
+ ].
+ ].
+ ].
+
+ val theMetaclass selectors copy sort do:[:sel |
+ showMethod value:sel value:val theMetaclass
+ ].
+ val theNonMetaclass selectors copy sort do:[:sel |
+ showMethod value:sel value:val theNonMetaclass
+ ].
+!
+
interpreterLoopWith:anObject
'read-eval-print loop; exit with "#exit"; help with "?"' printCR.
(ReadEvalPrintLoop new doChunkFormat:false; error:Stderr; prompt:'> ')readEvalPrintLoop.
@@ -938,6 +998,7 @@
i ...... inspect receiver (in dot)
I ...... interpreter (expression evaluator)
e expr evaluate expression
+ ? c [p] help on class c (selectors matching p)
' errorPrintCR.
(XWorkstation notNil and:[ Screen default isKindOf:XWorkstation ]) ifTrue:[
@@ -955,10 +1016,10 @@
!MiniDebugger class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/MiniDebugger.st,v 1.84 2013-04-19 09:40:36 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/MiniDebugger.st,v 1.85 2013-04-30 12:51:20 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/MiniDebugger.st,v 1.84 2013-04-19 09:40:36 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/MiniDebugger.st,v 1.85 2013-04-30 12:51:20 cg Exp $'
! !
--- a/Number.st Tue Apr 30 10:54:00 2013 +0100
+++ b/Number.st Tue May 21 21:58:09 2013 +0100
@@ -183,7 +183,7 @@
^ [
|value intValue mantissaAndScale scale decimalMantissa str
- nextChar radix negative signExp exp denom|
+ nextChar radix sign signExp exp denom|
str := aStringOrStream readStream.
@@ -191,21 +191,27 @@
nextChar isNil ifTrue:[^ exceptionBlock value].
(nextChar == $-) ifTrue:[
- negative := true.
+ sign := -1.
str next.
nextChar := str peekOrNil
] ifFalse:[
- negative := false.
+ sign := 1.
(nextChar == $+) ifTrue:[
str next.
nextChar := str peekOrNil
]
].
+ nextChar = $( ifTrue:[
+ "maybe a Fraction e.g. (1/3)"
+ value := self readSmalltalkSyntaxFrom:str.
+ value isNil ifTrue:[^ exceptionBlock value].
+ ^ value * sign
+ ].
nextChar isNil ifTrue:[^ exceptionBlock value].
(nextChar isDigit or:[(decimalPointCharacters includes:nextChar)]) ifFalse:[
^ exceptionBlock value.
"/ value := super readFrom:str.
-"/ negative ifTrue:[value := value negated].
+"/ sign == -1 ifTrue:[value := value negated].
"/ ^ value
].
(decimalPointCharacters includes:nextChar) ifTrue:[
@@ -288,7 +294,7 @@
].
].
].
- negative ifTrue:[
+ sign == -1 ifTrue:[
value := value negated
].
value.
@@ -388,8 +394,12 @@
Number readSmalltalkSyntaxFrom:'(1/0)'
- Number readFrom:'(1/3)'
+ Number readFrom:'(1/3)'
Number readFrom:'(-1/3)'
+ Number readFrom:'-(1/3)'
+ Number readFrom:'(1/-3)'
+ Number readFrom:'(-1/-3)'
+ Number readFrom:'-(-1/-3)'
Number readSmalltalkSyntaxFrom:'+00000123.45'
Number readFrom:'+00000123.45'
@@ -2348,10 +2358,10 @@
!Number class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Number.st,v 1.141 2013-04-19 15:07:39 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Number.st,v 1.142 2013-04-30 15:17:34 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Number.st,v 1.141 2013-04-19 15:07:39 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Number.st,v 1.142 2013-04-30 15:17:34 cg Exp $'
! !
--- a/Object.st Tue Apr 30 10:54:00 2013 +0100
+++ b/Object.st Tue May 21 21:58:09 2013 +0100
@@ -15,12 +15,12 @@
instanceVariableNames:''
classVariableNames:'ErrorSignal HaltSignal MessageNotUnderstoodSignal
UserInterruptSignal RecursionInterruptSignal
- ExceptionInterruptSignal SubscriptOutOfBoundsSignal
- IndexNotFoundSignal NonIntegerIndexSignal NotFoundSignal
- KeyNotFoundSignal ElementOutOfBoundsSignal UserNotificationSignal
- InformationSignal WarningSignal PrimitiveFailureSignal
- DeepCopyErrorSignal AbortSignal ErrorRecursion Dependencies
- InfoPrinting ActivityNotificationSignal InternalErrorSignal
+ SubscriptOutOfBoundsSignal IndexNotFoundSignal
+ NonIntegerIndexSignal NotFoundSignal KeyNotFoundSignal
+ ElementOutOfBoundsSignal UserNotificationSignal InformationSignal
+ WarningSignal PrimitiveFailureSignal DeepCopyErrorSignal
+ AbortSignal ErrorRecursion Dependencies InfoPrinting
+ ActivityNotificationSignal InternalErrorSignal
NonWeakDependencies SynchronizationSemaphores ObjectAttributes
OSSignalInterruptSignal FinalizationLobby
RecursiveStoreStringSignal AbortAllSignal EnabledBreakPoints'
@@ -221,7 +221,8 @@
"called only once - initialize signals"
ErrorSignal isNil ifTrue:[
- self initSignals
+ self initSignals.
+ ErrorRecursion := true.
].
ObjectAttributes isNil ifTrue:[
@@ -670,6 +671,7 @@
! !
+
!Object methodsFor:'accessing'!
_at:index
@@ -2814,8 +2816,8 @@
AssertionFailedError
raiseRequestWith:self
errorString:('Assertion failed in ',
- thisContext sender printString,
- '[', thisContext sender lineNumber printString,']')
+ thisContext methodHome sender printString,
+ '[', thisContext methodHome sender lineNumber printString,']')
].
"
@@ -2838,7 +2840,7 @@
(aBooleanOrBlock value) ifFalse:[
AssertionFailedError
raiseRequestWith:self
- errorString:(messageIfFailing, ' {',thisContext sender "methodHome" printString,' }')
+ errorString:(messageIfFailing, ' {',thisContext methodHome sender "methodHome" printString,' }')
].
"
@@ -9417,7 +9419,8 @@
Smalltalk isInitialized ifFalse:[
'errorNotification: ' print. aString printCR.
- aContext sender printAllLevels:10.
+ con := aContext ? thisContext methodHome.
+ con sender printAllLevels:10.
^ nil
].
@@ -9461,7 +9464,7 @@
] do:[ |s|
sender := aContext.
sender isNil ifTrue:[
- sender := thisContext sender.
+ sender := thisContext methodHome sender.
].
con := sender.
@@ -9650,11 +9653,11 @@
!Object class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Object.st,v 1.718 2013-04-27 13:07:08 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Object.st,v 1.720 2013-05-07 14:04:27 stefan Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Object.st,v 1.718 2013-04-27 13:07:08 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Object.st,v 1.720 2013-05-07 14:04:27 stefan Exp $'
!
version_SVN
--- a/PCFilename.st Tue Apr 30 10:54:00 2013 +0100
+++ b/PCFilename.st Tue May 21 21:58:09 2013 +0100
@@ -169,7 +169,7 @@
"/ kludge when running cygwin: replace '/cygdrive/X/...'
"/ by X:\...
(tempDir startsWith:'/cygdrive/') ifTrue:[
- tempDir := tempDir copyFrom:'/cygdrive/' size+1.
+ tempDir := tempDir withoutPrefix:'/cygdrive/'.
tempDir size > 2 ifTrue:[
(tempDir at:2) == $/ ifTrue:[
tempDir := (tempDir at:1) asString , ':' ,
@@ -886,14 +886,14 @@
!PCFilename class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/PCFilename.st,v 1.58 2013-04-25 14:11:09 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/PCFilename.st,v 1.59 2013-05-07 15:29:18 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/PCFilename.st,v 1.58 2013-04-25 14:11:09 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/PCFilename.st,v 1.59 2013-05-07 15:29:18 cg Exp $'
!
version_SVN
- ^ '§Id§'
+ ^ '$Id: PCFilename.st,v 1.59 2013-05-07 15:29:18 cg Exp $'
! !
--- a/Project.st Tue Apr 30 10:54:00 2013 +0100
+++ b/Project.st Tue May 21 21:58:09 2013 +0100
@@ -1028,9 +1028,7 @@
(clsName := classOrClassName) isBehavior ifTrue:[
clsName := classOrClassName name
].
- (clsName startsWith:'Smalltalk::') ifTrue:[
- clsName := clsName copyFrom:'Smalltalk::' size + 1.
- ].
+ clsName := clsName withoutPrefix:'Smalltalk::'.
i := ClassInfo new.
i className:clsName.
@@ -1590,11 +1588,11 @@
!Project class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Project.st,v 1.210 2013-04-02 09:34:01 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Project.st,v 1.211 2013-05-07 15:28:56 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Project.st,v 1.210 2013-04-02 09:34:01 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Project.st,v 1.211 2013-05-07 15:28:56 cg Exp $'
! !
--- a/ProjectDefinition.st Tue Apr 30 10:54:00 2013 +0100
+++ b/ProjectDefinition.st Tue May 21 21:58:09 2013 +0100
@@ -623,7 +623,7 @@
].
rel := self topRelativePathToPackage_unix:aPackageID.
(rel startsWith:'stx/') ifTrue:[
- ^ '$(TOP)/', (rel copyFrom:'stx/' size + 1).
+ ^ '$(TOP)/', (rel withoutPrefix:'stx/').
] ifFalse:[
^ '$(TOP)/../', rel
]
@@ -650,7 +650,7 @@
rel := self topRelativePathToPackage_win32:aPackageID.
(rel startsWith:'stx\') ifTrue:[
- ^ '$(TOP)\', (rel copyFrom:'stx\' size + 1).
+ ^ '$(TOP)\', (rel withoutPrefix:'stx\').
] ifFalse:[
^ '$(TOP)\..\', rel
]
@@ -782,7 +782,7 @@
rel := (self topRelativePathToPackage_unix:toPackageID).
(rel startsWith:'stx/') ifTrue:[
- ^ '$(TOP)', (rel copyFrom:'stx/' size)
+ ^ '$(TOP)', (rel copyFrom:'stx/' size) "/ notice: the slash remains
].
^ '$(TOP)/../', rel.
@@ -2832,9 +2832,10 @@
productName
"Returns a product name which will appear in <lib>.rc.
- Under win32, this is placed into the dlls file-info"
-
- |m|
+ Under win32, this is placed into the dlls file-info.
+ This method is usually redefined in a concrete application definition"
+
+ |m nm|
m := self module.
m = 'stx' ifTrue:[
@@ -2843,10 +2844,20 @@
m = 'exept' ifTrue:[
^ 'eXept addOns'
].
- Error handle:[:ex |
+ SubclassResponsibilityError handle:[:ex |
+ "/ we get this error, if the concrete class has not yet redefined
+ "/ startupClassName.
+ self breakPoint:#cg.
^ 'ProductName'
] do:[
- ^ self startupClassName
+ nm := self startupClassName.
+ (nm endsWith:'Startup') ifTrue:[
+ ^ nm copyButLast:'Startup' size.
+ ].
+ (nm endsWith:'Start') ifTrue:[
+ ^ nm copyButLast:'Start' size.
+ ].
+ ^ nm
].
"Modified: / 08-11-2007 / 16:45:14 / cg"
@@ -2993,12 +3004,16 @@
dict := OrderedDictionary withKeysAndValues:#(
'Make.spec' #'generate_make_dot_spec'
'Make.proto' #'generate_make_dot_proto'
- 'Makefile' #'generate_makefile' "/ for unix
+ "/ cg: changed to generate Makefile.init instead of Makefile,
+ "/ because macosx files are not case sensitive.
+ "/ You will have to execute make -f Makefile.init initially
+ "/ 'Makefile' #'generate_makefile' "/ for unix
+ 'Makefile.init' #'generate_makefile' "/ for unix
'bc.mak' #'generate_bc_dot_mak' "/ for windows
'abbrev.stc' #'generate_abbrev_dot_stc'
'bmake.bat' #'generate_bmake_dot_mak' "/ for bcc32
'vcmake.bat' #'generate_vcmake_dot_mak' "/ for msvc
- 'lccmake.bat' #'generate_lccmake_dot_mak' "/ for lcc
+ 'lccmake.bat' #'generate_lccmake_dot_mak' "/ for lcc - not supported at the moment
"/ 'tccmake.bat' #'generate_tccmake_dot_mak' "/ for tcc - cannot link at the moment
'mingwmake.bat' #'generate_mingwmake_dot_mak' "/ for mingw
).
@@ -4730,6 +4745,12 @@
# My only task is to generate the real makefile and call make again.
# Thereafter, I am no longer used and needed.
#
+# MACOSX caveat:
+# as filenames are not case sensitive (in a default setup),
+# we cannot use tha above trick. Therefore, this file is now named
+# "Makefile.init", and you have to execute "make -f Makefile.init" to
+# get the initial makefile. This is now also done by the toplevel CONFIG
+# script.
.PHONY: run
@@ -7466,11 +7487,11 @@
!ProjectDefinition class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/ProjectDefinition.st,v 1.463 2013-04-26 09:04:54 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ProjectDefinition.st,v 1.468 2013-05-07 15:28:48 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/ProjectDefinition.st,v 1.463 2013-04-26 09:04:54 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ProjectDefinition.st,v 1.468 2013-05-07 15:28:48 cg Exp $'
!
version_HG
@@ -7479,7 +7500,7 @@
!
version_SVN
- ^ '§ Id: ProjectDefinition.st 10645 2011-06-09 15:28:45Z vranyj1 §'
+ ^ '$ Id: ProjectDefinition.st 10645 2011-06-09 15:28:45Z vranyj1 $'
! !
--- a/SequenceableCollection.st Tue Apr 30 10:54:00 2013 +0100
+++ b/SequenceableCollection.st Tue May 21 21:58:09 2013 +0100
@@ -7191,6 +7191,28 @@
"
"Modified: / 16.5.1998 / 20:21:46 / cg"
+!
+
+map:values at:key ifAbsent:exceptionValue
+ "the receiver is interpreted as a collection of keys;
+ find key in the receiver and return the corresponding value
+ from the valuesCollection argument."
+
+ |idx|
+
+ idx := self indexOf:key.
+ idx == 0 ifTrue:[^ exceptionValue value].
+ ^ values at:idx
+
+ "
+ #(16 32 128 256 512 1024)
+ map: #('ipc4' 'ipc5' 'ic07' 'ic08' 'ic09' 'ic10')
+ at:128 ifAbsent:nil
+
+ #(16 32 128 256 512 1024)
+ map: #('ipc4' 'ipc5' 'ic07' 'ic08' 'ic09' 'ic10')
+ at:64 ifAbsent:nil
+ "
! !
!SequenceableCollection methodsFor:'searching-equality'!
@@ -8912,11 +8934,11 @@
!SequenceableCollection class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/SequenceableCollection.st,v 1.336 2013-04-26 11:36:40 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/SequenceableCollection.st,v 1.338 2013-05-06 13:35:25 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/SequenceableCollection.st,v 1.336 2013-04-26 11:36:40 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/SequenceableCollection.st,v 1.338 2013-05-06 13:35:25 cg Exp $'
! !
--- a/Smalltalk.st Tue Apr 30 10:54:00 2013 +0100
+++ b/Smalltalk.st Tue May 21 21:58:09 2013 +0100
@@ -6495,56 +6495,54 @@
then in the package directory if existing.
Return a path or nil.
Search order is:
- bitmaps/<pkg>/file
- resources/<pkg>/bitmaps/file
- <pkg>/bitmaps/file
+ bitmaps/<pkg>/file
+ resources/<pkg>/bitmaps/file
+ <pkg>/bitmaps/file
"
|f dir packageDir pF|
- ((f := aFileName asString) startsWith:'bitmaps/') ifTrue:[
- f := f copyFrom:('bitmaps/' size + 1).
- ].
+ f := aFileName asString withoutPrefix:'bitmaps/'.
aPackageIDOrNil isNil ifTrue:[
- "/ this will be an error in the future
+ "/ this will be an error in the future
"/ 'Smalltalk [warning]: bitmap file access without package: ' infoPrint. aFileName infoPrintCR.
"/ self halt.
- pF := self searchPath:(self realSystemPath) for:aFileName in:('bitmaps').
- pF notNil ifTrue:[
- ^ pF.
- ].
- f ~= aFileName ifTrue:[
- pF := self searchPath:(self realSystemPath) for:f in:('bitmaps').
- pF notNil ifTrue:[
- ^ pF.
- ].
- ].
- ^ nil
+ pF := self searchPath:(self realSystemPath) for:aFileName in:('bitmaps').
+ pF notNil ifTrue:[
+ ^ pF.
+ ].
+ f ~= aFileName ifTrue:[
+ pF := self searchPath:(self realSystemPath) for:f in:('bitmaps').
+ pF notNil ifTrue:[
+ ^ pF.
+ ].
+ ].
+ ^ nil
].
dir := self projectDirectoryForPackage:aPackageIDOrNil.
dir notNil ifTrue:[
- pF := dir asFilename / f.
- pF exists ifTrue:[
- ^ pF.
- ].
- pF := dir asFilename / 'bitmaps' /f.
- pF exists ifTrue:[
- ^ pF.
- ].
+ pF := dir asFilename / f.
+ pF exists ifTrue:[
+ ^ pF.
+ ].
+ pF := dir asFilename / 'bitmaps' /f.
+ pF exists ifTrue:[
+ ^ pF.
+ ].
].
packageDir := aPackageIDOrNil copyReplaceAll:$: with:$/.
pF := self searchPath:(self realSystemPath) for:aFileName in:('bitmaps/',packageDir).
pF notNil ifTrue:[
- ^ pF.
+ ^ pF.
].
pF := self searchPath:(self realSystemPath) for:aFileName in:('resources/',packageDir,'/bitmaps').
pF notNil ifTrue:[
- ^ pF.
+ ^ pF.
].
^ nil
@@ -6708,59 +6706,57 @@
and in a packages directory.
Return the absolute filename or nil if none is found.
Search order is:
- resources/<pkg>/file
- <pkg>/resources/file
+ resources/<pkg>/file
+ <pkg>/resources/file
"
|pF f dir packageDir|
- ((f := aFileName asString) startsWith:'resources/') ifTrue:[
- f := aFileName copyFrom:('resources/' size + 1).
- ].
+ f := aFileName asString withoutPrefix:'resources/'.
aPackageIDOrNil isNil ifTrue:[
- "/ this will be an error in the future
+ "/ this will be an error in the future
"/ 'Smalltalk [warning]: resource file access without package: ' infoPrint. aFileName infoPrintCR.
"/ self halt.
- pF := self searchPath:(self realSystemPath) for:aFileName in:('resources').
- pF notNil ifTrue:[
- ^ pF.
- ].
+ pF := self searchPath:(self realSystemPath) for:aFileName in:('resources').
+ pF notNil ifTrue:[
+ ^ pF.
+ ].
"/ pF := self searchPath:(self realSystemPath) for:aFileName in:('resources/styles').
"/ pF notNil ifTrue:[
"/ ^ pF.
"/ ].
- f ~= aFileName ifTrue:[
- pF := self searchPath:(self realSystemPath) for:f in:('resources').
- pF notNil ifTrue:[
- ^ pF.
- ].
+ f ~= aFileName ifTrue:[
+ pF := self searchPath:(self realSystemPath) for:f in:('resources').
+ pF notNil ifTrue:[
+ ^ pF.
+ ].
"/ pF := self searchPath:(self realSystemPath) for:f in:('resources/styles').
"/ pF notNil ifTrue:[
"/ ^ pF.
"/ ].
- ].
- ^ nil
+ ].
+ ^ nil
].
packageDir := aPackageIDOrNil copyReplaceAll:$: with:$/.
pF := self searchPath:(self realSystemPath) for:aFileName in:('resources/',packageDir).
pF notNil ifTrue:[
- ^ pF.
+ ^ pF.
].
"/ the following code finds the file within the IDE's own hierarchy
dir := self projectDirectoryForPackage:aPackageIDOrNil.
dir notNil ifTrue:[
- dir := dir asFilename.
-
- (pF := dir / 'resources' / f) exists ifTrue:[ ^ pF name ].
+ dir := dir asFilename.
+
+ (pF := dir / 'resources' / f) exists ifTrue:[ ^ pF name ].
"/ (pF := dir / 'styles' / f) exists ifTrue:[ ^ pF name ].
- "resolve something like: 'ASN/definition.asn1'"
- (pF := dir / f) exists ifTrue:[ ^ pF name ].
+ "resolve something like: 'ASN/definition.asn1'"
+ (pF := dir / f) exists ifTrue:[ ^ pF name ].
].
^ nil
@@ -7976,11 +7972,11 @@
!Smalltalk class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.1025 2013-04-25 19:09:39 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.1026 2013-05-07 15:29:07 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.1025 2013-04-25 19:09:39 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.1026 2013-05-07 15:29:07 cg Exp $'
!
version_HG
@@ -7989,6 +7985,6 @@
!
version_SVN
- ^ '§ Id: Smalltalk.st 10648 2011-06-23 15:55:10Z vranyj1 §'
+ ^ '$ Id: Smalltalk.st 10648 2011-06-23 15:55:10Z vranyj1 $'
! !
--- a/UnixOperatingSystem.st Tue Apr 30 10:54:00 2013 +0100
+++ b/UnixOperatingSystem.st Tue May 21 21:58:09 2013 +0100
@@ -12,56 +12,56 @@
"{ Package: 'stx:libbasic' }"
AbstractOperatingSystem subclass:#UnixOperatingSystem
- instanceVariableNames: ''
- classVariableNames: 'HostName DomainName SlowFork ForkFailed CurrentDirectory
+ instanceVariableNames:''
+ classVariableNames:'HostName DomainName SlowFork ForkFailed CurrentDirectory
LastTimeInfo LastTimeInfoSeconds LastTimeInfoMilliseconds
LastTimeInfoIsLocal CachedMountPoints CacheMountPointsTimeStamp
Codeset CodesetEncoder'
- poolDictionaries: ''
- category: 'OS-Unix'
+ poolDictionaries:''
+ category:'OS-Unix'
!
Object subclass:#FileDescriptorHandle
- instanceVariableNames: 'fd'
- classVariableNames: 'OpenFiles'
- poolDictionaries: ''
- privateIn: UnixOperatingSystem
+ instanceVariableNames:'fd'
+ classVariableNames:'OpenFiles'
+ poolDictionaries:''
+ privateIn:UnixOperatingSystem
!
OSFileHandle subclass:#FilePointerHandle
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- privateIn: UnixOperatingSystem
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:UnixOperatingSystem
!
Object subclass:#FileStatusInfo
- instanceVariableNames: 'type mode uid gid size id accessed modified statusChanged path
+ instanceVariableNames:'type mode uid gid size id accessed modified statusChanged path
numLinks'
- classVariableNames: ''
- poolDictionaries: ''
- privateIn: UnixOperatingSystem
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:UnixOperatingSystem
!
Object subclass:#MountInfo
- instanceVariableNames: 'mountPointPath deviceOrRemotePath fsType attributeString'
- classVariableNames: ''
- poolDictionaries: ''
- privateIn: UnixOperatingSystem
+ instanceVariableNames:'mountPointPath deviceOrRemotePath fsType attributeString'
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:UnixOperatingSystem
!
Object subclass:#OSProcessStatus
- instanceVariableNames: 'pid status code core'
- classVariableNames: ''
- poolDictionaries: ''
- privateIn: UnixOperatingSystem
+ instanceVariableNames:'pid status code core'
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:UnixOperatingSystem
!
UnixOperatingSystem::FileDescriptorHandle subclass:#SocketHandle
- instanceVariableNames: ''
- classVariableNames: 'ProtocolCache'
- poolDictionaries: ''
- privateIn: UnixOperatingSystem
+ instanceVariableNames:''
+ classVariableNames:'ProtocolCache'
+ poolDictionaries:''
+ privateIn:UnixOperatingSystem
!
!UnixOperatingSystem primitiveDefinitions!
@@ -648,7 +648,6 @@
"
! !
-
!UnixOperatingSystem class methodsFor:'initialization'!
initialize
@@ -689,7 +688,6 @@
"Modified: / 11.12.1998 / 16:22:48 / cg"
! !
-
!UnixOperatingSystem class methodsFor:'OS signal constants'!
sigABRT
@@ -1421,7 +1419,6 @@
"
! !
-
!UnixOperatingSystem class methodsFor:'error messages'!
currentErrorNumber
@@ -2496,7 +2493,6 @@
"
! !
-
!UnixOperatingSystem class methodsFor:'executing OS commands-implementation'!
exec:aCommandPathArg withArguments:argColl environment:environmentDictionary
@@ -2941,7 +2937,6 @@
"Created: / 12.11.1998 / 14:39:20 / cg"
! !
-
!UnixOperatingSystem class methodsFor:'executing OS commands-queries'!
commandAndArgsForOSCommand:aCommandString
@@ -2967,14 +2962,14 @@
|info path|
- "shortcut - use the /proc filesystem.
+ "shortcut - use the /proc filesystem (if present).
Here we get an absolute path to the running executable."
info := '/proc/self/exe' asFilename linkInfo.
info notNil ifTrue:[
- path := info path.
- path notEmptyOrNil ifTrue:[
- ^ path
- ].
+ path := info path.
+ path notEmptyOrNil ifTrue:[
+ ^ path
+ ].
].
"Fall back - do it the hard way"
@@ -2995,31 +2990,31 @@
commandFilename := aCommand asFilename.
commandFilename isAbsolute ifTrue:[
- ^ aCommand
+ ^ commandFilename pathName
].
commandFilename isExplicitRelative ifTrue:[
- ^ commandFilename pathName
+ ^ commandFilename pathName
].
path := self getEnvironment:'PATH'.
path notEmptyOrNil ifTrue:[
- (path asCollectionOfSubstringsSeparatedBy:self pathSeparator) do:[:eachPathComponent |
- eachPathComponent isEmpty ifTrue:[
- f := commandFilename
- ] ifFalse:[
- f := eachPathComponent asFilename construct:aCommand.
- ].
- self executableFileExtensions do:[:eachExtension |
- eachExtension notEmpty ifTrue:[
- fExt := f addSuffix:eachExtension.
- ] ifFalse:[
- fExt := f.
- ].
- fExt isExecutable ifTrue:[
- ^ fExt pathName
- ].
- ].
- ].
+ (path asCollectionOfSubstringsSeparatedBy:self pathSeparator) do:[:eachPathComponent |
+ eachPathComponent isEmpty ifTrue:[
+ f := commandFilename
+ ] ifFalse:[
+ f := eachPathComponent asFilename construct:aCommand.
+ ].
+ self executableFileExtensions do:[:eachExtension |
+ eachExtension notEmpty ifTrue:[
+ fExt := f addSuffix:eachExtension.
+ ] ifFalse:[
+ fExt := f.
+ ].
+ fExt isExecutable ifTrue:[
+ ^ fExt pathName
+ ].
+ ].
+ ].
].
^ nil
@@ -3039,7 +3034,6 @@
"Modified: / 5.6.1998 / 19:03:32 / cg"
! !
-
!UnixOperatingSystem class methodsFor:'file access'!
closeFd:anInteger
@@ -3567,7 +3561,6 @@
^ self primitiveFailed
! !
-
!UnixOperatingSystem class methodsFor:'file access rights'!
accessMaskFor:aSymbol
@@ -3710,7 +3703,6 @@
^ self primitiveFailed
! !
-
!UnixOperatingSystem class methodsFor:'file locking'!
lockFD:aFileDescriptor shared:isSharedReadLock blocking:blockIfLocked
@@ -3937,7 +3929,6 @@
^ false
! !
-
!UnixOperatingSystem class methodsFor:'file queries'!
caseSensitiveFilenames
@@ -5049,7 +5040,6 @@
"Modified: / 5.6.1998 / 18:38:11 / cg"
! !
-
!UnixOperatingSystem class methodsFor:'interrupts & signals'!
defaultSignal:signalNumber
@@ -5749,7 +5739,6 @@
"Modified: / 27.1.1998 / 20:05:59 / cg"
! !
-
!UnixOperatingSystem class methodsFor:'ipc support'!
makeBidirectionalPipe
@@ -6052,7 +6041,6 @@
self primitiveFailed
! !
-
!UnixOperatingSystem class methodsFor:'misc'!
closeLeftOverFiles
@@ -6133,7 +6121,6 @@
"Modified: 22.4.1996 / 13:13:09 / cg"
! !
-
!UnixOperatingSystem class methodsFor:'os queries'!
executableFileExtensions
@@ -8268,7 +8255,6 @@
! !
-
!UnixOperatingSystem class methodsFor:'path queries'!
decodePath:encodedPathName
@@ -8365,7 +8351,6 @@
"Modified: / 23-01-2013 / 10:00:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
-
!UnixOperatingSystem class methodsFor:'private'!
mountPointsFromProcFS
@@ -8398,7 +8383,6 @@
"Created: / 12.6.1998 / 16:30:43 / cg"
! !
-
!UnixOperatingSystem class methodsFor:'shared memory access'!
shmAttach:id address:addr flags:flags
@@ -8481,7 +8465,6 @@
"Modified: 22.4.1996 / 13:14:46 / cg"
! !
-
!UnixOperatingSystem class methodsFor:'socket creation'!
socketAccessor
@@ -8498,7 +8481,6 @@
^ SocketHandle new domain:domainArg type:typeArg protocol:protocolArg
! !
-
!UnixOperatingSystem class methodsFor:'time and date'!
computeOSTimeFromUTCYear:y month:m day:d hour:h minute:min second:s millisecond:millis
@@ -8941,7 +8923,6 @@
"
! !
-
!UnixOperatingSystem class methodsFor:'users & groups'!
getEffectiveGroupID
@@ -9312,7 +9293,6 @@
"
! !
-
!UnixOperatingSystem class methodsFor:'waiting for events'!
blockingChildProcessWait
@@ -10031,7 +10011,6 @@
^ self primitiveFailed
! !
-
!UnixOperatingSystem::FileDescriptorHandle class methodsFor:'change & update'!
update:aspect with:argument from:anObject
@@ -10051,7 +10030,6 @@
"Created: 30.9.1997 / 12:57:35 / stefan"
! !
-
!UnixOperatingSystem::FileDescriptorHandle class methodsFor:'initialization'!
initialize
@@ -10066,7 +10044,6 @@
"Modified: 30.9.1997 / 12:40:55 / stefan"
! !
-
!UnixOperatingSystem::FileDescriptorHandle class methodsFor:'instance creation'!
for:aFileDescriptor
@@ -10077,7 +10054,6 @@
"Created: 30.9.1997 / 14:00:00 / stefan"
! !
-
!UnixOperatingSystem::FileDescriptorHandle methodsFor:'error handling'!
error:anErrorSymbolOrErrno
@@ -10090,7 +10066,6 @@
self primitiveFailed:anErrorSymbolOrErrno.
! !
-
!UnixOperatingSystem::FileDescriptorHandle methodsFor:'file access'!
close
@@ -10105,7 +10080,6 @@
"Modified: 30.9.1997 / 13:06:55 / stefan"
! !
-
!UnixOperatingSystem::FileDescriptorHandle methodsFor:'initialization'!
for:aFileDescriptor
@@ -10131,7 +10105,6 @@
"Modified (comment): / 16-03-2013 / 00:04:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
-
!UnixOperatingSystem::FileDescriptorHandle methodsFor:'input/output'!
readBytes:count into:aByteBuffer startingAt:firstIndex
@@ -10406,7 +10379,6 @@
"
! !
-
!UnixOperatingSystem::FileDescriptorHandle methodsFor:'misc functions'!
nextError
@@ -10563,7 +10535,6 @@
! !
-
!UnixOperatingSystem::FileDescriptorHandle methodsFor:'private-accessing'!
fileDescriptor
@@ -10590,7 +10561,6 @@
! !
-
!UnixOperatingSystem::FileDescriptorHandle methodsFor:'queries'!
canReadWithoutBlocking
@@ -10706,7 +10676,6 @@
"
! !
-
!UnixOperatingSystem::FileDescriptorHandle methodsFor:'registering'!
register
@@ -10739,7 +10708,6 @@
"Modified (comment): / 16-03-2013 / 00:04:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
-
!UnixOperatingSystem::FileDescriptorHandle methodsFor:'releasing'!
invalidate
@@ -10752,7 +10720,6 @@
"Modified: 30.9.1997 / 12:42:16 / stefan"
! !
-
!UnixOperatingSystem::FileDescriptorHandle methodsFor:'waiting'!
readWaitWithTimeoutMs:timeout
@@ -10821,7 +10788,6 @@
^ canWrite not
! !
-
!UnixOperatingSystem::FilePointerHandle methodsFor:'release'!
closeFile
@@ -10838,7 +10804,6 @@
! !
-
!UnixOperatingSystem::FileStatusInfo class methodsFor:'instance creation'!
type:t mode:m uid:u gid:g size:s id:i accessed:aT modified:mT statusChanged:sT path:lP numLinks:nL
@@ -10846,7 +10811,6 @@
type:t mode:m uid:u gid:g size:s id:i accessed:aT modified:mT statusChanged:sT path:lP numLinks:nL
! !
-
!UnixOperatingSystem::FileStatusInfo methodsFor:'accessing'!
accessTime
@@ -10937,7 +10901,6 @@
^ uid
! !
-
!UnixOperatingSystem::FileStatusInfo methodsFor:'accessing-vms'!
fixedHeaderSize
@@ -10970,7 +10933,6 @@
^ nil
! !
-
!UnixOperatingSystem::FileStatusInfo methodsFor:'backward compatibility'!
accessed
@@ -11002,7 +10964,6 @@
^ self statusChangeTime
! !
-
!UnixOperatingSystem::FileStatusInfo methodsFor:'private-accessing'!
type:t mode:m uid:u gid:g size:s id:i accessed:aT modified:mT statusChanged:sT path:lP numLinks:nL
@@ -11019,7 +10980,6 @@
numLinks := nL.
! !
-
!UnixOperatingSystem::FileStatusInfo methodsFor:'queries-access'!
isGroupExecutable
@@ -11094,7 +11054,6 @@
"
! !
-
!UnixOperatingSystem::FileStatusInfo methodsFor:'queries-type'!
isBlockSpecial
@@ -11129,7 +11088,6 @@
^ type == #unknown
! !
-
!UnixOperatingSystem::MountInfo methodsFor:'accessing'!
mountPointPath
@@ -11147,7 +11105,6 @@
attributeString := attributeStringArg.
! !
-
!UnixOperatingSystem::MountInfo methodsFor:'printing'!
printOn:aStream
@@ -11156,14 +11113,12 @@
nextPutAll:mountPointPath.
! !
-
!UnixOperatingSystem::MountInfo methodsFor:'queries'!
isRemote
^ fsType = 'nfs'
! !
-
!UnixOperatingSystem::OSProcessStatus class methodsFor:'documentation'!
documentation
@@ -11190,7 +11145,6 @@
"
! !
-
!UnixOperatingSystem::OSProcessStatus class methodsFor:'instance creation'!
pid:pid status:status code:code core:core
@@ -11211,7 +11165,6 @@
"Modified: 30.4.1996 / 18:25:05 / cg"
! !
-
!UnixOperatingSystem::OSProcessStatus methodsFor:'accessing'!
code
@@ -11250,7 +11203,6 @@
"Modified: 30.4.1996 / 18:26:54 / cg"
! !
-
!UnixOperatingSystem::OSProcessStatus methodsFor:'initialization'!
pid:newPid status:newStatus code:newCode core:newCore
@@ -11262,7 +11214,6 @@
"Created: 28.12.1995 / 14:18:22 / stefan"
! !
-
!UnixOperatingSystem::OSProcessStatus methodsFor:'printing & storing'!
printOn:aStream
@@ -11274,7 +11225,6 @@
aStream nextPut:$).
! !
-
!UnixOperatingSystem::OSProcessStatus methodsFor:'private-OS interface'!
code:something
@@ -11310,7 +11260,6 @@
"Created: 28.12.1995 / 14:05:07 / stefan"
! !
-
!UnixOperatingSystem::OSProcessStatus methodsFor:'queries'!
couldNotExecute
@@ -11339,7 +11288,6 @@
"Modified: 28.12.1995 / 14:13:41 / stefan"
! !
-
!UnixOperatingSystem::SocketHandle class methodsFor:'constants'!
protocolCodeOf:aNameOrNumber
@@ -11431,7 +11379,6 @@
"
! !
-
!UnixOperatingSystem::SocketHandle class methodsFor:'initialization'!
reinitialize
@@ -11440,7 +11387,6 @@
ProtocolCache := nil.
! !
-
!UnixOperatingSystem::SocketHandle class methodsFor:'queries'!
XXgetAddressInfo:hostName serviceName:serviceNameArg domain:domainArg type:typeArg protocol:protoArg flags:flags
@@ -12441,7 +12387,6 @@
^ result.
! !
-
!UnixOperatingSystem::SocketHandle methodsFor:'accepting'!
acceptWithPeerAddressBuffer:peerOrNil
@@ -12515,7 +12460,6 @@
^ self class for:newFd
! !
-
!UnixOperatingSystem::SocketHandle methodsFor:'binding'!
bindTo:socketAddress
@@ -12570,7 +12514,6 @@
"
! !
-
!UnixOperatingSystem::SocketHandle methodsFor:'connecting'!
cancelConnect
@@ -12693,7 +12636,6 @@
"
! !
-
!UnixOperatingSystem::SocketHandle methodsFor:'datagram transmission'!
receiveFrom:socketAddress buffer:aDataBuffer start:startIndex for:nBytes flags:flags
@@ -12930,7 +12872,6 @@
^ self error:error.
! !
-
!UnixOperatingSystem::SocketHandle methodsFor:'initialization'!
domain:domainArg type:typeArg protocol:protocolArg
@@ -13016,7 +12957,6 @@
"
! !
-
!UnixOperatingSystem::SocketHandle methodsFor:'misc'!
getOptionsLevel:level name:name
@@ -13208,7 +13148,6 @@
^ nil.
! !
-
!UnixOperatingSystem::SocketHandle methodsFor:'queries'!
getNameInto:socketAddress
@@ -13286,15 +13225,14 @@
^ nil
! !
-
!UnixOperatingSystem class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/UnixOperatingSystem.st,v 1.317 2013-04-26 13:30:07 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/UnixOperatingSystem.st,v 1.321 2013-05-06 00:24:56 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/UnixOperatingSystem.st,v 1.317 2013-04-26 13:30:07 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/UnixOperatingSystem.st,v 1.321 2013-05-06 00:24:56 cg Exp $'
!
version_HG