プログラミングのプログラミング
for VisualWorks 7.8 / 7.7 / 7.6
Smalltalkのプログラムをシステムブラウザを用いて作成してゆくことが多いと思います。そのプログラミング行為そのものをプログラムにしてみましょう。名付けて「プログラミングのプログラミング」です。パッケージを作るところから、名前空間を定義し、クラス群を生成し、メソッド群を作成し、例題プログラムをこしらえてテストを行い、ソースコードとしてセーブし、バイナリとしてセーブ（パーセル化）するところまで、これら一連のプログラムを紹介します。
Workbook.zipをダウンロードし、適当な場所に展開してください。Workbookというディレクトリができあがります。
$ curl -O http://www.cc.kyoto-su.ac.jp/~atsushi/Programs/VisualWorks/ProgrammingOfProgramming/Workbook.zip
% Total % Received % Xferd Average Speed Time Time Time Current
Dload Upload Total Spent Left Speed
100 6361 100 6361 0 0 58194 0 --:--:-- --:--:-- --:--:-- 94940
$ unzip Workbook.zip
Archive: Workbook.zip
creating: Workbook/
inflating: Workbook/Workbook.st
creating: Workbook/Workspaces/
inflating: Workbook/Workspaces/1_Package.st
inflating: Workbook/Workspaces/2_NameSpace.st
inflating: Workbook/Workspaces/3_Classes.st
inflating: Workbook/Workspaces/4_Methods.st
inflating: Workbook/Workspaces/5_Methods.st
inflating: Workbook/Workspaces/6_Methods.st
inflating: Workbook/Workspaces/7_Testing.st
inflating: Workbook/Workspaces/8_Saving.st
inflating: Workbook/Workspaces/9_Parcel.st
そうしたら、VisualWorksを立ち上げ、ファイルブラウザを開き、Workbookのディレクトリの中を見てください。その中にWorkbook.stというファイルがありますので、それを選択してファイルイン（File In）します。
1_Packageから9_Parcelまでのタブを持つワークブックが現れます。パッケージを作るところから、名前空間を定義し、クラス群を生成し、メソッド群を作成し、テストを行い、ソースコードとしてセーブし、バイナリとしてセーブ（パーセル化）するところまで、スモールトーカー（Smalltalker）が暗記している（そらんじている）典型的なイディオム（慣用句としてのプログラム断片）を収録しています。
参考のため、上記のワークブックを出現させるプログラムを以下に紹介しておきます。（実のところ、下記のプログラムにもメタプログラミングが施されており、プログラミングのプログラミングになっています。ちょっと難しいので、どうぞ飛び越して、次へと歩を進めてくださいませ。）
| aDirectory aContext aBoolean aBlock aDialog aCollection aWorkbook aBuilder aRectangle |
aDirectory := nil.
aContext := thisContext.
aBoolean := true.
aBlock :=
[[aContext notNil and: [aBoolean yourself]] whileTrue:
[(aContext selector == #fileIn and: [aContext receiver isKindOf: Stream])
ifTrue:
[| aFilename |
aFilename := aContext receiver stream fileName.
aDirectory := aFilename head asFilename.
aBoolean := false].
aContext := aContext sender]].
[aBlock value]
on: aBlock messageNotUnderstoodSignal
do:
[:exception |
aDirectory := nil.
exception return].
aDirectory
ifNil:
[aDirectory := Filename defaultDirectory construct: 'Workbook'.
aDirectory exists
ifFalse:
[aDialog := ChooseDirectoryDialog new.
aDialog windowTitle: 'Choose the direcotry ' , aDirectory tail printString.
aDialog open ifFalse: [^nil].
aDirectory := aDialog selection]].
aDirectory := aDirectory construct: 'Workspaces'.
aDirectory exists ifFalse: [^nil].
aCollection := OrderedCollection new.
aDirectory directoryContents asSortedCollection
do:
[:each |
('*.st' match: each)
ifTrue: [aCollection add: (aDirectory construct: each)]].
aWorkbook := Workbook new.
aCollection with: (1 to: aCollection size)
do:
[:each :index |
| aStream pageContents labelString aPage |
aStream := each readStream.
[pageContents := aStream contents] ensure: [aStream close].
labelString := each tail asString.
labelString := (Filename splitExtension: labelString) first.
aPage := WorkspacePage labeled: labelString with: pageContents.
index = 1
ifTrue: [aWorkbook replaceAllTextPagesWith: aPage]
ifFalse: [aWorkbook addPage: aPage]].
aBuilder := aWorkbook allButOpenInterface: #windowSpec.
aRectangle := (Screen default bounds center extent: 0 @ 0)
expandedBy: 400 @ 250.
aBuilder window openIn: aRectangle.
aBuilder window displayPendingInvalidation.
aWorkbook postOpenWith: aBuilder.
^aWorkbook
まず、システムブラウザにたよらずに、プログラムでパッケージを作るところから始めましょう。1_Packageのタブをひいて得られるプログラムを全選択して実行（Do it）してください。
実行したプログラムを示しておきます。Store.RegistryをレシーバにしてpackageNamedOrCreate: packageNameStringというメッセージを送っているところがミソです。
| packageNameString commentString aPackage |
packageNameString := 'Forest-ProjectM'.
commentString := 'Smalltalk Studies in Kyoto'.
aPackage := Store.Registry packageNamedOrCreate: packageNameString.
aPackage comment: commentString.
^aPackage
本当にパッケージができているのかを確かめましょう。システムブラウザを開けて調べればいいのですが、そこはプログラミングのプログラミング、プログラムでシステムブラウザを開け、当該のパッケージを選択してみます。以下のようなプログラムになります。
| packageNameString aPackage aBrowser aNavigator |
packageNameString := 'Forest-ProjectM'.
aPackage := Store.Registry packageNamed: packageNameString.
aPackage ifNil: [^nil].
aBrowser := Refactory.Browser.RefactoringBrowser open.
aNavigator := aBrowser navigator.
aNavigator selectPundle: aPackage.
^aBrowser
実行しましょう。ただし、上記のプログラムを音読して（声に出して読んで）からにしてください。（なぜ、OrCreateのキャメルがないのか、おわかりいただけますよね。リファクタリングブラウザの開き方とパッケージの選択の仕方など、後ほど時間があるときにでも、RefactoringBrowserとBrowserNavigatorの2つのクラスを調査していただけると助かります。）
以下ではプログラム群と画像群に物を言わせて多くを語りませんが、どのメッセージ式がミソであるのか等々、メタプログラミングの高みをめざして、私たちのプログラミング行為の背後で動いているプログラムの外在化（externalization）に心を砕いていただければ幸いです。
次は名前空間です。2_NameSpaceのタブをひいて得られるプログラムを全選択して実行してください。
| nameSpaceSymbol packageNameString commentString aNameSpace aPackage |
nameSpaceSymbol := #ProjectM.
packageNameString := 'Forest-ProjectM'.
commentString := 'Smalltalk Studies in Kyoto'.
aPackage := Store.Registry packageNamed: packageNameString.
aPackage ifNil: [^nil].
aNameSpace := Smalltalk at: nameSpaceSymbol ifAbsent: [nil].
aNameSpace
ifNil:
[aNameSpace := Smalltalk
defineNameSpace: nameSpaceSymbol
private: false
imports: 'private Smalltalk.*'
category: packageNameString.
aNameSpace comment: commentString.
aNameSpace yourself].
([aNameSpace package]
on: aNameSpace messageNotUnderstoodSignal
do: [:exception | Store.Registry containingPackageForNameSpace: aNameSpace])
= aPackage
ifFalse:
[Store.XChangeSet current moveWholeObject: aNameSpace toPackage: aPackage].
^aNameSpace
名前空間ができているのかを確かめます。
| nameSpaceSymbol aNameSpace aBrowser aNavigator aBinding |
nameSpaceSymbol := #ProjectM.
aNameSpace := Smalltalk at: nameSpaceSymbol ifAbsent: [^nil].
aBrowser := Refactory.Browser.RefactoringBrowser open.
aNavigator := aBrowser navigator.
aBinding := aNameSpace fullyQualifiedReference binding.
aNavigator setBinding: aBinding.
^aBrowser
さぁ、簡単なMVC（モデル・ビュー・コントローラ）のためのクラス群（Model・View・Controller）を作成します。3_Classesのタブをひいて得られるプログラムを全選択して実行してください。
| nameSpaceSymbol packageNameString commentString aPackage aNameSpace aCollection |
nameSpaceSymbol := #ProjectM.
packageNameString := 'Forest-ProjectM'.
commentString := 'Smalltalk Studies in Kyoto'.
aPackage := Store.Registry packageNamed: packageNameString.
aPackage ifNil: [^nil].
aNameSpace := Smalltalk at: nameSpaceSymbol ifAbsent: [^nil].
aCollection := (OrderedCollection new)
add: (Array with: #Model with: #{UI.Model} with: 'forest picture');
add: (Array with: #View with: #{UI.View} with: 'offset');
add: (Array with: #Controller with: #{UI.Controller} with: '');
yourself.
^aCollection collect:
[:anArray |
| aClass |
aClass := aNameSpace
defineClass: (anArray at: 1)
superclass: (anArray at: 2)
indexedType: #none
private: false
instanceVariableNames: (anArray at: 3)
classInstanceVariableNames: ''
imports: ''
category: packageNameString.
aPackage addClass: aClass.
aClass comment: commentString.
aClass yourself]
ちゃんとクラス群が定義できたのかを確かめます。
| aCollection aBrowser aNavigator |
aCollection := Array
with: ProjectM.Model
with: ProjectM.View
with: ProjectM.Controller.
aBrowser := Refactory.Browser.RefactoringBrowser open.
aNavigator := aBrowser navigator.
aNavigator state classesAndNameSpaces: aCollection.
aNavigator
setState: aNavigator state;
changed.
^aBrowser
モデルのメソッド群を作ります。4_Methodsのタブをひいて得られるプログラムを全選択して実行してください。
| aClass aCollection |
aClass := ProjectM.Model.
aCollection := (OrderedCollection new)
add: (Array with: 'accessing' with: '
picture
^picture
');
add: (Array with: 'accessing'
with: '
picture: anImage
picture := anImage
');
yourself.
^aCollection collect:
[:anArray |
| aProtocol aCode aTree aSelector aMethod |
aProtocol := (anArray at: 1) asSymbol.
aCode := (anArray at: 2) yourself.
aTree := Refactory.Browser.RBParser parseMethod: aCode.
aSelector := aClass compile: aTree formattedCode classified: aProtocol.
aMethod := aClass compiledMethodAt: aSelector.
aMethod yourself]
モデルのインスタンスメソッド群が作られているのかを確かめます。
| aClass aBrowser aNavigator |
aClass := ProjectM.Model.
aBrowser := Refactory.Browser.RefactoringBrowser open.
aNavigator := aBrowser navigator.
aNavigator selectClass: aClass.
(aNavigator state)
protocols: aClass organization categories;
selectors: aClass selectors.
aNavigator
setState: aNavigator state;
changed.
^aBrowser
ビューのメソッド群を作ります。5_Methodsのタブをひいて得られるプログラムを全選択して実行してください。
| aClass aCollection |
aClass := ProjectM.View.
aCollection := (OrderedCollection new)
add: (Array with: 'controller accessing'
with: '
defaultControllerClass
^Controller
');
add: (Array with: 'displaying'
with: '
displayOn: aGraphicsContext
aGraphicsContext
paint: ColorValue white;
displayRectangle: self bounds.
model
ifNotNil:
[model picture ifNotNil: [:it | it displayOn: aGraphicsContext at: offset]]
');
add: (Array with: 'initialize-release'
with: '
initialize
super initialize.
offset := 0 @ 0
');
add: (Array with: 'scrolling'
with: '
scrollBy: aPoint
self scrollTo: offset + aPoint
');
add: (Array with: 'scrolling'
with: '
scrollTo: aPoint
offset := aPoint
');
add: (Array with: 'updating'
with: '
update: aNode
self invalidateNow
');
yourself.
^aCollection collect:
[:anArray |
| aProtocol aCode aTree aSelector aMethod |
aProtocol := (anArray at: 1) asSymbol.
aCode := (anArray at: 2) yourself.
aTree := Refactory.Browser.RBParser parseMethod: aCode.
aSelector := aClass compile: aTree formattedCode classified: aProtocol.
aMethod := aClass compiledMethodAt: aSelector.
aMethod yourself]
ビューのインスタンスメソッド群が作られているのかを確かめます。
| aClass aBrowser aNavigator |
aClass := ProjectM.View.
aBrowser := Refactory.Browser.RefactoringBrowser open.
aNavigator := aBrowser navigator.
aNavigator selectClass: aClass.
(aNavigator state)
protocols: aClass organization categories;
selectors: aClass selectors.
aNavigator
setState: aNavigator state;
changed.
^aBrowser
コントローラのメソッド群を作ります。6_Methodsのタブをひいて得られるプログラムを全選択して実行してください。
| aClass aCollection |
aClass := ProjectM.Controller.
aCollection := (OrderedCollection new)
add: (Array with: 'events'
with: '
blueButtonPressedEvent: event
self mouseButtonActivity.
^nil
');
add: (Array with: 'activities'
with: '
clickActivity
Transcript
cr;
show: thisContext printString
');
add: (Array with: 'activities'
with: '
grabActivity
| mouse previous current |
mouse := self sensor.
previous := current := mouse cursorPoint.
[mouse anyButtonPressed] whileTrue:
[current := mouse cursorPoint.
previous = current
ifFalse:
[(self view)
scrollBy: current - previous;
invalidateNow.
previous := current].
Processor yield]
');
add: (Array with: 'activities'
with: '
mouseButtonActivity
Cursor crossHair showWhile:
[| symbol |
symbol := self mouseButtonChecking.
symbol = #click ifTrue: [self clickActivity].
symbol = #grab ifTrue: [self grabActivity]].
self sensor waitNoButton
');
add: (Array with: 'activities'
with: '
mouseButtonChecking
| mouse limit |
mouse := self sensor.
limit := Time millisecondClockValue + 333.
[Time millisecondClockValue < limit] whileTrue:
[mouse anyButtonPressed ifFalse: [^#click].
Processor yield].
^#grab
');
add: (Array with: 'events'
with: '
redButtonPressedEvent: event
self mouseButtonActivity.
^nil
');
add: (Array with: 'events'
with: '
yellowButtonPressedEvent: event
self mouseButtonActivity.
^nil
');
yourself.
^aCollection collect:
[:anArray |
| aProtocol aCode aTree aSelector aMethod |
aProtocol := (anArray at: 1) asSymbol.
aCode := (anArray at: 2) yourself.
aTree := Refactory.Browser.RBParser parseMethod: aCode.
aSelector := aClass compile: aTree formattedCode classified: aProtocol.
aMethod := aClass compiledMethodAt: aSelector.
aMethod yourself]
コントローラのインスタンスメソッド群が作られているのかを確かめます。
| aClass aBrowser aNavigator |
aClass := ProjectM.Controller.
aBrowser := Refactory.Browser.RefactoringBrowser open.
aNavigator := aBrowser navigator.
aNavigator selectClass: aClass.
(aNavigator state)
protocols: aClass organization categories;
selectors: aClass selectors.
aNavigator
setState: aNavigator state;
changed.
^aBrowser
例題プログラムをモデルのクラスメソッドとして作成し、それを走らせて、テストします。7_Testingのタブをひいて得られるプログラムを全選択して実行してください。
| aClass aProtocol aCode |
aClass := ProjectM.Model class.
aProtocol := 'examples' asSymbol.
aCode := '
example
"ProjectM.Model example."
| aModel aView aWindow aRectangle |
aModel := Model new.
aModel picture: (CachedImage
on: (Screen default completeContentsOfArea: (Point zero
extent: (Screen default bounds extent min: 1024 @ 768)))).
aView := View model: aModel.
aWindow := ApplicationWindow
model: aModel
label: nil
minimumSize: 400 @ 300.
aWindow component: aView.
aRectangle := Point zero extent: 800 @ 600.
aRectangle := aRectangle align: aRectangle center
with: Screen default bounds center.
aWindow openIn: aRectangle.
^aModel
'.
aTree := Refactory.Browser.RBParser parseMethod: aCode.
aClass compile: aTree formattedCode classified: aProtocol.
^aClass soleInstance example
次のようなウィンドウが開いてきます。
システムブラウザで例題プログラムを見てみましょう。
| aClass aProtocol aSelector aBrowser aNavigator |
aClass := ProjectM.Model class.
aProtocol := #examples.
aSelector := #example.
aBrowser := Refactory.Browser.RefactoringBrowser open.
aNavigator := aBrowser navigator.
aNavigator selectClass: aClass.
(aNavigator state)
protocol: aProtocol;
selector: aSelector.
aNavigator
setState: aNavigator state;
changed.
^aBrowser
作ってきたものをソースコードとして（XML形式で）ファイルにセーブにします。8_Savingのタブをひいて得られるプログラムを全選択して実行してください。
| packageNameString aPackage aFilename |
packageNameString := 'Forest-ProjectM'.
aPackage := Store.Registry packageNamed: packageNameString.
aPackage ifNil: [^nil].
aFilename := Filename defaultDirectory construct: packageNameString , '.st'.
aPackage fileOutOnFileNamed: aFilename.
^aPackage
ソースコードがセーブされているのかを確かめます。ファイルブラウザを開き、当該ファイルを選択するプログラムになります。
| packageNameString aPackage aFilename aFileBrowser |
packageNameString := 'Forest-ProjectM'.
aPackage := Store.Registry packageNamed: packageNameString.
aPackage ifNil: [^nil].
aFilename := Filename defaultDirectory construct: packageNameString , '.st'.
aFilename exists ifFalse: [^nil].
aFileBrowser := Tools.FileTools.FileBrowser new.
aFileBrowser open.
aFileBrowser selectFileNamed: aFilename.
^aFileBrowser
作ってきたものを小包（パーセル）にします。9_Parcelのタブをひいて得られるプログラムを全選択して実行してください。
| packageNameString nameSpaceSymbol commentString aPackage aNameSpace aParcel |
packageNameString := 'Forest-ProjectM'.
nameSpaceSymbol := #ProjectM.
commentString := 'Smalltalk Studies in Kyoto'.
aPackage := Store.Registry packageNamed: packageNameString.
aPackage ifNil: [^nil].
aNameSpace := Smalltalk at: nameSpaceSymbol ifAbsent: [^nil].
aParcel := Parcel parcelNamed: packageNameString.
aParcel isNil
ifTrue:
[aParcel := Parcel createParcelNamed: packageNameString.
aParcel comment: commentString].
aParcel addNameSpace: aNameSpace.
aPackage allClasses do: [:aClass | aParcel addEntiretyOfClass: aClass].
aParcel
parcelOutOn: packageNameString , '.pcl'
withSource: packageNameString , '.pst'
hideOnLoad: false
republish: false
backup: false.
^aParcel
ちゃんとパーセルとしてセーブされて（.pclと.pstの2つのファイルができあがって）いるのかを確かめます。
| packageNameString aPackage aFilename aFileBrowser |
packageNameString := 'Forest-ProjectM'.
aPackage := Store.Registry packageNamed: packageNameString.
aPackage ifNil: [^nil].
aFilename := Filename defaultDirectory construct: packageNameString , '.pcl'.
aFilename exists ifFalse: [^nil].
aFileBrowser := Tools.FileTools.FileBrowser new.
aFileBrowser open.
aFileBrowser selectFileNamed: aFilename.
^aFileBrowser
for VisualWorks 7.8 / 7.7 / 7.6
Updated: 2015/11/08 (Created: 2010/01/01)
