Squeak-dev December 2020

squeak-dev@lists.squeakfoundation.org

32 participants
172 discussions

Re: [squeak-dev] [ANN] DoItFirst command line goodie on SqueakSource
by stes＠PANDORA.BE 10 Dec '20

10 Dec '20

-----BEGIN PGP SIGNED MESSAGE----- Hash: SHA256 Nice utility. It provides a workaround or solution to Transcript redirectToStdOut not working (or not working robustly). $ cat headless-hello.sq TranscriptStream redirectToStdOut. Transcript show:'hello world'. Smalltalk quitPrimitive $ squeak -headless squeak.image headless-hello.sq For some reason the above prints no output in squeak-4. I believe that I tested it on older Squeak versions (version 3?) and there, redirectToStdout worked. Or perhaps in some versions I notice that it sometimes seems to print on stdout and sometimes not. But anyway the DoItFirst package and its -evaluate on the other hand, uses "Filestream stdout" and seems to work better; it depends on the asString message (it sends asString to the argument that is being evaluated). $ squeak -headless squeak.image -- -evaluate "#'hello world'" hello world $ squeak -headless squeak.image -- -evaluate "Smalltalk imageFormatVersion" 6504 In any case this provides a mechanism for batch oriented processing. Thanks, David Stes -----BEGIN PGP SIGNATURE----- Version: GnuPG v2 iQEcBAEBCAAGBQJfw8EKAAoJEAwpOKXMq1MaPPMH/Av2+4xVDKutBXZBlfvUbx1c o6Z9OuVhvtnMdIPU19fIy0o4347V0AqKNrxFJz1MQaF05ZBu7a9hXf3+qsF6pkTY xfNRRd8sIYajGrad9bjPjPotMFJKn+pYFdg7Tp/IKc4yXv9x+kzPJRCRqtlM94qH m91zcW1vK6yqNWxeS0FBvpSXpNgxTP0aOw4myzb0VzXB/Tge9BS2QOfQi4NIx/0O p8Nqumvo0YJA30Fvvrz163Dng8LeH97yfeh1q1DXp987Ys5Sa5pfboy2CWjiWqsS T9thHiZa0wt2KZoB8m2WUdT2wXKv+uYRmYvx6Wh4d5vfST1Ql774pE+0uRGXBdE= =quQK -----END PGP SIGNATURE-----

4 11

Error in inspector for WideCharacterSet
by Fabio Niephaus 09 Dec '20

09 Dec '20

Hi all, Just looked through some of the tests and found an issue with WideCharacterSets: Inspect the following: `CharacterSet newFrom: (String with: 811 asCharacter with: $c)` Would be great if someone could have a look. Thanks, Fabio [image: image.png]

2 2

The Trunk: System-mt.1196.mcz
by commits＠source.squeak.org 09 Dec '20

09 Dec '20

Marcel Taeumel uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-mt.1196.mcz ==================== Summary ==================== Name: System-mt.1196 Author: mt Time: 9 December 2020, 11:08:33.726163 am UUID: 93f95297-e0dd-43a5-84a8-16fa9ea4c6e2 Ancestors: System-dtl.1195 Removes duplication for author initials "md". =============== Diff against System-dtl.1195 =============== Item was changed: ----- Method: SystemNavigation class>>privateAuthorsRaw (in category 'class initialization') ----- (excessive size, no diff calculated) Item was changed: + (PackageInfo named: 'System') postscript: 'SystemNavigation initializeAuthors....'! - (PackageInfo named: 'System') postscript: 'SystemNavigation initializeAuthors...'!

1 0

The Trunk: Files-dtl.185.mcz
by commits＠source.squeak.org 08 Dec '20

08 Dec '20

David T. Lewis uploaded a new version of Files to project The Trunk: http://source.squeak.org/trunk/Files-dtl.185.mcz ==================== Summary ==================== Name: Files-dtl.185 Author: dtl Time: 8 December 2020, 4:13:54.809395 pm UUID: 722a668c-0449-4292-8076-fe77438b3ddd Ancestors: Files-eem.184 Let DoItFirstTest>>startup invoke DoItFirst>>reevaluateCwd. If a DoItFirst command line option has specified a new FileDirectory default, apply it now. =============== Diff against Files-eem.184 =============== Item was changed: ----- Method: FileDirectory class>>startUp (in category 'name utilities') ----- startUp "Establish the platform-specific FileDirectory subclass. Do any platform-specific startup." self setDefaultDirectoryClass. self setDefaultDirectory: (self dirPathFor: Smalltalk imageName). Preferences startInUntrustedDirectory ifTrue:[ "The SecurityManager may override the default directory to prevent unwanted write access etc." self setDefaultDirectory: SecurityManager default untrustedUserDirectory. "Make sure we have a place to go to" DefaultDirectory assureExistence]. Smalltalk openSourceFiles. + (Smalltalk classNamed: #DoItFirst) ifNotNil: [ :doit | doit perform: #reevaluateCwd ]. !

1 0

The Trunk: Tests-dtl.443.mcz
by commits＠source.squeak.org 08 Dec '20

08 Dec '20

David T. Lewis uploaded a new version of Tests to project The Trunk: http://source.squeak.org/trunk/Tests-dtl.443.mcz ==================== Summary ==================== Name: Tests-dtl.443 Author: dtl Time: 8 December 2020, 4:12:09.524558 pm UUID: 7c308020-16a4-4b76-83c9-5bc4ba13fd98 Ancestors: Tests-mt.442 Add DoItFirstTest to verify command line parsing for DoitFirst and confirm mapping of command line tokens to known options. =============== Diff against Tests-mt.442 =============== Item was added: + TestCase subclass: #DoItFirstTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Tests-System-Support'! + + !DoItFirstTest commentStamp: 'dtl 12/6/2020 20:02' prior: 0! + A DoItFirstTest verifies command line parsing for DoitFirst to confirm mapping of command line tokens to known options. + ! Item was added: + ----- Method: DoItFirstTest>>testEvaluateFileContents (in category 'tests') ----- + testEvaluateFileContents + | doItFirst actionBlocks action blockArg | + doItFirst := DoItFirst new. + { + { '--' . 'foo' . 'bar' . '--file' . 'arg1' . 'arg2' . 'arg3' } . + { '--' . 'foo' . 'bar' . '-file' . 'arg1' . 'arg2' . 'arg3' } . + { '--' . 'foo' . 'bar' . '-f' . 'arg1' . 'arg2' . 'arg3' } . + { 'foo' . 'bar' . '--file' . 'arg1' . 'arg2' . 'arg3' } . + { 'foo' . 'bar' . '-file' . 'arg1' . 'arg2' . 'arg3' } . + { 'foo' . 'bar' . '-f' . 'arg1' . 'arg2' . 'arg3' } + } do: [ :args | + actionBlocks := doItFirst parse: args. + self assert: 1 equals: actionBlocks size. + action := actionBlocks first. + self assert: action equals: (doItFirst actions at: #file). + self assert: 0 equals: action numArgs. + self assert: 1 equals: action numTemps. + blockArg := (action at: 1) first. + self assert: 'arg1' equals: blockArg. + ]. + ! Item was added: + ----- Method: DoItFirstTest>>testEvaluateOption (in category 'tests') ----- + testEvaluateOption + | doItFirst actionBlocks action blockArg | + doItFirst := DoItFirst new. + { + { '--' . 'foo' . 'bar' . '--evaluate' . 'arg1' . 'arg2' . 'arg3' } . + { '--' . 'foo' . 'bar' . '-evaluate' . 'arg1' . 'arg2' . 'arg3' } . + { '--' . 'foo' . 'bar' . '-e' . 'arg1' . 'arg2' . 'arg3' } . + { 'foo' . 'bar' . '--evaluate' . 'arg1' . 'arg2' . 'arg3' } . + { 'foo' . 'bar' . '-evaluate' . 'arg1' . 'arg2' . 'arg3' } . + { 'foo' . 'bar' . '-e' . 'arg1' . 'arg2' . 'arg3' } + } do: [ :args | + actionBlocks := doItFirst parse: args. + self assert: 1 equals: actionBlocks size. + action := actionBlocks first. + self assert: action equals: (doItFirst actions at: #evaluate). + self assert: 0 equals: action numArgs. + self assert: 1 equals: action numTemps. + blockArg := (action at: 1) first. + self assert: 'arg1' equals: blockArg. + ]. + ! Item was added: + ----- Method: DoItFirstTest>>testParseCwd (in category 'tests') ----- + testParseCwd + | doItFirst actionBlocks action blockArg | + doItFirst := DoItFirst new. + { + { '--' . 'foo' . 'bar' . '--cwd' . 'arg1' . 'arg2' . 'arg3' } . + { '--' . 'foo' . 'bar' . '-cwd' . 'arg1' . 'arg2' . 'arg3' } . + { '--' . 'foo' . 'bar' . '-c' . 'arg1' . 'arg2' . 'arg3' } . + { 'foo' . 'bar' . '--cwd' . 'arg1' . 'arg2' . 'arg3' } . + { 'foo' . 'bar' . '-cwd' . 'arg1' . 'arg2' . 'arg3' } . + { 'foo' . 'bar' . '-c' . 'arg1' . 'arg2' . 'arg3' } + } do: [ :args | + actionBlocks := doItFirst parse: args. + self assert: 1 equals: actionBlocks size. + action := actionBlocks first. + self assert: action equals: (doItFirst actions at: #cwd). + self assert: 0 equals: action numArgs. + self assert: 1 equals: action numTemps. + blockArg := (action at: 1) first. + self assert: 'arg1' equals: blockArg. + ]. + ! Item was added: + ----- Method: DoItFirstTest>>testParseDebug (in category 'tests') ----- + testParseDebug + "Debug is a deferred action, registered in the actions but not added + to the list of actions to be immediately evaluated" + | doItFirst actionBlocks deferredAction | + doItFirst := DoItFirst new. + { + { '--' . 'foo' . 'bar' . '--debug' . 'arg1' . 'arg2' . 'arg3' } . + { '--' . 'foo' . 'bar' . '-debug' . 'arg1' . 'arg2' . 'arg3' } . + { 'foo' . 'bar' . '--debug' . 'arg1' . 'arg2' . 'arg3' } . + { 'foo' . 'bar' . '-debug' . 'arg1' . 'arg2' . 'arg3' } . + } do: [ :args | + actionBlocks := doItFirst parse: args. + self assert: 0 equals: actionBlocks size. "deferred action" + deferredAction := doItFirst actions at: #debug. + self assert: 0 equals: deferredAction numArgs. + self assert: 0 equals: deferredAction numTemps + ]. + ! Item was added: + ----- Method: DoItFirstTest>>testParseDoit (in category 'tests') ----- + testParseDoit + | doItFirst actionBlocks action blockArg | + doItFirst := DoItFirst new. + { + { '--' . 'foo' . 'bar' . '--doit' . 'arg1' . 'arg2' . 'arg3' } . + { '--' . 'foo' . 'bar' . '-doit' . 'arg1' . 'arg2' . 'arg3' } . + { '--' . 'foo' . 'bar' . '-d' . 'arg1' . 'arg2' . 'arg3' } . + { 'foo' . 'bar' . '--doit' . 'arg1' . 'arg2' . 'arg3' } . + { 'foo' . 'bar' . '-doit' . 'arg1' . 'arg2' . 'arg3' } . + { 'foo' . 'bar' . '-d' . 'arg1' . 'arg2' . 'arg3' } + } do: [ :args | + actionBlocks := doItFirst parse: args. + self assert: 1 equals: actionBlocks size. + action := actionBlocks first. + self assert: action equals: (doItFirst actions at: #doit). + self assert: 0 equals: action numArgs. + self assert: 1 equals: action numTemps. + blockArg := (action at: 1) first. + self assert: 3 equals: blockArg size. + self assert: 'arg1' equals: blockArg first. + self assert: 'arg2' equals: blockArg second. + self assert: 'arg3' equals: blockArg third. + ]. + ! Item was added: + ----- Method: DoItFirstTest>>testParseDoitArgsListWithFileArg (in category 'tests') ----- + testParseDoitArgsListWithFileArg + | doItFirst actionBlocks action blockArg | + doItFirst := DoItFirst new. + { + { '--' . 'foo' . 'bar' . '--doit' . 'arg1' . 'arg2' . 'arg3' . '-f' . 'arg4'} . + { '--' . 'foo' . 'bar' . '-doit' . 'arg1' . 'arg2' . 'arg3' . '-f' . 'arg4'} . + { '--' . 'foo' . 'bar' . '-d' . 'arg1' . 'arg2' . 'arg3' . '-f' . 'arg4'} . + { 'foo' . 'bar' . '--doit' . 'arg1' . 'arg2' . 'arg3' . '-f' . 'arg4'} . + { 'foo' . 'bar' . '-doit' . 'arg1' . 'arg2' . 'arg3' . '-f' . 'arg4'} . + { 'foo' . 'bar' . '-d' . 'arg1' . 'arg2' . 'arg3' . '-f' . 'arg4'} + } do: [ :args | + actionBlocks := doItFirst parse: args. + self assert: 2 equals: actionBlocks size. + action := actionBlocks first. + self assert: action equals: (doItFirst actions at: #doit). + self assert: 0 equals: action numArgs. + self assert: 1 equals: action numTemps. + blockArg := (action at: 1) first. + self assert: 3 equals: blockArg size. + self assert: 'arg1' equals: blockArg first. + self assert: 'arg2' equals: blockArg second. + self assert: 'arg3' equals: blockArg third. + ]. + + ! Item was added: + ----- Method: DoItFirstTest>>testParseDoitArgsListWithHelpArg (in category 'tests') ----- + testParseDoitArgsListWithHelpArg + | doItFirst actionBlocks action blockArg | + doItFirst := DoItFirst new. + { + { '--' . 'foo' . 'bar' . '--doit' . 'arg1' . 'arg2' . 'arg3' . '-help' . 'arg4'} . + { '--' . 'foo' . 'bar' . '-doit' . 'arg1' . 'arg2' . 'arg3' . '-help' . 'arg4'} . + { '--' . 'foo' . 'bar' . '-d' . 'arg1' . 'arg2' . 'arg3' . '-help' . 'arg4'} . + { 'foo' . 'bar' . '--doit' . 'arg1' . 'arg2' . 'arg3' . '-help' . 'arg4'} . + { 'foo' . 'bar' . '-doit' . 'arg1' . 'arg2' . 'arg3' . '-help' . 'arg4'} . + { 'foo' . 'bar' . '-d' . 'arg1' . 'arg2' . 'arg3' . '-help' . 'arg4'} + } do: [ :args | + actionBlocks := doItFirst parse: args. + self assert: 2 equals: actionBlocks size. + action := actionBlocks second. + self assert: action equals: (doItFirst actions at: #doit). + self assert: 0 equals: action numArgs. + self assert: 1 equals: action numTemps. + blockArg := (action at: 1) first. + self assert: 3 equals: blockArg size. + self assert: 'arg1' equals: blockArg first. + self assert: 'arg2' equals: blockArg second. + self assert: 'arg3' equals: blockArg third. + ]. + ! Item was added: + ----- Method: DoItFirstTest>>testParseFIleinArgsListWithHelpArg (in category 'tests') ----- + testParseFIleinArgsListWithHelpArg + | doItFirst actionBlocks action blockArg | + doItFirst := DoItFirst new. + { + { '--' . 'foo' . 'bar' . '--filein' . 'arg1' . 'arg2' . 'arg3' . '-help' . 'arg4'} . + { '--' . 'foo' . 'bar' . '-filein' . 'arg1' . 'arg2' . 'arg3' . '-help' . 'arg4'} . + { 'foo' . 'bar' . '--filein' . 'arg1' . 'arg2' . 'arg3' . '-help' . 'arg4'} . + { 'foo' . 'bar' . '-filein' . 'arg1' . 'arg2' . 'arg3' . '-help' . 'arg4'} . + } do: [ :args | + actionBlocks := doItFirst parse: args. + self assert: 2 equals: actionBlocks size. + action := actionBlocks second. + self assert: action equals: (doItFirst actions at: #filein). + self assert: 0 equals: action numArgs. + self assert: 1 equals: action numTemps. + blockArg := (action at: 1) first. + self assert: 3 equals: blockArg size. + self assert: 'arg1' equals: blockArg first. + self assert: 'arg2' equals: blockArg second. + self assert: 'arg3' equals: blockArg third. + ]. + ! Item was added: + ----- Method: DoItFirstTest>>testParseFilein (in category 'tests') ----- + testParseFilein + | doItFirst actionBlocks action blockArg | + doItFirst := DoItFirst new. + { + { '--' . 'foo' . 'bar' . '--filein' . 'arg1' . 'arg2' . 'arg3' } . + { '--' . 'foo' . 'bar' . '-filein' . 'arg1' . 'arg2' . 'arg3' } . + { 'foo' . 'bar' . '--filein' . 'arg1' . 'arg2' . 'arg3' } . + { 'foo' . 'bar' . '-filein' . 'arg1' . 'arg2' . 'arg3' } . + } do: [ :args | + actionBlocks := doItFirst parse: args. + self assert: 1 equals: actionBlocks size. + action := actionBlocks first. + self assert: action equals: (doItFirst actions at: #filein). + self assert: 0 equals: action numArgs. + self assert: 1 equals: action numTemps. + blockArg := (action at: 1) first. + self assert: 3 equals: blockArg size. + self assert: 'arg1' equals: blockArg first. + self assert: 'arg2' equals: blockArg second. + self assert: 'arg3' equals: blockArg third. + ]. + ! Item was added: + ----- Method: DoItFirstTest>>testParseFileinArgsListWithFileArg (in category 'tests') ----- + testParseFileinArgsListWithFileArg + | doItFirst actionBlocks action blockArg | + doItFirst := DoItFirst new. + { + { '--' . 'foo' . 'bar' . '--filein' . 'arg1' . 'arg2' . 'arg3' . '-f' . 'arg4'} . + { '--' . 'foo' . 'bar' . '-filein' . 'arg1' . 'arg2' . 'arg3' . '-f' . 'arg4'} . + { 'foo' . 'bar' . '--filein' . 'arg1' . 'arg2' . 'arg3' . '-f' . 'arg4'} . + { 'foo' . 'bar' . '-filein' . 'arg1' . 'arg2' . 'arg3' . '-f' . 'arg4'} . + } do: [ :args | + actionBlocks := doItFirst parse: args. + self assert: 2 equals: actionBlocks size. + action := actionBlocks first. + self assert: action equals: (doItFirst actions at: #filein). + self assert: 0 equals: action numArgs. + self assert: 1 equals: action numTemps. + blockArg := (action at: 1) first. + self assert: 3 equals: blockArg size. + self assert: 'arg1' equals: blockArg first. + self assert: 'arg2' equals: blockArg second. + self assert: 'arg3' equals: blockArg third. + ]. + + ! Item was added: + ----- Method: DoItFirstTest>>testParseHelp (in category 'tests') ----- + testParseHelp + | doItFirst actionBlocks action | + doItFirst := DoItFirst new. + { + { '--' . 'foo' . 'bar' . '--help' . 'arg1' . 'arg2' . 'arg3' } . + { '--' . 'foo' . 'bar' . '-help' . 'arg1' . 'arg2' . 'arg3' } . + { '--' . 'foo' . 'bar' . '-h' . 'arg1' . 'arg2' . 'arg3' } . + { 'foo' . 'bar' . '--help' . 'arg1' . 'arg2' . 'arg3' } . + { 'foo' . 'bar' . '-help' . 'arg1' . 'arg2' . 'arg3' } . + { 'foo' . 'bar' . '-h' . 'arg1' . 'arg2' . 'arg3' } + } do: [ :args | + actionBlocks := doItFirst parse: args. + self assert: 1 equals: actionBlocks size. + action := actionBlocks first. + self assert: action equals: (doItFirst actions at: #help). + self assert: 0 equals: action numArgs. + self assert: 0 equals: action numTemps + ]. + !

1 0

The Trunk: System-dtl.1195.mcz
by commits＠source.squeak.org 08 Dec '20

08 Dec '20

David T. Lewis uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-dtl.1195.mcz ==================== Summary ==================== Name: System-dtl.1195 Author: dtl Time: 8 December 2020, 4:10:40.495367 pm UUID: 88a0ce82-643e-47c4-83e9-27404ce5f71f Ancestors: System-eem.1194 Add DoItFirst to be the first thing in the system startup list, processing certain command line options prior to any additional image initialization. DoItFirst image arguments: --doit argumentlist "evaluate each argument as a doIt expression" --evaluate arg "evaluate arg, print result then exit" --file filename "evaluate contents of filename, print result then exit" --filein filelist "file in each file named in fileList" --cwd path "set FileDirectory defaultDirectory to path prior to evaluating other options" --debug "enter a debugger as soon as possible in the startUp processing" --help "print this message" Some arguments have single character synonyms, -f is a synonym for --file, -d for --doit A single '-' may be used instead of '--', -help is interpreted as --help =============== Diff against System-eem.1194 =============== Item was added: + Object subclass: #DoItFirst + instanceVariableNames: 'actions' + classVariableNames: 'Current' + poolDictionaries: '' + category: 'System-Support'! + + !DoItFirst commentStamp: 'dtl 12/6/2020 14:39' prior: 0! + Be the first thing in the system startup list, and do things that should be done prior to any additional image initialization. If the first image argument is a recognized option, evaluate it. Image arguments are typically preceded by a '--' token on the command line. + + DoItFirst image arguments: + --doit argumentlist "evaluate each argument as a doIt expression" + --evaluate arg "evaluate arg, print result then exit" + --file filename "evaluate contents of filename, print result then exit" + --filein filelist "file in each file named in fileList" + --cwd path "set FileDirectory defaultDirectory to path prior to evaluating other options" + --debug "enter a debugger as soon as possible in the startUp processing" + --help "print this message" + + Some arguments have single character synonyms, -f is a synonym for --file, -d for --doit + A single '-' may be used instead of '--', -help is interpreted as --help + ! Item was added: + ----- Method: DoItFirst class>>current (in category 'class initialization') ----- + current + "Protect against nil in case package was reloaded and existing startUp + methods refer to the current instance." + ^Current ifNil: [ Current := self new ]! Item was added: + ----- Method: DoItFirst class>>initialize (in category 'class initialization') ----- + initialize + Smalltalk addToStartUpList: self before: SmallInteger.! Item was added: + ----- Method: DoItFirst class>>reevaluateCwd (in category 'reevaluate options') ----- + reevaluateCwd + "If a -cwd option was specified on the command line, reevaluate it now. + May be called from FileDirectory class>>startUp: to reevaluate the command line + option to ensure that the default directory is ultimately set as specified by the -cwd + image command line option." + + ^ self current evaluateArg: #cwd.! Item was added: + ----- Method: DoItFirst class>>reevaluateDebug (in category 'reevaluate options') ----- + reevaluateDebug + "The -debug option cannot be evaluated at DoInNow startUp time, but may be called + later in the startUp processing. If -debug was not specified as a command option this + method does nothing. + + May be called from Delay>>startup to invoke a debugger at the earliest possible time." + + ^ self current evaluateArg: #debug.! Item was added: + ----- Method: DoItFirst class>>startUp: (in category 'system startup') ----- + startUp: resuming + resuming ifTrue: [ Current := self new. Current evaluateArgs ] + ! Item was added: + ----- Method: DoItFirst>>actions (in category 'private') ----- + actions + ^actions! Item was added: + ----- Method: DoItFirst>>add:to:at: (in category 'private') ----- + add: valuable to: actionList at: key + "Add valuable to the end of action list, and register it at key so that it may + be reevaluated at a later time if necessary." + actionList addLast: valuable. + actions at: key put: valuable.! Item was added: + ----- Method: DoItFirst>>addFirst:to:at: (in category 'private') ----- + addFirst: valuable to: actionList at: key + "Add valuable to the beginning of action list, and register it at key so that it may + be reevaluated at a later time if necessary." + actionList addFirst: valuable. + actions at: key put: valuable.! Item was added: + ----- Method: DoItFirst>>addWithoutEvaluation:at: (in category 'private') ----- + addWithoutEvaluation: valuable at: key + "Register action at key so that it may be reevaluated at a later time. Do not + evaluate in the startUp of DoItNow. Used when the action cannot yet be + evaluated because it requires startUp processing later in the startup list." + actions at: key put: valuable.! Item was added: + ----- Method: DoItFirst>>cwd: (in category 'actions') ----- + cwd: path + "Evaluate arg and print the result on stdout, or error message on stderr. + Exit immediately without saving the image." + (FileDirectory on: path) exists + ifTrue: [ FileDirectory setDefaultDirectory: path ] + ifFalse: [ FileStream stderr nextPutAll: path, ': directory does not exist'; lf; flush. + Smalltalk quitPrimitive ] + ! Item was added: + ----- Method: DoItFirst>>debug (in category 'actions') ----- + debug + "halt and enter a debugger" + Halt new signal: self class name, ' inserted break in StartUpList processing'.! Item was added: + ----- Method: DoItFirst>>doIt: (in category 'actions') ----- + doIt: arguments + "Evaluate arguments and print the result on stdout, or error message on stderr. + Exit the image after any error." + arguments do: [ :arg | + [FileStream stdout nextPutAll: (Compiler evaluate: arg) asString; lf; flush] + on: Error + do: [ :ex | FileStream stderr nextPutAll: ex asString; lf; flush. + Smalltalk quitPrimitive ]]! Item was added: + ----- Method: DoItFirst>>evaluateArg: (in category 'evaluating') ----- + evaluateArg: actionKey + "If actionKey is registered, then evaluate its action. This is intended to allow + a previously evaluated option to be reevaluated at a later point in the system + startup list if necessary." + (actions at: actionKey ifAbsent: []) ifNotNil: [:action | action value]! Item was added: + ----- Method: DoItFirst>>evaluateArgs (in category 'evaluating') ----- + evaluateArgs + | actionQueue | + actionQueue := self parse readStream. + [ actionQueue atEnd ] whileFalse: [ actionQueue next value ]. + ! Item was added: + ----- Method: DoItFirst>>evaluateFileContents: (in category 'actions') ----- + evaluateFileContents: fileName + "Evaluate the contents of a file and print the result on stdout, or error + message on stderr. Exit immediately without saving the image." + + | fs arg | + [ [ fs := FileStream oldFileNamed: fileName. ] + on: FileDoesNotExistException + do: [ :ex | FileStream stderr nextPutAll: ex asString; lf; flush. + Smalltalk quitPrimitive ]. + arg := fs contentsOfEntireFile. + ^ self evaluateOption: arg. + ] ensure: [ fs close ]. + ! Item was added: + ----- Method: DoItFirst>>evaluateOption: (in category 'actions') ----- + evaluateOption: arg + "Evaluate option and print the result on stdout, or error message on stderr. + Exit immediately without saving the image." + [FileStream stdout nextPutAll: (Compiler evaluate: arg) asString; lf; flush] + on: Error + do: [ :ex | FileStream stderr nextPutAll: ex asString; lf; flush ]. + Smalltalk quitPrimitive! Item was added: + ----- Method: DoItFirst>>fileIn: (in category 'actions') ----- + fileIn: fileNames + "File in each named file. On error, print a message to stderr and exit the image." + fileNames do: [ :arg | + [ | fs | + fs := FileStream oldFileNamed: arg. + FileStream stdout nextPutAll: 'file in ', fs name; lf; flush. + fs fileIn ] + on: Error + do: [ :ex | FileStream stderr nextPutAll: ex asString; lf; flush. + Smalltalk quitPrimitive ]]! Item was added: + ----- Method: DoItFirst>>help (in category 'actions') ----- + help + FileStream stdout nextPutAll: self class name, ' image arguments:'; lf. + { '--doit argumentlist "evaluate each argument as a doIt expression"' . + '--evaluate arg "evaluate arg, print result then exit"' . + '--file filename "evaluate contents of filename, print result then exit"' . + '--filein filelist "file in each file named in fileList"' . + '--cwd path "set FileDirectory defaultDirectory to path prior to evaluating other options"' . + '--debug "enter a debugger as soon as possible in the startUp processing"'. + '--help "print this message"' + } do: [ :e | FileStream stdout tab; nextPutAll: e; lf ]. + FileStream stdout + nextPutAll: 'some arguments have single character synonyms, -f is a synonym for --file, -d for --doit'; lf; + nextPutAll: 'single ''-'' may be used instead of ''--'', -help is interpreted as --help'; lf; + flush. + Smalltalk quitPrimitive. + + ! Item was added: + ----- Method: DoItFirst>>initialize (in category 'initialize-release') ----- + initialize + actions := Dictionary new. + ! Item was added: + ----- Method: DoItFirst>>isArg: (in category 'private') ----- + isArg: token + ^ token isEmpty not and: [ token beginsWith: '-' ].! Item was added: + ----- Method: DoItFirst>>keyFor: (in category 'evaluating') ----- + keyFor: argument + "Interpret an argument key from the command line. Be permissive in + allowing '-somearg' to be treated as '--somearg', and where possible let + '-s' be the single character synonym for '--somearg' " + ^ argument caseOf: { + "print help to stdout then exit" + [ '--help' ] -> [ #help ] . + [ '-help' ] -> [ #help ] . + [ '-h' ] -> [ #help ] . + "enter debugger as soon as possible" + [ '--debug' ] -> [ #debug ] . + [ '-debug' ] -> [ #debug ] . + "evaluate each argument string as a doIt" + [ '--doit' ] -> [ #doit ] . + [ '-doit' ] -> [ #doit ] . + [ '-d' ] -> [ #doit ] . + "evaluate expression and exit" + [ '--evaluate' ] -> [ #evaluate ] . + [ '-evaluate' ] -> [ #evaluate ] . + [ '-e' ] -> [ #evaluate ] . + "evaluate contents of file and exit" + [ '--file' ] -> [ #file ] . + [ '-file' ] -> [ #file ] . + [ '-f' ] -> [ #file ] . + "file in one or more files" + [ '--filein' ] -> [ #filein ] . + [ '-filein' ] -> [ #filein ] . + "change FileDirectory default directory" + [ '--cwd' ] -> [ #cwd ] . + [ '-cwd' ] -> [ #cwd ] . + [ '-c' ] -> [ #cwd ] + } otherwise: [ #ignore ]. + ! Item was added: + ----- Method: DoItFirst>>nextTokensFrom: (in category 'evaluating') ----- + nextTokensFrom: argumentStream + "Next available tokens up to the next parseable argument, for commands + that expect an argument list of names or doIt expressions." + + | list | + list := OrderedCollection new. + [ argumentStream atEnd or: [ self isArg: argumentStream peek ]] + whileFalse: [ list add: argumentStream next ]. + ^ list! Item was added: + ----- Method: DoItFirst>>parse (in category 'evaluating') ----- + parse + "Parse the argument list and answer a list of action selectors to be performed" + ^ self parse: Smalltalk arguments. + ! Item was added: + ----- Method: DoItFirst>>parse: (in category 'evaluating') ----- + parse: argumentList + "Iterate over the argument list, adding action blocks to the actions dictionary. + If any action blocks require files or directory initialization send the appropriate + startUp message to do it now. Answer a list of option selectors that should be + evaluated." + + | args actions needsFiles needsDirectory | + needsFiles := needsDirectory := false. + args := argumentList readStream. + actions := OrderedCollection new. + [ args atEnd ] whileFalse: [ | key | + (key := self keyFor: args next) caseOf: { + [ #help ] -> [ self addFirst: [ self help ] to: actions at: key. needsFiles := true] . + [ #debug ] -> [ self addWithoutEvaluation: [ self debug ] at: key] . + [ #doit ] -> [ | list | list := self nextTokensFrom: args. self add:[ self doIt: list ] to: actions at: key. needsFiles := true] . + [ #evaluate ] -> [ | arg | arg := args next. self add:[ self evaluateOption: arg ] to: actions at: key. needsFiles := true] . + [ #file ] -> [ | arg | arg := args next. self add:[ self evaluateFileContents: arg ] to: actions at: key. needsFiles := true] . + [ #filein ] -> [ | list | list := self nextTokensFrom: args. self add:[ self fileIn: list ] to: actions at: key. needsFiles := needsDirectory := true] . + [ #cwd ] -> [ | arg | arg := args next. self addFirst:[ self cwd: arg ] to: actions at: key. needsFiles := needsDirectory := true] . + } otherwise: [] ]. + needsFiles ifTrue: [ FileStream startUp: true. "initialize stdout and stderr" ]. + needsDirectory ifTrue: [ FileDirectory startUp "set default directory" ]. + ^ actions. + !

1 0

Smalltalk specialObjectsArray at: 38
by Marcel Taeumel 08 Dec '20

08 Dec '20

Hi Eliot. In current Trunk, which has SistaV1 enabled, "Smalltalk specialObjectsArray at: 38" is still "nil" but should be "FullBlockClosure". Is this good? How can the bytecode "pushFullClosure" work? CC squeak-dev Best, Marcel

2 1

The Inbox: CollectionsTests-ct.347.mcz
by commits＠source.squeak.org 07 Dec '20

07 Dec '20

A new version of CollectionsTests was added to project The Inbox: http://source.squeak.org/inbox/CollectionsTests-ct.347.mcz ==================== Summary ==================== Name: CollectionsTests-ct.347 Author: ct Time: 7 December 2020, 6:46:54.870326 pm UUID: 1de6ec63-21e0-7248-acc6-4b0e71a82475 Ancestors: CollectionsTests-mt.346 Tests Collections-ct.922 (Dictionary >> #at:put:during:). =============== Diff against CollectionsTests-mt.346 =============== Item was added: + ----- Method: DictionaryTest>>testAtPutDuring (in category 'tests - basic') ----- + testAtPutDuring + + | dictionary | + dictionary := Dictionary new. + + dictionary at: #a put: 3 during: [ + self assert: 3 equals: (dictionary at: #a)]. + self deny: (dictionary includesKey: #a). + + dictionary + at: #a put: 2; + at: #a put: 3 during: [ + self assert: 3 equals: (dictionary at: #a)]. + self assert: 2 equals: (dictionary at: #a). + + dictionary at: #a put: 3 during: [ + self assert: 3 equals: (dictionary at: #a). + dictionary at: #a put: 4]. + self assert: 4 equals: (dictionary at: #a). + self fail. + dictionary + at: #a put: 2; + at: #a put: 3 during: [ + self assert: 3 equals: (dictionary at: #a). + dictionary removeKey: #a]. + self deny: (dictionary includesKey: #a).!

1 0

Tool labels are ... odd (Senders/Implementors of)
by Chris Cunningham 07 Dec '20

07 Dec '20

For Senders and Implementors, they work. If I click on the Vars button (to see where Instance Variables are used), the tool shows up as 'Sender of <variableName>', which isn't right. If I do Class References, the window/tool also shows up as Senders of. Being a person who has many windows open in Squeak, this makes it hard to track down where the right window is. If any one has an idea where this is (or, better yet, can fix it), wonderful. Failing that, I'll eventually get around to submitting my own fix. Thanks, cbc

1 0

The Inbox: Morphic-ct.1716.mcz
by commits＠source.squeak.org 06 Dec '20

06 Dec '20

Christoph Thiede uploaded a new version of Morphic to project The Inbox: http://source.squeak.org/inbox/Morphic-ct.1716.mcz ==================== Summary ==================== Name: Morphic-ct.1716 Author: ct Time: 6 December 2020, 6:03:02.43962 pm UUID: b5046c96-a83e-2543-b9e2-4b56a3e99a1a Ancestors: Morphic-mt.1713 Re-enables handling of #launchDrop events when the VM is configured as a singleton and has been invoked again, though currently only handled with a rudimentary fallback implementation. See http://forum.world.st/Changeset-Enhanced-integration-of-drag-n-drop-from-ho…. Thanks to Jakob (jr) for the feedback! Reuploaded as replacement for Morphic-ct.1715. Thanks also to Marcel for the feedback! :-) =============== Diff against Morphic-mt.1713 =============== Item was changed: ----- Method: HandMorph>>generateDropFilesEvent: (in category 'private events') ----- generateDropFilesEvent: evtBuf "Generate the appropriate mouse event for the given raw event buffer." | position buttons modifiers stamp numFiles dragType | stamp := evtBuf second. stamp = 0 ifTrue: [stamp := Time eventMillisecondClock]. dragType := evtBuf third. position := evtBuf fourth @ evtBuf fifth. buttons := MouseEvent redButton. "hacked because necessary for correct mouseMoveDragging handling" modifiers := evtBuf sixth. buttons := buttons bitOr: (modifiers bitShift: 3). numFiles := evtBuf seventh. dragType caseOf: { [1] -> [ "dragEnter" externalDropMorph := TransferMorph new dragTransferType: #filesAndDirectories; source: self; passenger: (numFiles = 0 "Usually, numFiles and drop paths are delivered on dragDrop only. Still reserving this possibility for able host implementations." ifTrue: [self flag: #vmCapabilityMissing. 'Unknown host content' translated] ifFalse: [self collectDropFilesAndDirectories: numFiles]); yourself. "During the drag operation, the host system is responsible for displaying the cursor." self grabMorph: externalDropMorph. self showTemporaryCursor: Cursor blank. externalDropMorph bottomRight: self topLeft. "Southeast area of the cursor is blocked by drawings from the source application. Display our drop morph at the opposite corner of the cursor." ]. [2] -> [ "dragMove" ^ MouseMoveEvent new setType: #mouseMove startPoint: self position endPoint: position trail: "{self position. position}"(self mouseDragTrailFrom: evtBuf) buttons: buttons hand: self stamp: stamp ]. [3] -> [ "dragLeave" externalDropMorph ifNotNil: #abandon. externalDropMorph := nil. self showTemporaryCursor: nil ]. [4] -> [ "dragDrop" + | oldButtons event | + oldButtons := lastEventBuffer fifth + bitOr: (lastEventBuffer sixth bitShift: 3). + event := MouseButtonEvent new + setType: #mouseUp + position: position + which: (oldButtons bitXor: buttons) + buttons: buttons + nClicks: 0 + hand: self + stamp: stamp. + - | oldButtons | externalDropMorph ifNil: [ + "dragDrop has been sent without prior dragging. This happens when the VM is configured as singleton application and has been invoked again with a new image file (aka #launchDrop, runAsSingleInstance on Unix, or RunSingleApp on Windows)." + self flag: #forLater. "ct: When we decouple event generation from Morphic, we will probably need to introduce a separate SystemLaunchEvent class for this event. See http://forum.world.st/Changeset-Enhanced-integration-of-drag-n-drop-from-ho…." + Project current + launchSystemFiles: (self collectDropFilesAndDirectories: numFiles) + event: event. + ^ nil]. - "dragDrop has been sent without prior dragging. This happens when the VM is configured as singleton application and has been called again (aka #launchDrop)." - ^ self error: 'Launch drop for singleton Squeak not yet implemented.']. self showTemporaryCursor: nil. externalDropMorph passenger isString ifTrue: [ self flag: #vmCapabilityMissing. "See above." externalDropMorph passenger: (self collectDropFilesAndDirectories: numFiles)]. externalDropMorph := nil. (Smalltalk classNamed: #DropFilesEvent) ifNotNil: [:eventClass | | classicEvent | "Generate classic DropFilesEvent, providing backward compatibility." classicEvent := eventClass new setPosition: position contents: numFiles hand: self. self processEvent: classicEvent. classicEvent wasHandled ifTrue: [^ nil]]. + ^ event ]. - oldButtons := lastEventBuffer fifth - bitOr: (lastEventBuffer sixth bitShift: 3). - ^ MouseButtonEvent new - setType: #mouseUp - position: position - which: (oldButtons bitXor: buttons) - buttons: buttons - nClicks: 0 - hand: self - stamp: stamp ]. [5] -> [ "drag request" "For dnd out. Not properly implemented at the moment." self shouldBeImplemented] }. ^ nil! Item was added: + ----- Method: MorphicProject>>launchSystemFiles:event: (in category 'utilities') ----- + launchSystemFiles: fileStreams event: genericMorphicEvent + "Handle a number of files the singleton VM was invoked with again." + + self flag: #todo. "Do something more useful with the image here, e. g. tell the VM to load it." + self inform: ('Cannot start a second instance of Squeak\with the image "{1}"\because the VM is configured as singleton application.' withCRs translated format: {fileStreams first localName}).!

1 0

Jump to page: