--- a/ReadEvalPrintLoop.st Tue Nov 08 16:48:17 2016 +0100
+++ b/ReadEvalPrintLoop.st Tue Nov 08 17:17:20 2016 +0100
@@ -16,7 +16,7 @@
Object subclass:#ReadEvalPrintLoop
instanceVariableNames:'inputStream outputStream errorStream compiler prompt
doChunkFormat traceFlag timingFlag profilingFlag printFlag
- exitAction currentDirectory'
+ exitAction currentDirectory lastEditedClass'
classVariableNames:''
poolDictionaries:''
category:'System-Support'
@@ -192,6 +192,106 @@
"Created: / 07-12-2006 / 19:04:50 / cg"
!
+cmd_debug:lineStream
+ MiniDebugger enter.
+!
+
+cmd_edit:lineStream
+ "edit a class or selector"
+
+ |errStream editor classOrMethodName cls methodName selector
+ code isNewClass tmpFile modifiedTime|
+
+ errStream := self errorStream.
+
+ editor := OperatingSystem getEnvironment:'STX_EDITOR'.
+ editor isNil ifTrue:[
+ editor := OperatingSystem getEnvironment:'EDITOR'.
+ editor isNil ifTrue:[
+ OperatingSystem isMSWINDOWSlike ifTrue:[
+ editor := 'notepad'.
+ ] ifFalse:[
+ editor := 'vi'.
+ ].
+ ].
+ ].
+
+ isNewClass := false.
+
+ lineStream skipSeparators.
+ lineStream atEnd ifTrue:[^ self].
+
+ classOrMethodName := lineStream
+ upToElementForWhich:[:ch |
+ ch isLetterOrDigit not and:[ch ~~ $_]
+ ].
+ "/
+ (classOrMethodName isUppercaseFirst) ifTrue:[
+ (cls := Smalltalk classNamed:classOrMethodName) isNil ifTrue:[
+ errStream nextPutAll:'edit: no such class: ',classOrMethodName,' ; create (y/n)? '.
+ (self inputStream nextLine withoutSeparators startsWith:'y') ifFalse:[^ self].
+ isNewClass := true.
+ code :=
+'Object
+ subclass:#%1
+ instanceVariableNames:''''
+ classVariableNames:''''
+ poolDictionaries:''''
+ category:''user classes''
+' bindWith:classOrMethodName.
+ ] ifFalse:[
+ lineStream skipSeparators.
+ lineStream atEnd ifFalse:[
+ methodName := lineStream upToSeparator.
+ ].
+ ].
+ ] ifFalse:[
+ methodName := classOrMethodName
+ ].
+
+ isNewClass ifFalse:[
+ cls := cls ? lastEditedClass.
+ cls isNil ifTrue:[
+ errStream nextPutLine:'edit usage:'.
+ errStream nextPutLine:' #edit className selector'.
+ errStream nextPutLine:' #edit className '.
+ errStream nextPutLine:' #edit selector (class as in previous edit)'.
+ ^ self.
+ ].
+ lastEditedClass := cls.
+ ((selector := methodName asSymbolIfInterned) isNil
+ or:[ (cls implements:selector) not]) ifTrue:[
+ errStream nextPutAll:('"',methodName,'" is a new method; create (y/n)? ').
+ (self inputStream nextLine withoutSeparators startsWith:'y') ifFalse:[^ self].
+ code := '
+%1
+ "this is a new method"
+ self halt
+' bindWith:methodName.
+ ] ifFalse:[
+ code := cls compiledMethodAt:selector.
+ ].
+ ].
+
+ tmpFile := Filename newTemporary.
+ tmpFile contents:code.
+ modifiedTime := tmpFile modificationTime.
+ OperatingSystem executeCommand:('%1 %2' bindWith:editor with:tmpFile pathName).
+ tmpFile modificationTime ~= modifiedTime ifTrue:[
+ isNewClass ifTrue:[
+ Compiler evaluate:tmpFile contentsOfEntireFile.
+ ] ifFalse:[
+ cls compile:tmpFile contentsOfEntireFile classified:'*as yet uncategorized'.
+ ].
+ ].
+
+ "
+ self new
+ input:Stdin;
+ cmd_edit:'MyClass foo' readStream
+ "
+!
+
cmd_exit:lineStream
exitAction value
@@ -219,12 +319,14 @@
memory ............. memory usage
flags .............. flags
modules ............ loaded modules
+ packages ........... available packages to load
all ................ all of the above
#set/clear <flag> ... set or clear a flag
trace .............. tracing execution
timing ............. timing execution
profiling .......... show execution profile
chunkFormat ........ traditional bang chunk format input mode
+ #debug ................. enter a MiniDebugger
The MiniDebugger (if entered) shows its own help with "?".
'
@@ -346,6 +448,12 @@
ok := true.
].
+ (showAll or:[ what startsWith:'pack' ]) ifTrue:[
+ showAll ifTrue:[ errStream cr; nextPutLine:'Packages:'; nextPutLine:'--------' ].
+ self showPackages.
+ ok := true.
+ ].
+
(showAll or:[ what startsWith:'mod' ]) ifTrue:[
showAll ifTrue:[ errStream cr; nextPutLine:'Modules:'; nextPutLine:'--------' ].
printModule :=
@@ -377,10 +485,10 @@
"/ + ObjectMemory newSpaceUsed.
errStream
"/ nextPutLine:('overall: ',(allMem // 1024) printString,' Kb');
- nextPutLine:('overall: ',(ObjectMemory bytesUsed // 1024) printString,' Kb');
+ nextPutLine:('used : ',(ObjectMemory bytesUsed // 1024) printString,' Kb');
nextPutLine:('free : ',(ObjectMemory freeSpace // 1024) printString,' Kb');
- nextPutLine:('minorGC: ',(ObjectMemory scavengeCount) printString);
- nextPutLine:('majorGC: ',(ObjectMemory garbageCollectCount) printString).
+ nextPutAll:('minorGC: ',(ObjectMemory scavengeCount) printString);
+ nextPutLine:(' majorGC: ',(ObjectMemory garbageCollectCount) printString).
ok := true.
].
@@ -458,6 +566,23 @@
].
"Created: / 07-12-2006 / 18:49:17 / cg"
+!
+
+showPackages
+ |all|
+
+ all := Set new.
+ Smalltalk knownLoadablePackagesDo:[:packageID :type :path |
+ all add:packageID
+ ].
+ all := all asOrderedCollection sort.
+ all do:[:eachPackage |
+ self errorStream nextPutLine:eachPackage.
+ ].
+
+ "
+ ReadEvalPrintLoop basicNew showPackages
+ "
! !
!ReadEvalPrintLoop methodsFor:'evaluation'!