Squeak
  links to this page:    
View this PageEdit this PageUploads to this PageHistory of this PageTop of the SwikiRecent ChangesSearch the SwikiHelp Guide
Recipe: How to list all global variables
Last updated at 7:56 pm UTC on 4 April 2017
The code below produces a set of Associations: name of the global with its value. All classes are globals but they are excluded in this set.
	(Smalltalk globals keys reject: [:k | (Smalltalk globals at: k) isBehavior])
			collect: [:k | k -> (Smalltalk globals at: k) class].

The code is in SystemDictionary's class comment.
Checked for Squeak 6.0alpha

Earlier code was
   Smalltalk keys
    select:
    [:k | ((Smalltalk at: k) isKindOf: Class) not]
       thenCollect:
      [:k | k -> (Smalltalk at: k) class]


Follow the discussion then update this page....

Globals


ActiveEvent
ActiveHand
ActiveWorld
CustomEventsRegistry
Display
ImageImports
Processor
References
ScheduledControllers
ScriptingSystem
Sensor
Smalltalk
SourcesFiles
TextConstants
Undeclared
World



Aaron Gray December 08, 2004 Are Smalltalk and SystemOrganization "global variables". If so where are the system globals and how do I list them, within a browser and say to the Transaction window from the workspace?

Boris Gaertner Yes, Smalltalk and SystemOrganization are "global variables". All the globals are in Smalltalk, which is an instance of SystemDictionary. Evaluate the following statements with print to obtain a feeling for this:
Smalltalk class
Smalltalk includesKey: #Smalltalk
Smalltalk includesKey: #SystemOrganization
Smalltalk is also the Dictionary that contains all classes. That is OK, classes are globally defined entities, too. Now, what you are really after is:
Smalltalk reject: [:item | item class isMeta ]
Evaluate this with 'inspect, it opens an inspector that shows you all globals that are not classes. (see footnote below) Here is exactly what you want:
(Smalltalk reject: [:item | item class isMeta ])
  associationsDo: [:assoc  | Transcript show: assoc key printString; cr].
This prints the names of the non-class globals into the transcript window.Note that
   (Smalltalk reject: [:item | item class isMeta ]) 
answers selected associations from Smalltalk. With
 associationsDo: [:assoc  | Transcript show: assoc key printString; cr].
we print only the keys of the assocs, the values of some globals have huge printed representations; it is therefore not a good idea to write them into the transcript.
Footnote: The 'class isMeta' looks like magic, but it is not. isMeta is defined in the instance protocol of classes Behavior and MetaClass. The class of a class is an instance of MetaClass, when sent the message isMeta, it answers true. Classes answer false.

Aaron Gray The main problem I seem to have with looking at code is seeing what class certain methods are for example in :-
   (Smalltalk reject: [:item | item class isMeta ])
       associationsDo: [:assoc  | Transcript show: assoc key printString; cr].
What class is key, if I look at Association I see key returns a key, but what class is that key that printString is being applied to? I find this same problem over and over, is there a simple solution ? I may have been given the answer at somepoint but cannot remember.

Yar Hwee Boon You can put a self halt before the "Transcript show" to find out. (Aaron Gray Err, tried it, but cannot see how?) Click debug, then inspect assoc (or assoc key) from the debugger. Inspectors show the class of the object it is looking at in the window title bar. Explorers don't. (Aaron Gray Ah, The key is a Symbol. So you have to run the code to find that out. And there is no other simple way ?) Class comments might describe this, but in this case it seems not. Actually, I've found it more convenient to actually find out information like this either through sending #class to an instance or viewing it in an inspector, ie. like you say, through code. Not sure how the others do it
though. Remember, its a great environment for exploration, running code should be fun :)

Yoshiki Ohshima A more "retrospective" (?) way, or a way to avoid to execute critical code directly is to ask "themselves" (i.e. objects) what invariant they satisfy. In this case, a line something like:
  Smalltalk keys collect: [:i | i class].
would return a set with just one element (Symbol). This means that the keys of Smalltalk are all Symbols.
...this is one of the downside of a highly dynamic language. The "type" info helps to understand code. Of course, the info can be supplied in other forms like comments or unit tests so doesn't necessarily have to be part of the code...

Richard A. O'Keefe Concerning this code:
	| globalObjects keyPrintString |
	globalObjects := Smalltalk reject: [:item | item class isMeta ].
	globalObjects  associationsDo: 
		[:assoc  | 
		 assoc halt.
		 keyPrintString := assoc key printString.
		 Transcript show: keyPrintString.
		 Transcript cr]
If we want to explain this to a beginner, we should start with something rather simpler. My advice would be that #associationsDo: is almost _always_ a bad thing to use. Why go out of your way to ask for associations when you don't actually _want_ associations?

A dictionary is a mapping from "keys" to "values". Iteration over a dictionary using #do: gives you the values one at a time. Iteration over a dictionary using #keysDo: gives you the keys one at a time. Iteration over a dictionary using #keysAndValuesDo: gives you corresponding keys and values, a matching pair at a time. All we want in this case is the keys. So
    globalVariables := Smalltalk reject: [:each | each class isMeta].
    globalVariables keysDo: [:key |
	"We want to print a key"
    ]
But what are these keys? Well, since Smalltalk is a mapping from global variable names to their values, the keys must be variable names. What kind of object is a variable name? Well, globalVariables keys "set of keys" anyOne "any member" class "what is it" gives the answer Symbol. What's a Symbol? It's a unique read only string. The ANSI Smalltalk Standard allows selectors like #foo #+ #at:put: and symbols like #'Happy Birthday' to be different, but historic Smalltalks made them the same, and so does Squeak. In any case, you don't need to convert a Symbol to a String because it already _is_ a kind of string.

So we can do
    globalVariables keysDo: [:key | Transcript show: key; cr].
But there's an even easier thing to do. Writing things to a Transcript isn't a very object-oriented thing to do, because all you get is a bunch of text you can look at. There isn't much else you can do with it. Nope, the best thing to do is
    globalVariables keys asSortedArray
or
    globalVariables keys asSortedArray
To , the simplest thing is to type cmd-i, or you can use the menu.To , the simplest thing is to type cmd-I (capital I), or you can use the menu.In fact, the _best_ thing to do is probably just
    globalVariables
which will show you the variable names _and_ their values.
and the whole thing then simplifies to
    Smalltalk reject: [:each | each class isMeta]
is an extremely useful tool, and the sooner a beginner learns to use it the better. When you select something in the explorer, you can type expressions in the bottom pane, and in those expressions, 'self' refers to the thing you selected in the upper pane. So you can not only _see_ things (as you could if you printed them in a Transcript), you can send them messages.