ReadEvalPrintLoop.st
changeset 20900 f2e647fa7eb1
parent 20892 765ca5daafd7
child 20901 56be0b5cd5d7
equal deleted inserted replaced
20899:e81f16882160 20900:f2e647fa7eb1
    14 "{ NameSpace: Smalltalk }"
    14 "{ NameSpace: Smalltalk }"
    15 
    15 
    16 Object subclass:#ReadEvalPrintLoop
    16 Object subclass:#ReadEvalPrintLoop
    17 	instanceVariableNames:'inputStream outputStream errorStream compiler prompt
    17 	instanceVariableNames:'inputStream outputStream errorStream compiler prompt
    18 		doChunkFormat traceFlag timingFlag profilingFlag printFlag
    18 		doChunkFormat traceFlag timingFlag profilingFlag printFlag
    19 		exitAction currentDirectory'
    19 		exitAction currentDirectory lastEditedClass'
    20 	classVariableNames:''
    20 	classVariableNames:''
    21 	poolDictionaries:''
    21 	poolDictionaries:''
    22 	category:'System-Support'
    22 	category:'System-Support'
    23 !
    23 !
    24 
    24 
   188 
   188 
   189 cmd_clear:lineStream
   189 cmd_clear:lineStream
   190     self cmd_setOrClear:lineStream to:false
   190     self cmd_setOrClear:lineStream to:false
   191 
   191 
   192     "Created: / 07-12-2006 / 19:04:50 / cg"
   192     "Created: / 07-12-2006 / 19:04:50 / cg"
       
   193 !
       
   194 
       
   195 cmd_debug:lineStream
       
   196     MiniDebugger enter.
       
   197 !
       
   198 
       
   199 cmd_edit:lineStream
       
   200     "edit a class or selector"
       
   201 
       
   202     |errStream editor classOrMethodName cls methodName selector 
       
   203      code isNewClass tmpFile modifiedTime|
       
   204 
       
   205     errStream := self errorStream.
       
   206 
       
   207     editor := OperatingSystem getEnvironment:'STX_EDITOR'.
       
   208     editor isNil ifTrue:[
       
   209         editor := OperatingSystem getEnvironment:'EDITOR'.
       
   210         editor isNil ifTrue:[
       
   211             OperatingSystem isMSWINDOWSlike ifTrue:[
       
   212                 editor := 'notepad'.
       
   213             ] ifFalse:[
       
   214                 editor := 'vi'.
       
   215             ].    
       
   216         ].    
       
   217     ].    
       
   218 
       
   219     isNewClass := false.
       
   220 
       
   221     lineStream skipSeparators.
       
   222     lineStream atEnd ifTrue:[^ self].
       
   223 
       
   224     classOrMethodName := lineStream 
       
   225                             upToElementForWhich:[:ch | 
       
   226                                 ch isLetterOrDigit not and:[ch ~~ $_]
       
   227                             ].
       
   228     "/ 
       
   229     (classOrMethodName isUppercaseFirst) ifTrue:[ 
       
   230         (cls := Smalltalk classNamed:classOrMethodName) isNil ifTrue:[
       
   231             errStream nextPutAll:'edit: no such class: ',classOrMethodName,' ; create (y/n)? '.
       
   232             (self inputStream nextLine withoutSeparators startsWith:'y') ifFalse:[^ self].
       
   233             isNewClass := true.
       
   234             code := 
       
   235 'Object
       
   236   subclass:#%1
       
   237   instanceVariableNames:''''
       
   238   classVariableNames:''''
       
   239   poolDictionaries:''''
       
   240   category:''user classes''
       
   241 '                   bindWith:classOrMethodName.
       
   242         ] ifFalse:[ 
       
   243             lineStream skipSeparators.
       
   244             lineStream atEnd ifFalse:[
       
   245                 methodName := lineStream upToSeparator.
       
   246             ].
       
   247         ].
       
   248     ] ifFalse:[
       
   249         methodName := classOrMethodName   
       
   250     ].
       
   251 
       
   252     isNewClass ifFalse:[
       
   253         cls := cls ? lastEditedClass.
       
   254         cls isNil ifTrue:[
       
   255             errStream nextPutLine:'edit usage:'.
       
   256             errStream nextPutLine:'   #edit className selector'.
       
   257             errStream nextPutLine:'   #edit className '.
       
   258             errStream nextPutLine:'   #edit selector (class as in previous edit)'.
       
   259             ^ self.
       
   260         ].
       
   261         lastEditedClass := cls.
       
   262         ((selector := methodName asSymbolIfInterned) isNil 
       
   263         or:[ (cls implements:selector) not]) ifTrue:[
       
   264             errStream nextPutAll:('"',methodName,'" is a new method; create (y/n)? ').
       
   265             (self inputStream nextLine withoutSeparators startsWith:'y') ifFalse:[^ self].
       
   266             code := '
       
   267 %1
       
   268     "this is a new method"
       
   269     self halt
       
   270 '               bindWith:methodName.
       
   271         ] ifFalse:[
       
   272             code := cls compiledMethodAt:selector.
       
   273         ].    
       
   274     ].
       
   275 
       
   276     tmpFile := Filename newTemporary.
       
   277     tmpFile contents:code.
       
   278     modifiedTime := tmpFile modificationTime.
       
   279     OperatingSystem executeCommand:('%1 %2' bindWith:editor with:tmpFile pathName).
       
   280     tmpFile modificationTime ~= modifiedTime ifTrue:[
       
   281         isNewClass ifTrue:[
       
   282             Compiler evaluate:tmpFile contentsOfEntireFile.    
       
   283         ] ifFalse:[
       
   284             cls compile:tmpFile contentsOfEntireFile classified:'*as yet uncategorized'.    
       
   285         ].    
       
   286     ].
       
   287 
       
   288     "
       
   289      self new 
       
   290         input:Stdin;
       
   291         cmd_edit:'MyClass foo' readStream
       
   292     "
   193 !
   293 !
   194 
   294 
   195 cmd_exit:lineStream
   295 cmd_exit:lineStream
   196     exitAction value
   296     exitAction value
   197 
   297 
   217         variables .......... interpreter variables
   317         variables .......... interpreter variables
   218         processes .......... processes
   318         processes .......... processes
   219         memory ............. memory usage
   319         memory ............. memory usage
   220         flags .............. flags
   320         flags .............. flags
   221         modules ............ loaded modules
   321         modules ............ loaded modules
       
   322         packages ........... available packages to load
   222         all ................ all of the above
   323         all ................ all of the above
   223     #set/clear <flag> ... set or clear a flag
   324     #set/clear <flag> ... set or clear a flag
   224         trace .............. tracing execution
   325         trace .............. tracing execution
   225         timing ............. timing execution
   326         timing ............. timing execution
   226         profiling .......... show execution profile
   327         profiling .......... show execution profile
   227         chunkFormat ........ traditional bang chunk format input mode
   328         chunkFormat ........ traditional bang chunk format input mode
       
   329     #debug ................. enter a MiniDebugger
   228 
   330 
   229 The MiniDebugger (if entered) shows its own help with "?".
   331 The MiniDebugger (if entered) shows its own help with "?".
   230 '
   332 '
   231 
   333 
   232     "Created: / 07-12-2006 / 18:54:20 / cg"
   334     "Created: / 07-12-2006 / 18:54:20 / cg"
   344             showAll ifTrue:[ errStream cr; nextPutLine:'Threads:'; nextPutLine:'--------' ].
   446             showAll ifTrue:[ errStream cr; nextPutLine:'Threads:'; nextPutLine:'--------' ].
   345             MiniDebugger basicNew showProcesses.
   447             MiniDebugger basicNew showProcesses.
   346             ok := true.
   448             ok := true.
   347         ].
   449         ].
   348         
   450         
       
   451         (showAll or:[ what startsWith:'pack' ]) ifTrue:[                    
       
   452             showAll ifTrue:[ errStream cr; nextPutLine:'Packages:'; nextPutLine:'--------' ].
       
   453             self showPackages.
       
   454             ok := true.
       
   455         ].
       
   456 
   349         (showAll or:[ what startsWith:'mod' ]) ifTrue:[
   457         (showAll or:[ what startsWith:'mod' ]) ifTrue:[
   350             showAll ifTrue:[ errStream cr; nextPutLine:'Modules:'; nextPutLine:'--------' ].
   458             showAll ifTrue:[ errStream cr; nextPutLine:'Modules:'; nextPutLine:'--------' ].
   351             printModule :=
   459             printModule :=
   352                 [:mod |
   460                 [:mod |
   353                     errStream
   461                     errStream
   375             showAll ifTrue:[ errStream cr; nextPutLine:'Memory:'; nextPutLine:'-------' ].
   483             showAll ifTrue:[ errStream cr; nextPutLine:'Memory:'; nextPutLine:'-------' ].
   376             "/ allMem := ObjectMemory oldSpaceUsed + ObjectMemory symSpaceUsed
   484             "/ allMem := ObjectMemory oldSpaceUsed + ObjectMemory symSpaceUsed
   377             "/                                     + ObjectMemory newSpaceUsed.
   485             "/                                     + ObjectMemory newSpaceUsed.
   378             errStream
   486             errStream
   379                 "/ nextPutLine:('overall: ',(allMem // 1024) printString,' Kb');
   487                 "/ nextPutLine:('overall: ',(allMem // 1024) printString,' Kb');
   380                 nextPutLine:('overall: ',(ObjectMemory bytesUsed // 1024) printString,' Kb');
   488                 nextPutLine:('used   : ',(ObjectMemory bytesUsed // 1024) printString,' Kb');
   381                 nextPutLine:('free   : ',(ObjectMemory freeSpace // 1024) printString,' Kb');
   489                 nextPutLine:('free   : ',(ObjectMemory freeSpace // 1024) printString,' Kb');
   382                 nextPutLine:('minorGC: ',(ObjectMemory scavengeCount) printString);
   490                 nextPutAll:('minorGC: ',(ObjectMemory scavengeCount) printString);
   383                 nextPutLine:('majorGC: ',(ObjectMemory garbageCollectCount) printString).
   491                 nextPutLine:(' majorGC: ',(ObjectMemory garbageCollectCount) printString).
   384             ok := true.
   492             ok := true.
   385         ].
   493         ].
   386         
   494         
   387         (showAll or:[ what startsWith:'flag' ]) ifTrue:[
   495         (showAll or:[ what startsWith:'flag' ]) ifTrue:[
   388             showAll ifTrue:[ errStream cr; nextPutLine:'Flags:'; nextPutLine:'------' ].
   496             showAll ifTrue:[ errStream cr; nextPutLine:'Flags:'; nextPutLine:'------' ].
   456 		    cr.
   564 		    cr.
   457 	    ].
   565 	    ].
   458     ].
   566     ].
   459 
   567 
   460     "Created: / 07-12-2006 / 18:49:17 / cg"
   568     "Created: / 07-12-2006 / 18:49:17 / cg"
       
   569 !
       
   570 
       
   571 showPackages
       
   572     |all|
       
   573 
       
   574     all := Set new.
       
   575     Smalltalk knownLoadablePackagesDo:[:packageID :type :path |
       
   576         all add:packageID
       
   577     ].
       
   578     all := all asOrderedCollection sort.
       
   579     all do:[:eachPackage |
       
   580         self errorStream nextPutLine:eachPackage.
       
   581     ].    
       
   582 
       
   583     "
       
   584      ReadEvalPrintLoop basicNew showPackages
       
   585     "
   461 ! !
   586 ! !
   462 
   587 
   463 !ReadEvalPrintLoop methodsFor:'evaluation'!
   588 !ReadEvalPrintLoop methodsFor:'evaluation'!
   464 
   589 
   465 basicReadEvalPrintLoopWithInput:input output:output error:error
   590 basicReadEvalPrintLoopWithInput:input output:output error:error