The Common Lisp Cookbook – Win32 API の使い方

Table of Contents

The Common Lisp Cookbook – Win32 API の使い方

📢 🎓 ⭐ Learn Common Lisp efficiently in videos, by the Cookbook's main contributor. Learn more.

🖊️ Discover a new Common Lisp and Coalton editor for beginners: mine and a new VSCode extension for Common Lisp: OLIVE.

導入と範囲

この章では Win32 API の基本を紹介し、Lisp からどう呼び出すかを示し、さらに Lisp を使って特定のアプリケーション領域に最適化した強力な Win32 プログラミング環境を作る方法を示します。Win32 API の全オプションを露出する Lisp 環境は、Win32 API と同じくらい複雑にならざるを得ません。しかし、あるアプリケーション領域が Win32 API のすべての関数のすべてのオプションを必要とするとは考えにくいものです。Lisp の構文を領域固有に拡張すると、その領域には不要な Win32 API の部分を隠せます。たぶん Win32 API の大部分は隠れるでしょう。プログラマは、その時点で必要な API の部分だけを扱い、考えればよくなります。後で必要になった部分は、いつでも簡単に露出できます。

単一の環境を、単純なアプリケーションと複雑なアプリケーションの両方に最適化するのは容易ではありません。この章で示す方法を使えば、単純なものから複雑なものまで、さまざまなアプリケーション領域に適した環境を構築できます。

章の前半では、後半の節へつながる概念や考え方を紹介し、最後から 2 番目の節で “Hello” プログラムにたどり着きます。

(require "win-header")
(in-package :wh)
(export '(initialize-appendix-b))

(DefMsgHandler appendix-b-proc MsgMap ()
               (WM_PAINT
                (text-out "Hello from Lisp!" 0 0 :color (RGB 0 0 255))
                0))

(defun initialize-appendix-b ()
  (DefActiveTopWindow "Hello" 'appendix-b-proc
    :style ws_overlappedwindow :width 150 :height 200 :title "Hello Program"))

使用しているのは Lispworks for Windows 4.2.7 です（Personal Edition は無料でダウンロードできます）。他の Lisp に合わせる試みはしておらず、クロスプラットフォーム互換性も考慮していません。これらの点は文書の構成を考える段階で議論し、現在の方針を次の理由で選びました。

Cookbook では、これらの分野や他の分野のカバー範囲を広げる貢献を歓迎します。

Win32 API を使ってプログラミングする人は、Charles Petzold の Programming Windows, The Definitive Guide to the Win32 API や同等の本に目を通しておくべきです。

ここで示すコードは、Windows XP 上の Lispworks for Windows 4.2.7 Professional Edition でのみテストしています。

なぜ Lisp を Win32 と組み合わせるのか

プログラムがクロスプラットフォームにできるなら、そうすべきです。Common Lisp の “Common” は、クロスプラットフォームかつクロスベンダーである性質への敬意でもあります。この移植性の利点は軽視すべきではありません。ただし、Win32 API を活用するプログラムを非移植的に書くからといって、Lisp の力を手放す必要はありません。

気になる点の 1 つは、Lisp の実行ファイルは大きいという印象かもしれません。Microsoft の OS は C と C++ で書かれており、C/C++ プログラム向けのサポートライブラリは OS に同梱されています。Lisp の実行時サポートが大きく見えるのは、それが OS に含まれていないからに過ぎません。Lispworks for Windows を使えば、ロイヤリティなしでデリバリモードの Lisp プログラムを配布できますし、実行時ライブラリを一度配布してから、小さなコンパイル済みプログラムだけを順次配布することもできます。

大量配布向けの小さなプログラムを作る必要があるなら、Lisp の実行時サポートが大半のコンピュータに入っていないことは制約になります。ただし、Lispworks for Windows ではデリバリ段階でかなり強い刈り込み（pruning）ができ、プログラムを 2MB 未満まで縮められることもあります。多くの配布ケースには十分です。完全な Lisp 実行時環境が必要なケースは、たいてい大規模アプリケーションで、実行時環境を CD や大きな一括ダウンロードで配布し、その後は個別にコンパイルしたコンポーネントをプログラムやコンポーネントの初期化時に読み込むのが理にかなっています。

配布可能なプログラムサイズの下限は、Lisp という言語に本質的なものではなく、現在の市場需要の結果に過ぎないと私は考えています。Lisp で書かれた本当に小さなスタンドアロン実行ファイルへの需要が高まれば、ベンダーにはよりよい pruner や shaker を開発する動機が生まれるはずです。（Lisp は最初にたくさん持っていて、配布物に不要なものを取り除きます。一方 C/C++ は最初に少ししか持っておらず、リンク時に必要なものを足していきます。起動直後の Lisp は REPL、つまり read-eval-print loop から始まり、Lisp の完全な力が対話的に使える状態になっています。）

Lispworks の Foreign Language Interface、つまり FLI の生々しい詳細を見ると、最初は奇妙に思えるかもしれません。OS は C/C++ で書かれているので、C/C++ からの OS 呼び出しは外部呼び出しではありません。Lisp 関数が Lisp 関数から呼ばれるのと同じです。

Win32 プログラムの一生をざっと見る

OS は Win32 の GUI プログラムを、サブルーチン、つまり関数の集合として扱います。

Windows の文字システムと Lisp

Microsoft の OS には、単一バイトの ASCII 文字集合を使うものと、2 バイトの Unicode 文字集合を使うものがあります。次を使います。

(defun external-format ()
  (if (string= (software-type) "Windows NT")
      :unicode
    :ascii)

どちらの形式を使っているかを判定します。文字や文字列を受け取る、または返す Win32 関数には 2 種類あります。1) ASCII 文字用で末尾が A のもの、2) 幅広 Unicode 文字用で末尾が W のものです。この external-format 関数は、主に Lispworks の外部関数インターフェイスの一部である fli:with-foreign-string を呼ぶときに役立ちます。Win32 関数を外部関数インターフェイス、つまり FLI で定義するとき、:dbcs キーワードがあると、その関数に単一バイト版と二重バイト版の両方があることを示します。:dbcs があると、Lispworks は単一バイトの Windows 95 では関数名に “A” を、二重バイトの Windows NT/2000/XP では “W” を付けます（サンプルプログラムは Windows XP で作成・テストしました）。:dbcs がなければ、Lispworks は外部関数名をそのまま使います。

Win32 の TextOut 関数に対する FLI 定義の一例は次のとおりです。

(fli:define-foreign-function
    (TextOut "TextOut" :dbcs :calling-convention :stdcall)
    ((HDC (:unsigned :long)) (nXStart (:unsigned :int)) (nYStart (:unsigned :int))
     (lpString :pointer) (cbString (:unsigned :int)))
  :result-type (:unsigned :long))

これは次の定義と等価です。

(fli:define-foreign-function
    (TextOut "TextOutW" :calling-convention :stdcall)
    ((HDC (:unsigned :long)) (nXStart (:unsigned :int)) (nYStart (:unsigned :int))
     (lpString :pointer) (cbString (:unsigned :int)))
  :result-type (:unsigned :long))

これは NT/2000/XP での話です（2 番目の例は 95 では “TextOutA” を使います）。

これを確かめるために、テスト目的で対話的に呼び出しやすい単純な FLI 定義を使ってみましょう。ここでは、ある Win32 関数を OS が認識しているかどうかだけを調べます。次の REPL での操作では、戻り値が意味を持つのは Lisp のリスタートハンドラが呼ばれたときだけです。リスタートハンドラが呼ばれなければ、その Win32 関数は見つかり、ロードされ、呼び出されたということです。FLI が見つけられない Win32 関数を呼び出そうとすると、リスタートハンドラが呼ばれます。（textout の正しい define-foreign-function 定義は 付録 A にあります。）

CL-USER 9 > (fli:define-foreign-function
                (TextOut-1 "TextOut" :dbcs :calling-convention :stdcall)
                () :result-type :int)
TEXTOUT-1

CL-USER 10 > (textout-1)
1

CL-USER 11 > (fli:define-foreign-function
                 (TextOut-2 "TextOut" :dbcs :calling-convention :stdcall)
                 () :result-type :int)
TEXTOUT-2

CL-USER 12 > (textout-2)
0

TextOut 関数はどちらの場合も見つかりました。これは、ある Win32 関数を複数の FLI 定義で名付けられることを示しています。この手法は、Win32 関数のあるパラメータに対して複数の Lisp データ型が要件を満たせる場合に役立つことがあります。

CL-USER 13 > (fli:define-foreign-function
                 (TextOut-3 "TextOutW" :dbcs :calling-convention :stdcall)
                 () :result-type :int)

TEXTOUT-3

CL-USER 14 > (textout-3)

Error: Foreign function TEXTOUT-3 trying to call to unresolved
external function "TextOutWW".

1 (abort) Return to level 0.
2 Return to top-level loop.
3 Return from multiprocessing.

Type :b for backtrace, :c  to proceed,  or :? for other
options

CL-USER 15 : 1 > :top

CL-USER 16 > (fli:define-foreign-function
                 (TextOut-4 "TextOutW" :calling-convention :stdcall)
                 () :result-type :int)

TEXTOUT-4

CL-USER 17 > (textout-4)
1

CL-USER 18 > (fli:define-foreign-function
                 (TextOut-5 "TextOutA" :calling-convention :stdcall)
                 () :result-type :int)
TEXTOUT-5

CL-USER 19 > (textout-5)
0

CL-USER 20 >

外部関数を複数回定義したとき、直前の定義と現在の定義とで :dbcs キーワードの使い方が異なると、Lispworks は警告を出します。ここではその警告を省略しました。CL-USER 14 のあと、Lispworks は “TextOutWW” について不平を述べています。これは :dbcs キーワードを使うと Lispworks が外部関数名に ‘W’ を付け足すことを示しています。ただし外部関数自体の存在は、実際に呼び出すまで検証されません。TextOut-5 は、TextOut の ASCII 版である Win32 関数 TextOutA の存在を検証しています。

タイトルなどに奇妙な文字集合が現れるのを見たことがありますが、:dbcs や W/A 宣言を一貫して使うようにすることで、そうした問題を解決できました。

Edi Weitz から、:dbcs キーワードが …A と …W のどちらを呼ぶかを決めるのはコンパイル時か実行時か、という質問がありました。そこで次のプログラムを書きました。

(in-package :cl-user)

(fli:define-foreign-function
    (MessageBox "MessageBox" :dbcs :calling-convention :stdcall)
    ((hwnd (:unsigned :long)) (text (:unsigned :long)) (title (:unsigned :long)) (flags (:unsigned :long)))
  :result-type (:unsigned :long))

(defun external-format ()
  (if (string= (software-type) "Windows NT")
      :unicode
      :ascii))

(defun display-format-used ()
  (fli:with-foreign-string
      (unicode-p u-ec u-bc :external-format (external-format)) "Unicode"
      (fli:with-foreign-string
	  (ascii-p a-ec a-bc :external-format (external-format)) "Ascii"
	  (fli:with-foreign-string
              (title-p t-ec t-bc :external-format (external-format)) "External Format"
              (if (eq (external-format) :unicode)
                  (messagebox 0 (fli:pointer-address unicode-p)
                              (fli:pointer-address title-p) 0)
                  (messagebox 0 (fli:pointer-address ascii-p)
                              (fli:pointer-address title-p) 0))))))

(compile 'external-format)
(compile 'display-format-used)

(deliver 'display-format-used "dbcs-run" 5)
(quit)

; We then have dbcs-run.exe. When run on Windows XP, dbcs-run pops up a messagebox
; displaying "Unicode". The same dbcs-run.exe file, ftp'd to a Macintosh running OS 9 with
; Virtual PC running Windows 98, pops up a message box displaying "Ascii".

FLI — Foreign Language Interface — C ヘッダファイルを Lisp へ翻訳する

C/C++ から Win32 API を呼ぶときは、コンパイラに付属するヘッダファイルをプログラムに #include します。ヘッダファイルには、API を構成する定数・構造体・関数の定義が含まれています。これらの定義は Lisp プログラムからも利用できる必要があります。私はこの変換を手作業で行うのがいちばんわかりやすいと考えています。自動化する方法もありますが、関数単位で手作業で行ってもさほど時間はかかりません。

C/C++ では、#define はプリプロセッサに存在します。プログラムが使う define だけがオブジェクトコードに含まれます。一方 Lisp では、defconstant はその後使われるかどうかに関わらず、すべて Lisp イメージにロードされます。この問題のきれいな解決策は私にはわかりません。

当面は、基礎となる中核の win-header.lisp を用意し、あまり使わない定義は機能ごとにまとめた別の .lisp ファイルに置いて、必要になったときにロードするようにしています。

FLI のデータ型

Win32 の C/C++ ヘッダファイルには、HINSTANCE、ハンドル、HMENU、LPCTSTR など、OS 固有のデータ型に対する typedef が数多く含まれています。Lisp の側から見ると、これらは結局のところ、符号付きか符号なしか、long か char か、単一か配列か、あるいはそれらの型からなる C 構造体か、に行き着きます。（Int は long と同じもののようです。）

Lisp は HINSTANCE と HMENU の違いを知りませんし、気にもしません。どちらも単なる 32 ビット値です。Lisp がこれらの値に注意を払うのは 2 つの場面です。1) Lisp のデータを外部のフィールドへ移すとき、2) 外部のデータを Lisp へ移すときです。Lispworks はその時点で型強制を試み、符号なしフィールドに負の値を詰め込むような誤った変換をしようとするとコンディションが発生します。外部フィールドを :pointer 型と宣言するなど、型についてのヒントをさらに与えると、ポインタにゼロを詰め込もうとしたときに Lisp が不平を述べます。OS にヌルポインタを渡したい場合には、これは不便です。そのため私は、たいていのパラメータを long として扱う方が楽だと感じています。とはいえ、ときどきこの方針は曲げます。

Lispworks の FLI ポインタは、実際には fli:pointer-address で取り出した（アンボックスした）アドレスを含む Lisp の構造体です。ポインタ値を OS に渡すとき、たとえば RECT のアドレスを GetClientRect に渡すときには、2 つのステップが必要です。1) 外部構造体を確保する、2) 確保した構造体のアドレスを OS に渡す、です。たいていの場合、こうした確保は fli:allocate-dynamic-foreign-object の呼び出しを fli:with-dynamic-foreign-objects で囲んで扱うのが最善です。解放を気にしなくて済むからです。確保した構造体のアドレスは fli:pointer-address で（ポインタ値をアンボックスして）渡し、外部関数のパラメータリストではそのフィールドを unsigned long と定義します。

FLI では、Lispworks が自動的な型強制（アンボックス）を試みるように定義することもできます。パラメータの型を :pointer と定義してみてください。ただし Lispworks は NULL ポインタを渡そうとすると不平を述べます。もっとも、アドレスがゼロの FLI ポインタを作ってみたわけではありません。私が選んだ、ポインタを unsigned long として扱う方法は、私にとって明快で、双方向（OS→Lisp、Lisp→OS）でうまく動きます。これは単に私の理解がまだ完全でないからかもしれず、もっとよい方法があるのかもしれません。

ときには C 構造体の中に C の配列を定義すると便利なことがあります。特に sPAINTSTRUCT でそうです。これは動きますが、構造体メンバや配列要素のアドレスを得る現在の方法は気に入っていません。気づけばバイトオフセットを手で数え、次のようなコードを使っています。

(defun interior-copy (to-struct-ptr byte-offset src-ptr)
  (let ((ptr (fli:make-pointer
              :address (fli:pointer-address to-struct-ptr :type :char))))
    (fli:incf-pointer ptr byte-offset)
    (wcscpy (fli:pointer-address ptr) (fli:pointer-address src-ptr))))

ここで wcscpy は strcpy のワイド文字版で、FLI を通して定義しています。もっとよい方法があって、誰かがすぐに教えてくれることを願っています。strcpy と wcscpy のどちらを選ぶかについては、(software-type) で呼び分けを決める以外のベストな方法を知るほど、さまざまな OS と Lispworks を使い込んでいません。（あるいは付録 A で定義した (external-format) を使います。）

Lisp 側に定義するデータ型は最小限に抑えていますが、ドキュメントの観点では、C/C++ ヘッダファイルで使われている typedef 名をまねるのがとても役立ちます。そこで fli:define-c-typedef を使って、BOOL、DWORD、ハンドル、HDC など、同様の Win32 データ型を定義します。

OS 固有の定数の多くは、Lisp プログラムから利用できるようにしておく必要があります。

(defconstant CW_USEDEFAULT       #x80000000)
(defconstant IDC_ARROW                32512)
(defconstant SW_SHOW                      5)
(defconstant WM_CLOSE            #x00000010)
(defconstant WM_DESTROY          #x00000002)

これらの定数は、MSDN のドキュメントでは名前だけが示され、値は載っていません。Lisp プログラムには名前だけでなく値も必要です。必要な値を見つける簡単な方法は、VC98/Include ディレクトリを grep することです。Visual Studio にはツールバーに「ファイルから検索」機能があり、この種の検索ができます。Kenny Tilton はこう述べています。「私がやったのは、ビルドできる VC++ プロジェクトを適当に手に入れることでした（NeHe OpenGL のサイトには VC++ プロジェクトがたくさんあります（ページ左のサイドバーにある OpenGL チュートリアルを参照。http:///nehe.gamedev.net）。私の環境では問題なくビルドできました）。そして気になるシンボルを右クリックします。（もちろん、まずは参照箇所を見つける必要がありますが 。）すると VC++ が 'find definition' を提示し、関数や定数やマクロなどのヘッダエントリへ直接ジャンプしてくれます。」

FLI のデータ構造

私はたいてい、構造体とそれに対する typedef を定義します。

; PAINTSTRUCT
(fli:define-c-struct sPAINTSTRUCT
    (HDC hdc)
  (fErase bool)
  (rcPaint-x uint)
  (rcPaint-y uint)
  (rcPaint-width uint)
  (rcPaint-height uint)
  (fRestore bool)
  (fIncUpdate bool)
  (rgbReserved (:c-array wBYTE 32)))
(fli:define-c-typedef PAINTSTRUCT sPAINTSTRUCT)

そうすると、次のようなことができます。

(fli:with-dynamic-foreign-objects ()
  (let ((ps-ptr (fli:allocate-dynamic-foreign-object :type 'paintstruct)))
    (format t "~&Pointer value: ~a" (fli:pointer-address ps-ptr))))

もっとも、この typedef がなぜ価値があるのかは私にはよくわかりません。Lisp は C ではないので、Lisp では typedef があっても、たとえば struct sPAINTSTRUCT と打たずに済むわけではありません。typedef は余計なものだと思うので、おそらく使うのをやめるでしょう。

FLI の関数

FLI で OS の呼び出しを定義するのはとても簡単です。私は OS のドキュメントにある API 定義から始めます。Visual C++ が使えるなら、MSDN のドキュメントもおそらくマシンにインストールされています。ドキュメントは MSDN のウェブサイト でも参照できます。目的の関数の Win32 ドキュメントページを開き、単純に翻訳します。

; LoadCursor
(fli:define-foreign-function
    (LoadCursor "LoadCursor" :dbcs :calling-convention :stdcall)
    ((hInstance handle) (param ulong))
  :result-type handle)

これまで見てきた Win32 の呼び出しはすべて :calling-convention :stdcall です。関数がテキストのパラメータを含むとわかっている場合は :dbcs キーワードを付けます。わからない場合は :dbcs なしで試します。この例で実際に呼び出される関数は LoadCursorA または LoadCursorW です。

Windows から Lisp へのコールバック

メッセージポンプが立ち上がって動き出すと、OS は Lisp の関数を繰り返し呼び出すことでメッセージを届けます。外部環境から呼び出せる Lisp 関数は、次のように定義できます。

; WndProc -- Window procedure for the window we will create
(fli:define-foreign-callable
    (wndproc :result-type :long :calling-convention :stdcall)
    ((hwnd hwnd) (msg ulong)
     (wparam ulong) (lparam ulong))
  (case msg
    (#.WM_PAINT (wndproc-paint hwnd msg wparam lparam))
    #+console (#.WM_DESTROY (PostQuitMessage 0) 0)
    (t (DefWindowProc hwnd msg wparam lparam))))

この wndproc 関数がメッセージディスパッチャです。OS はプログラムに送られるメッセージごとに wndproc を 1 回呼び出します。wndproc は、メッセージを理解して適切な関数を呼び出す役割を担います。

#. リーダーマクロは WM_PAINT と WM_DESTROY の値をコンパイル時に返すので、case が機能します。#+console は「:console が *features* のメンバである場合にのみ次のフォームを含める」という意味です。

付録 A の Win32 Lisp プログラムの例は、Lispworks IDE からでも、Emacs の ILISP のようなコンソールモードからでも実行できます。PostQuitMessage を IDE から呼ぶと、IDE が終了してしまいます。コンソールモードで PostQuitMessage を呼ばないと、Win32 のウィンドウが閉じません。

プログラムを起動する

マルチプロセッシングは Lispworks IDE では常に動いていますが、Emacs の ILISP では動いていることもあれば動いていないこともあります。マルチプロセッシングが使えると便利です。プログラムが動いていて、ボタンやメニューがすべて有効なウィンドウが表示されたままの状態で、プログラムやその変数を覗いたりいじったり、即座に反映される新しい関数や再定義した関数を与えたり、さらには Win32 API を呼び出したりできるからです。

ただし ILISP の下では、マルチプロセッシングは私にとってそれほど快適ではありませんでした。私は ILISP と Emacs の環境が大好きです。Lispworks IDE もとてもよくできていて、オンラインマニュアルを探したり、インスペクタのようなデバッグツールを使ったりといった用途のために、起動したままにしてあります。とはいえ編集やたいていの実行については、Emacs と ILISP の方が好みです。しかし ILISP では複数のプロセスを見る方法を覚えておらず、プロセス間を切り替える方法も知りません。ILISP でマルチプロセッシングを使うと、コンディションを抱えたスレッドが *standard-output* と *standard-input* を握ってしまうように見えます。もう一方のスレッドへ戻る方法がわかりません。これは十分に厄介なので、ILISP の下ではマルチプロセッシングを使わず、マルチプロセッシングで可能になる対話的なデバッグ機能が必要・欲しいとき、あるいは何らかの形でマルチプロセッシングが必要なときには、Lispworks IDE に切り替えます。

IDE の下で実行する場合、メッセージポンプは Lispworks が提供します。Emacs/ILISP の下（あるいは配布されたアプリケーションでそうなるようなコンソールモード）で実行する場合は、Lisp プログラム自身がメッセージポンプを提供しなければなりません。

そのため付録 A の例のプログラムでは、関数 create-toplevel-window が、コンソールモードのときにマルチプロセッシングが動いていることを保証します。関数 create-toplevel-window-run は、コンソールモードのときだけメッセージポンプの処理を行い、それ以外では行いません。

付録 A のプログラムは、ファイルがロードされたときに register-class を呼び出します。この呼び出しは一度だけ行えばよいので、トップレベルで呼び出しています。

(defvar *reg-class-atom* (register-class))

そうすれば create-toplevel-window-run は、CreateWindowEx を呼び、必要に応じてメッセージポンプを開始するだけで済みます。

Lisp REPL と Win32 開発

Win32 アプリケーションを Lispworks IDE の中で実行しているときは、IDE の REPL プロンプトで Lisp のフォームを入力できます。任意の変数を見たり、任意の関数を再定義したり、SendMessage や、WM_PAINT の中にいることのような OS からのコンテキストを必要としないその他の Win32 関数を呼び出したりできます。ボタンがクリックされたときに呼ばれる関数を再定義すれば、次にそのボタンをクリックしたときには新しい関数が呼ばれます。Lispworks のデバッグツールが使えます。ほかの Lisp プログラムを同時に実行することもできます。実行中の Win32 プログラム内の個々の関数を REPL から呼び出せます。関数をトレースしたり解除したり、アドバイス（advice）を追加・削除したり、CLOS のクラスをその場で再定義したりできます。Lisp は、スロットの追加や削除が実行中のプログラム内で秩序立って行われることを保証します。

Lisp は、慎重に管理すればプログラムを何年も連続して動かせるように設計されており、その間にバグを直し、新しい関数を定義し、CLOS オブジェクトを再定義しながら、プログラムを保守できるようにも設計されています。

CAPI から Win32 を直接呼び出す

Lispworks には、GUI プログラム開発のためのクロスプラットフォーム API である CAPI が含まれています。CAPI は強力で使いやすいものです。真にクロスプラットフォームな能力を得るには、100% 純粋な CAPI にとどめることが重要です。

とはいえ、純粋な Win32 環境であっても、車輪をいちいち作り直すことなく、CAPI の機能をさっと使って高度な GUI プログラムを生成したいと思うのは自然なことです。CAPI プログラムの中から Win32 固有の機能を使うこともできます。

(defclass image-pane (output-pane) ()
  (:default-initargs
   :display-callback 'draw-image))

...

(let ((pane-1 (make-instance 'image-pane))
      ...
      (contain (make-instance 'column-layout
                              :description (list pane-1 other-pane))
        :best-width 640
        :best-height 480)))

...

(defun draw-image (pane x y width height)
  (let ((hwnd (capi:simple-pane-handle pane)))
    ;; This returns the actual Win32 window handle
    ;; Now call CreateWindowEx with hwnd as the new window's parent
    ;; The Win32-defined window then covers the
    ;; CAPI window. After destroying or hiding the Win32 window, the
    ;; CAPI window is revealed.
    ;; Be careful not to create the window if it already is created.

    ....

image-pane から pane-1 への、そして image-pane から draw-image へのつながりと、pane-1 が CAPI のウィンドウに含まれていることに注目してください。draw-image は、画像を描くべきとき……つまり画像を描くべきときに呼び出されます！

ウィンドウへのハンドルや CAPI 環境とのその他のやりとりを必要としない Win32 関数の呼び出しは、もちろん問題なく動きます。

よいプログラムの多くは、主にローカル変数を使います。Windows のプログラムが動いている間に、Lispworks IDE からマルチプロセッシング環境を使ってプログラムを操作したい場合は、ウィンドウハンドルやその他の Windows リソースに対応するシンボルや変数にアクセスできることが重要です。SendMessage を REPL から呼ぶつもりなら、有効な hwnd が手に入る必要があります。hwnd を手元に置く方法のひとつは、OS が hwnd を渡してくる関数の中で setf することです。これはデバッグ専用の手法として使ってもよいし、プログラムの恒久的な一部として残しておいてもかまいません。

C とのインターフェイス

OS は Win32 関数の多くを常に利用可能にしています。一方で、たとえば avicap32 のビデオ関数のように、明示的にロードしなければならない DLL の中に存在する関数もあります。サードパーティ製や自作の DLL も、明示的なロードが必要です。

目的の DLL の名前にちなんだ .def ファイル（たとえば avicap32.def）を作ります。

exports capCreateCaptureWindow=capCreateCaptureWindowW
exports capGetDriverDescription=capGetDriverDescriptionW

そして Lisp 側では次のようにします。

;; capCreateCaptureWindow
(fli:define-foreign-function
    (capCreateCaptureWindow "capCreateCaptureWindowW")
    ((lpszWindowName :pointer) (dwStyle fli-dword) (x :int) (y :int)
     (nWidth :int) (nHeight :int) (HWND fli-hwnd) (nID :int))
  :result-type (:unsigned :long)
  :module :avicap32
  :documentation "Opens a video capture window.")

(fli:register-module "avicap32")

DLL 内の関数を使って作ったウィンドウには、先ほど示したように CAPI のウィンドウを親として与えられます。.def ファイルが必要かどうかは、どの関数を使いたいかによります。ここでは :dbcs を使えば、外部関数名にハードコードした ‘W’ が不要になるかもしれません。

RAII と GC

C++ でよく使われるイディオムに「Resource Acquisition Is Initialization（リソースの確保は初期化である）」があります。C++ のオブジェクトがコンストラクタでオペレーティングシステムのリソース（たとえば開いたファイル）を確保し、オブジェクトのデストラクタでそのリソースを解放するものです。これらのオブジェクトは動的エクステントを持つことも、不定エクステントを持つこともあります。

動的エクステントを持つオブジェクトは、C++ の関数の先頭でローカルに宣言され、関数が戻ってオブジェクトがスコープから外れると、そのデストラクタが呼ばれます。これに対応する Lisp のイディオムは with-... マクロの使用です。マクロはリソースを確保し、unwind-protect のもとでそれを解放する役割を担います。

C++ では、不定エクステントを持つオブジェクトは delete または delete [] でデストラクタを明示的に呼び出さなければなりません。デストラクタはオブジェクトを取り壊し、まず明示的に書かれた C++ コードによって確保済みのリソースを解放し、続いてデストラクタが終了する際にコンパイラ生成のコードによってオブジェクトのメモリを解放します。

Lisp はガベージコレクトされます。つまり、オブジェクトのメモリを解放するのは Lisp の責任です。しかしそれは、オブジェクトへの最後の参照が消えてから、かなり長い時間が経つまで起こらないかもしれません。ガベージコレクタはメモリが埋まったときか、明示的に呼ばれたときにしか動きません。オブジェクトが確保済みのリソースを保持している場合、ほとんどの場合そのリソースを解放すべき適切な時点があり、その時点で解放しないとリソースの枯渇につながります。

プログラマが明示的な Lisp コードで確保した、ウィンドウハンドルのような確保済みリソースについては、Lisp は責任を負いません。プログラマは (defun release-resources... のような関数を定義し、C++ ならデストラクタが呼ばれたであろう箇所でその解放関数を呼ばなければなりません。解放関数が戻り、オブジェクトへの参照がなくなれば、Lisp は将来のガベージコレクションでそのオブジェクトのメモリを解放します。

Win32/Lisp 環境のもうひとつの問題は GC に関するものです。GC は Lisp のデータを自由に移動できます。GC によって移動されうる Lisp データのアドレスを OS に渡してはいけません。OS に渡すデータはすべて FLI を通して確保すべきです。FLI がそのデータを移動不可にする役割を担います。

COM

COM は Windows プログラミングで広く使われています。Lispworks for Windows には COM/Automation User Guide and Reference Manual と関連する関数群が含まれています。私は Lisp で COM をいじったことがなく、ここではマニュアルと関数が利用できることを記すにとどめます。実のところ、com と automation を require して com:midl フォームを呼び出してみたところ、膨大な一連の IDL ファイルがロードされ、その幅広さと量に驚かされました。ただ、COM で実際に何かを動かすところまではやっていません。

Lisp の力を使い始める

デモプログラムをようやく完成させたとき、私が最初に思ったのは「ほかの Win32 プログラムと変わらないな」でした。Lisp らしいところは何もありませんでした。どんな言語でも書ける、ただの Win32 コードだったのです。言語が違えば得意な問題領域も違います。Perl と聞けばテキストを思い浮かべます。Fortran とともに数値を思い浮かべます。Lisp と聞けば、自分自身の言語を定義することを思い浮かべます。マクロは Lisp の中に組み込み言語を定義するために使う道具のひとつであり、Lisp をプログラム可能なプログラミング言語たらしめているものの一部です。

Win32 API プログラミングは、新しい言語を強く求めています。これは非常に強力で柔軟な API ですが、あるアプリケーションの文脈では特定の部分集合しか使われず、しかもそれらは繰り返しの形で使われます。これは、仮にできたとしても API そのものを再定義すべきだ、という意味ではありません。あるアプリケーションでうまくいくものが、次のアプリケーションでうまくいくとは限らないからです。おそらくほぼすべての Win32 プログラムで使われる言語拡張もあるでしょう。一方、特定のアプリケーションにしか当てはまらない拡張もあるでしょう。

Lisp の美点のひとつは、プログラマがいつでも新しい拡張を定義できることです。Common Lisp Cookbook のマクロの章を参照してください。マクロの書き方をはじめ多くを学ぶには、Paul Graham の On Lisp もおすすめします。

コードを書くときは、同じパターンを何度も打ち込んでいることに気づいてください。そして遅すぎないうちに「マクロか関数の出番だ」と考えましょう。マクロを書いているときでさえ、繰り返しのコーディングに気づいてください。マクロはマクロの上に組み立てられますし、マクロがマクロを生成することもできます。

マクロと関数のどちらを選ぶべきかは、ひとつにはコードの肥大化の問題です。マクロはその場で評価されて新しいコードを生み出しますが、関数はそうではありません。マクロの利点は、クロージャを作れること、つまりマクロが展開される時点で環境に存在する変数の値を取り込めることで、これにより単純なオブジェクトの必要性の多くがなくなります。マクロが defvar や defparameter フォームを作る場合、そのマクロが作る別の関数からそれらの変数やパラメータを使えます。もっとも、その用途にはクロージャも使えます。defvar を使うと、Win32 プログラムがウィンドウを開いて実行している間に、マルチプロセッシング環境の REPL からそれらの defvar を参照できます。defvar とクロージャのどちらを使うにせよ、保存と取り出しのための仕組みはまったく必要ありません。

マクロをこのように使わない場合、本来ならマクロが作っていたであろう関数は、当該オブジェクト固有のウィンドウハンドルやキャプションなどのリソースを取り出すために、何らかのオブジェクト検索コードを持たなければなりません。

関数は inline に declaim でき、パラメータとして渡せますが、マクロはそうはできない点に注意してください。

On Lisp で定義されているマクロの多くは、Win32 プログラミングでとても役立ちます。私はシンボル生成のマクロを多用しています。

必要なマクロのひとつの群は、Foreign Language Interface の利用をより簡単に、よりコンパクトに、より読みやすくします。私は with-foreign-strings というマクロを持っていて、これはポインタ名と文字列のペアのリストを受け取り、入れ子になった一連の (fli:with-foreign-string... 呼び出しを生成します。各文字列に対して、一意で予測可能な名前を付けた要素数とバイト数のパラメータの生成も含みます。私の setf-foreign-slot-values や with-foreign-slot-values マクロも、コードをよりコンパクトで読みやすくしてくれます。

もうひとつのマクロの群は、Windows のメッセージハンドラ関数を定義するのに役立ちます。私はウィンドウメッセージ用に CLOS クラスを作り、CLOS のメソッドディスパッチャに各メッセージへの適切な関数を見つけさせるのが好みです。こうするとメッセージハンドラを継承でき、派生クラスで選んだメッセージに対してより具体的なハンドラを定義できます。CLOS はこれをうまく扱ってくれます。私は DefMsgHandler というマクロを持っていて、これは RegisterClass を呼び、処理する各メッセージに対する CLOS メソッドを定義し、WM_PAINT のような遍在する関数で必要な定型処理を引き受け、望む種類のメッセージごとに実行する関数本体を簡単に定義できるようにします。ほかにも、プッシュボタン、エディットボックス、リストビューなどの Win32 コントロールを定義するのに役立つマクロがあります。

付録 B を見て、付録 A と比べてみてください。もちろん、付録 A のヘッダファイル部分を拡張したものが付録 B でも使われていますが、そこには示されていません。付録 A のプログラムは、ごく一部を除いてライブラリにまとめられ、付録 B ではそれが呼び出されています。アプリケーション固有の情報はすべて、付録 B のごく小さなプログラムの中に収まっています。

付録 C のプログラムは、これらのマクロを使って、ラジオボタン、プッシュボタン、チェックボックス、背景ウィンドウに描いたテキスト、そして列を持つリストビューを含むウィンドウを定義しています。

まとめ

本文と付録 A〜C で示したサンプルコードは、Lisp の中にとどまり、そこから Win32 API にアクセスすることに重点を置いています。Paul Tarvydas は 付録 D に、C と Lisp の協調とやりとりを示すコードを寄せています。Paul のよく書かれた例では、メッセージループの駆動に C の dll を使い、Lisp のコールバック関数のアドレスを Lisp 側から dll 内の変数に書き込んでいます。

Lisp は対話的で豊かなプログラミング環境を提供します。Lisp で言語拡張を作るためにマクロを賢く使うと、アプリケーション固有の情報がシステム全体の中の小さな局所領域に集約されます。これによってアプリケーションを理解する労力が減り、アプリケーションの信頼性が高まり、保守の時間が短くなり、保守のための変更の信頼性も高まります。Lisp はこれを容易にするよう設計されています。

付録 A: 「Hello, Lisp」プログラム #1

ここに、「Hello, Lisp!」と表示する GUI ウィンドウを開く Win32 Lisp プログラムを示します。プログラムの詳細についての議論は、このリスティングのあとに続きます。プログラムのリスティングには、C/C++ プログラムで #include されるヘッダファイルから必要な行が含まれています。

本文を読みながら、プログラムのソースコードが見える別ウィンドウを開いておくと便利かもしれません。

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; Header-file kinds of code
;

; Determine character type
(defun external-format ()
  (if (string= (software-type) "Windows NT")
      :unicode
      :ascii))

(defparameter *class-name* "LWTestClass")

;--- Win32 SDK Constants

; Not all of these are verified by testing in code
; More are included than are used to allow play
(defconstant COLOR_WINDOW                 5)
(defconstant CS_HREDRAW                   1)
(defconstant CS_VREDRAW                   2)
(defconstant CW_USEDEFAULT       #x80000000)
(defconstant IDC_ARROW                32512)
(defconstant SW_SHOW                      5)
(defconstant WM_CLOSE            #x00000010)
(defconstant WM_DESTROY          #x00000002)
(defconstant WM_PAINT            #x0000000f)
(defconstant WS_BORDER           #x00080000)
(defconstant WS_CAPTION          #x00C00000)
(defconstant WS_CHILD            #x40000000)
(defconstant WS_DISABLED         #x08000000)
(defconstant WS_EX_CONTROLPARENT #x00010000)
(defconstant WS_EX_APPWINDOW     #x00040000)
(defconstant WS_MAXIMIZEBOX      #x00010000)
(defconstant WS_MINIMIZEBOX      #x00020000)
(defconstant WS_OVERLAPPED       #x00000000)
(defconstant WS_POPUP            #x80000000)
(defconstant WS_SYSMENU          #x00080000)
(defconstant WS_THICKFRAME       #x00040000)
(defconstant WS_VISIBLE          #x10000000)

; Aggregates
(defconstant WS_POPUPWINDOW (logior ws_popup ws_border ws_sysmenu))
(defconstant WS_OVERLAPPEDWINDOW (logior ws_overlapped ws_caption
                                         ws_sysmenu ws_thickframe
                                         ws_minimizebox ws_maximizebox))

;--- Win32 SDK data types

(fli:define-c-typedef BOOL (:unsigned :long))
(fli:define-c-typedef DWORD (:unsigned :long))
(fli:define-c-typedef HANDLE (:unsigned :long))
(fli:define-c-typedef HDC (:unsigned :long))
(fli:define-c-typedef HINSTANCE (:unsigned :long))
(fli:define-c-typedef HMENU (:unsigned :long))
(fli:define-c-typedef HWND (:unsigned :long))
(fli:define-c-typedef INT :int)
(fli:define-c-typedef LONG :long)
(fli:define-c-typedef LPCTSTR :pointer)
(fli:define-c-typedef LPSTR :pointer)
(fli:define-c-typedef LPVOID :long)
(fli:define-c-typedef LPFN :long) ;; Doesn't work as :pointer
(fli:define-c-typedef UINT (:unsigned :int))
(fli:define-c-typedef ULONG (:unsigned :long))
(fli:define-c-typedef wBYTE (:unsigned :char))
(fli:define-c-typedef PTR (:unsigned :long))

;--- Win32 SDK structures

; POINT
(fli:define-c-struct sPOINT
    (x int)
  (y int))
(fli:define-c-typedef POINT sPOINT)

; MSG
(fli:define-c-struct sMSG
    (hwnd hwnd)
  (wParam ulong)
  (lParam ulong)
  (time dword)
  (point point))
(fli:define-c-typedef MSG sMSG)

; PAINTSTRUCT
(fli:define-c-struct sPAINTSTRUCT
    (HDC hdc)
  (fErase bool)
  (rcPaint-x uint)
  (rcPaint-y uint)
  (rcPaint-width uint)
  (rcPaint-height uint)
  (fRestore bool)
  (fIncUpdate bool)
  (rgbReserved (:c-array wBYTE 32)))
(fli:define-c-typedef PAINTSTRUCT sPAINTSTRUCT)

; WndClass
(fli:define-c-struct sWNDCLASS
    (style uint)
  (lpfnWndProc lpfn)
  (cbClsExtra int)
  (cbWndExtra int)
  (hInstance handle)
  (hIcon handle)
  (hCursor handle)
  (hBrBackground handle)
  (lpszMenuName ulong) ;; ulong so it can be set to null without error
  (lpszClassName lpctstr))
(fli:define-c-typedef WNDCLASS sWNDCLASS)

;--- Win32 SDK functions

; BeginPaint
(fli:define-foreign-function
    (BeginPaint "BeginPaint" :calling-convention :stdcall)
    ((hwnd hwnd) (lpPaintStruct ptr))
  :result-type hdc)

; CreateWindowEx
(fli:define-foreign-function
    (CreateWindowEx "CreateWindowEx" :dbcs :calling-convention :stdcall)
    ((dwExStyle dword) (lpClassName lpctstr) (lpWindowName lpctstr)
     (dwStyle dword) (x uint) (y uint) (nWidth uint) (nHeight uint)
     (hwndParent hwnd) (hMenu hmenu) (hInstance hinstance) (lpParam lpvoid))
  :result-type hwnd)

; DefWindowProc
(fli:define-foreign-function
    (DefWindowProc "DefWindowProc" :dbcs :calling-convenction :stdcall)
    ((hwnd ulong) (msg ulong) (wparam ulong) (lparam ulong))
  :result-type ulong)

; DispatchMessage
(fli:define-foreign-function
    (DispatchMessage "DispatchMessage" :dbcs :calling-convention :stdcall)
    ((MsgPtr ptr)) ;; We're passing a pointer but Lisp doesn't know
  :result-type ulong)

; EndPaint
(fli:define-foreign-function
    (EndPaint "EndPaint" :calling-convention :stdcall)
    ((hwnd hwnd) (lpPaintStruct ptr))
  :result-type bool)

; GetLastError
(fli:define-foreign-function
    (GetLastError "GetLastError" :calling-convention :stdcall)
    ()
  :result-type dword)

; GetMessage
(fli:define-foreign-function
    (GetMessage "GetMessage" :dbcs :calling-convention :stdcall)
    ((lpMsg ptr) (hwnd ulong) (MsgFiltMin ulong) (MsgFiltMax ulong))
  :result-type bool)

; GetModuleHandle - with no module name specified; pass this a zero i.e. NULL
(fli:define-foreign-function
    (GetModuleHandle-current "GetModuleHandle"
                             :dbcs :calling-convenction :stdcall)
    ((lpModuleName :long))
  :result-type handle)

; Lisp helper
(defmacro current-module-handle ()
  `(GetModuleHandle-current 0))

; GetModuleHandle - pass this a foreign string naming the desired module
(fli:define-foreign-function
    (GetModuleHandle "GetModuleHandle" :dbcs :calling-convenction :stdcall)
    ((lpModuleName lpctstr))
  :result-type handle)

; LoadCursor
(fli:define-foreign-function
    (LoadCursor "LoadCursor" :dbcs)
    ((hInstance handle) (param (:unsigned :long)))
  :result-type handle)

; PostQuitMessage
(fli:define-foreign-function
    (PostQuitMessage "PostQuitMessage" :calling-convention :stdcall)
    ((nExitCode :int))
  :result-type :void)

; RegisterClass
(fli:define-foreign-function
    (RegisterClass "RegisterClass" :dbcs :calling-convention :stdcall)
    ((WndClass ptr))
  :result-type bool)

; TextOut
(fli:define-foreign-function
    (TextOut "TextOut" :dbcs :calling-convention :stdcall)
    ((HDC hdc) (nXStart uint) (nYStart uint)
     (lpString lpctstr) (cbString uint))
  :result-type bool)

; TranslateMessage
(fli:define-foreign-function
    (TranslateMessage "TranslateMessage" :calling-convention :stdcall)
    ((msg-ptr ulong))
  :result-type bool)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; Code specific to one program
;

;--- Win32 SDK Callbacks

; WndProc -- Window procedure for the window we will create
(fli:define-foreign-callable
    (wndproc :result-type :long :calling-convention :stdcall)
    ((hwnd hwnd) (msg (:unsigned :long))
     (wparam (:unsigned :long)) (lparam (:unsigned :long)))
  (case msg
    (#.WM_PAINT (wndproc-paint hwnd msg wparam lparam))
    #+console (#.WM_DESTROY (PostQuitMessage 0) 0)
    (t (DefWindowProc hwnd msg wparam lparam))))

;--- Functions called from WndProc

(defun wndproc-paint (hwnd msg wparam lparam)
  (fli:with-dynamic-foreign-objects ()
    (let* ((ps (fli:allocate-dynamic-foreign-object :type 'paintstruct))
           (hdc (beginpaint hwnd (fli:pointer-address ps))))
                                        ; Paint here
      (fli:with-foreign-string (text-ptr ec bc :external-format (external-format))
        "Hello, Lisp!"
        (textout hdc 0 0 text-ptr ec))
      (endpaint hwnd (fli:pointer-address ps))
      0)))

;--- Main Functions

(defun register-class ()
  (fli:with-foreign-string (cn-p ec bc :external-format (external-format))
    *class-name*
    ;; Below - use with-dynamic... for automatic freeing. Make some pointers.
    (let (rslt
          (wc-p (fli:allocate-foreign-object :type 'wndclass))
          (wp-p (fli:make-pointer :symbol-name "wndproc")))
      (unwind-protect
           (progn
             (setf (fli:foreign-slot-value wc-p 'style) (logior cs_hredraw cs_vredraw))
             (setf (fli:foreign-slot-value wc-p 'lpfnWndProc)
                   (fli:pointer-address wp-p))
             (setf (fli:foreign-slot-value wc-p 'cbClsExtra) 0)
             (setf (fli:foreign-slot-value wc-p 'cbWndExtra) 0)
             (setf (fli:foreign-slot-value wc-p 'hInstance) (current-module-handle))
             (setf (fli:foreign-slot-value wc-p 'hIcon) 0)
             (setf (fli:foreign-slot-value wc-p 'hCursor) (LoadCursor 0 IDC_ARROW))
             (setf (fli:foreign-slot-value wc-p 'hbrBackground) (1+ color_window))
             (setf (fli:foreign-slot-value wc-p 'lpszMenuName) 0)
             (setf (fli:foreign-slot-value wc-p 'lpszClassName) cn-p)
             (setq rslt (RegisterClass (fli:pointer-address wc-p))))
        (fli:free-foreign-object wp-p)
        (fli:free-foreign-object wc-p)
        (if (/= rslt 0)
            rslt
            (error (format nil "~&RegisterClass failed in reg-class. Error: ~a"
                           (GetLastError))))))))

(defvar *reg-class-atom* (register-class))

; CreateWindow
(defun create-toplevel-window-run (window-name)
  "See create-window."
  (fli:with-foreign-string ;; class name pointer
      (cn-p ec bc :external-format (external-format)) *class-name*
      (fli:with-foreign-string ;; window name pointer
          (wn-p ec bc :external-format (external-format)) window-name
          (let ((hwnd (createwindowex 0 cn-p wn-p
                                      (logior ws_visible ws_overlappedwindow)
                                      cw_usedefault cw_usedefault cw_usedefault cw_usedefault
                                        ;0 0 640 480
                                      0 0 (GetModuleHandle-current 0) 0)))
            (when (zerop hwnd)
              (error (format nil "CreateWindow failed. GetLastError is ~a"
                             (GetLastError))))
            #-console hwnd ;; Should return wParam in thread, what about here?
            #+console ;; Message pump the thread
            (fli:with-dynamic-foreign-objects ()
	      (let ((ms (fli:allocate-dynamic-foreign-object :type 'msg)))
                (do ((gm (GetMessage (fli:pointer-address ms) 0 0 0)
                         (GetMessage (fli:pointer-address ms) 0 0 0)))
                    ((zerop gm) (fli:foreign-slot-value ms 'wParam))
                  (TranslateMessage (fli:pointer-address ms))
                  (DispatchMessage (fli:pointer-address ms)))))))))

; CloseWindow
(defun close-window (hwnd)
  (sendmessage hwnd WM_CLOSE 0 0))

(defmacro create-toplevel-window (window-name)
  "Creates an overlapped window with title WINDOW-NAME.
	      Returns the window handle."
  #-console `(create-toplevel-window-run ,window-name)
  #+console  `(progn
                (when (null (mp:list-all-processes))
                  (mp:initialize-multiprocessing))
                (mp:process-run-function ,window-name nil
                                         'create-toplevel-window-run ,window-name)))

付録 B: 「Hello, Lisp!」プログラム #2

(require "win-header")

(in-package :wh)
(export '(initialize-appendix-b))

(DefMsgHandler appendix-b-proc MsgMap ()
               (WM_PAINT
                (text-out "Hello, Lisp!" 0 0 :color (RGB 0 0 255))
                0))

(defun initialize-appendix-b ()
  (DefActiveTopWindow "Hello" 'appendix-b-proc
    :style ws_overlappedwindow :width 200 :height 100 :title "Hello Program"))

付録 C: プログラム #3

(require "win-header")

(in-package :wh)
(export '(initialize-appendix-c))

; Following helps group the radio buttons
(defparameter *radio-list* nil)

; Define a message handler routine named testproc, inheriting
;  from the base MsgMap. Others could inherit from this one...
(DefMsgHandler appendix-c-proc MsgMap (:hbrbackground (1+ color_btnface))
               (WM_CREATE

                (DefGroupBox hwndGroupBox "Wish List" 25 30 300 70) ;; left top width height

                (DefPushButton hwndB1 "More Money" 30 48 90 40
                               ((mMessageBox "Quit buying Lisp books." "You requested more money.")))

                (DefPushButton hwndB2 "Youth" 121 48 90 40
                               ((mMessageBox "Sorry, not even Lisp can help you there." "You requested Youth.")))

                (DefPushButton hwndB3 "Better Lisp Skills" 212 48 90 40
                               ((mMessageBox "Keep practising." "You requested better Lisp skills.")))

                (DefRadioButton hwndRB1 "Lisp is cool" 40 105 100 20
                                :hwndlist *radio-list*)

                (DefRadioButton hwndRB2 "Lisp is boss" 200 105 100 20
                                :hwndlist *radio-list*)

                (SetCheck *hwndRB1*)

                (with-listview (DefListView hwndListView "" 25 150 300 200)
                  ((col "Lisp Book Title" 90)
                   (col "ISBN" 66)
                   (col "Author" 150)))

                (DefEdit hwndEdit "Learning Lisp is fun" 40 372 160 20 ())

                (DefAutoCheckBox hwndCheckBox "I like it" 210 372 70 20
                                 ((if (IsChecked *hwndCheckBox*)
                                      (mMessageBox "I'm glad you like it" "Atta boy!")
                                      (mMessageBox "Don't you like it?" "Whatsamatta U."))))
                0)

               (WM_PAINT
                (with-font "Arial" -20 font-normal 0 0 0 ;; points weight italic bold underline
                           (text-out "I Like Lisp" 70 5 :color (RGB 0 0 255)))
                (with-font "Arial" -11 font-bold 0 0 0
                           (text-out "Try it, you might like it, too!" 170 10
                                     :color (RGB 255 0 0)))
                0))

(defun initialize-appendix-c ()
  (DefActiveTopWindow "Test" 'appendix-c-proc
    :style ws_overlappedwindow :width 360 :height 450
    :title "First Lisp Screenshot"))

付録 D: Paul Tarvydas の例

これは、（C で）ウィンドウクラスを作り、それを LWW から呼び出して処理する例です。Petzold の「Hello」の例に似ていますが、独自のメインループを作る代わりに LWW のメインループにフックする点が異なります。私が Win32 に不慣れなため（そして辛抱が足りないため :-)）、おそらく本来あるべき姿ほどきれいではありません。

使い方は次のとおりです。

1) “wintest” という DevStudio の Win32 DLL プロジェクトを作る 2) wintest.c ファイルをプロジェクトに入れる 3) run.lisp ファイルをプロジェクトディレクトリにコピーする（Debug ディレクトリがそのサブディレクトリになるように） 4) C プロジェクトをビルドする 5) Project»Settings»Debug»Executable for debug session を lispworksxxx.exe を指すように設定する 6) プロジェクトを実行する。これで lispworks が立ち上がるはず 7) run.lisp を開き、コンパイルしてロードする 8) リスナーで “(run)” と打つ 9) すると、中央に “hello” と表示されたウィンドウが見えるはず

このサンプルのウィンドウクラスは C で作られて初期化されます（lisp のメインラインから呼ばれます）。このウィンドウへの Windows からのコールバック（たとえば WM_PAINT メッセージ）は lisp で処理されます。Windows には lisp 関数（Lisp_WndProc）へのポインタが渡され、コールバックにそれを使うよう指示されています。lisp コードは “hello” のテキストを表示する Win32 呼び出しを直接行います。lisp はこれを設定するために FLI の外部関数と外部変数を使います。［実際のプロジェクトでこれを行うなら、もっと無理のない制御の流れを選ぶでしょうが、この例はあなたが尋ねていた FLI 呼び出しをひととおり試しているようです。］

［スタイルや簡素化などについて、どなたからのコメントも歓迎します。］

Paul Tarvydas tarvydas at spamoff-attcanada dotca

//
// Example of creating a windows class in
// a DLL, then invoking it from Lisp.
//
// Convention for this example - routines
// that are written in C and are called by
// lisp are prefixed by "C_" and routines
// written in lisp called by C are prefixed
// by "Lisp_".  Note that, using LWW's FLI functions
// and declarations everything could be done in Lisp.
// This example shows how to bounce between Lisp and
// C in the event that one might wish to "reuse"
// existing C code.

//
// The routines C_CreateClass and C_CreateWindow are
// written in C and exported from the DLL to be called
// by Lisp.  Note that routines exported from a DLL
// are expected to use the :stdcall calling convention.
//
// The routine Lisp_WndProc is written in Lisp and
// exported (via FLI) so that it may be called
// by Windows.  Note that Windows expects Lisp_WndProc
// to use the :stdcall calling convention.

#include <windows.h>
#include <stdio.h>

BOOL APIENTRY DllMain( HANDLE hModule,
                       DWORD  ul_reason_for_call,
                       LPVOID lpReserved )
{
  return TRUE;
}

// Windows calls a WndProc function to deliver a windows
// event to a widget.  In this example, this callback
// function is written in lisp.  If the WndProc function
// decides to handle the event, it should return 0, else
// it should call DefWindowProc.
//
// To get at the function, C uses a function pointer.
// Lisp must set this function pointer before calling
// C_CreateClass.  This variable is exported from
// the dll, allowing lisp to see it and to put a value
// into it.
//
// [Obviously, we could do this in other ways, for
// example, we could pass the pointer to C_CreateClass as
// a parameter.  Choosing to use a pointer variable shows
// off more of the FLI - the fact that lisp can manipulate
// C variables which reside in the DLL itself.]
//
__declspec(dllexport) LRESULT (CALLBACK *Lisp_WndProc)(HWND window,
UINT eventType, UINT wParam, LONG lParam);

//
// Example Window (ExWindow)
//

__declspec(dllexport) void C_CreateClass (void) {
WNDCLASS wClass;

/* setup the window class data and register the class */

  wClass.style = CS_HREDRAW | CS_VREDRAW;
  wClass.lpfnWndProc = Lisp_WndProc;
  wClass.cbClsExtra = wClass.cbWndExtra = 0;
  wClass.hInstance = GetModuleHandle (NULL);
  wClass.hIcon = LoadIcon(NULL,IDI_APPLICATION);
  wClass.hCursor = LoadCursor(NULL,IDC_ARROW);
  wClass.hbrBackground = GetStockObject(LTGRAY_BRUSH);
  wClass.lpszMenuName = NULL;
  wClass.lpszClassName = "ExWindow";
  RegisterClass(&wClass);
}

//
// create and display a window and returns its HWND
//
__declspec(dllexport) HWND C_CreateWindow (void) {
  HWND mainWindow;
  STARTUPINFO startup;
  mainWindow = CreateWindow("ExWindow",// window class name
                            "ExWindow", // Window caption
                            WS_OVERLAPPEDWINDOW, // style
                            CW_USEDEFAULT, // initial x position
                            CW_USEDEFAULT, // initial y position
                            CW_USEDEFAULT, // initial x extent
                            CW_USEDEFAULT, // initial y extent
                            NULL, //(HWND)parent, // parent window
                            NULL, // menu handle
                            GetModuleHandle (NULL), // program instance
handle
                            NULL); // creation parameters
  if (NULL == mainWindow) {
        long r = GetLastError();
  } else {
        GetStartupInfo (&startup);
        ShowWindow(mainWindow,startup.wShowWindow);
        UpdateWindow(mainWindow);
  }
  return mainWindow;
}


;
; Driver that initializes and calls a C dll
; to display a window.
;

; Define some Win32 types
(fli:define-c-typedef HWND (:unsigned :long))
(fli:define-c-typedef HANDLE (:pointer :void))
(fli:define-c-typedef HDC (:pointer :void))
(fli:define-c-typedef BOOL :int)
(fli:define-c-typedef wBYTE (:unsigned :char))
(fli:define-c-struct sRECT
  (left :LONG)
  (top  :LONG)
  (right :LONG)
  (bottom :LONG))
(fli:define-c-typedef RECT sRECT)
(fli:define-c-struct sPAINTSTRUCT ;; from winuser.h
  (hdc HDC)
  (fErase BOOL)
  (rcPaint RECT)
  (fRestore BOOL)
  (fIncUpdate BOOL)
  (rbgReserved (:c-array wBYTE 32)))
(fli:define-c-typedef PAINTSTRUCT sPAINTSTRUCT)

; some constants from WINUSER.H
(eval-when (compile load)
  (defconstant WM_COMMAND #x0111)
  (defconstant WM_PAINT #x000F)
  (defconstant WM_DESTROY #x0002))
(defconstant DT_TOP              #x00000000)
(defconstant DT_LEFT             #x00000000)
(defconstant DT_CENTER           #x00000001)
(defconstant DT_RIGHT            #x00000002)
(defconstant DT_VCENTER          #x00000004)
(defconstant DT_BOTTOM           #x00000008)
(defconstant DT_WORDBREAK        #x00000010)
(defconstant DT_SINGLELINE       #x00000020)
(defconstant DT_EXPANDTABS       #x00000040)
(defconstant DT_TABSTOP          #x00000080)
(defconstant DT_NOCLIP           #x00000100)
(defconstant DT_EXTERNALLEADING  #x00000200)
(defconstant DT_CALCRECT         #x00000400)
(defconstant DT_NOPREFIX         #x00000800)
(defconstant DT_INTERNAL         #x00001000)

; some Win32 calls
(fli:define-foreign-function (get-last-error "GetLastError")
    () :result-type :long :calling-convention :stdcall)

(fli:define-foreign-function (GetClientRect "GetClientRect")
    ((h HWND) (l (:pointer RECT)))
  :result-type :long :calling-convention :stdcall)

(fli:define-foreign-function (DrawText "DrawText" :dbcs)
    ((h HDC) (s :pointer) (nCount :int) (lprect :pointer)
     (uFormat (:unsigned :int)))
  :result-type :long :calling-convention :stdcall)

(fli:define-foreign-function (BeginPaint "BeginPaint")
    ((h HWND) (lpPaint :pointer))
  :result-type HDC :calling-convention :stdcall)

(fli:define-foreign-function (EndPaint "EndPaint")
    ((h HWND) (lpPaint :pointer))
  :result-type BOOL :calling-convention :stdcall)

(fli:define-foreign-function (DefWindowProc "DefWindowProc" :dbcs)
    ((h HWND) (msg (:unsigned :int))
     (wParam (:unsigned :int)) (lParam (:unsigned :int)))
  :result-type :long :calling-convention :stdcall)

;
; Exports from the DLL
;
; definition of pointer variable exported from the DLL
(fli:define-foreign-variable (Lisp_WndProc "Lisp_WndProc") :type
  :pointer)

; definition of routines exported from the DLL
(fli:define-foreign-function (C_CreateClass "C_CreateClass")
    () :result-type :void :calling-convention :stdcall)

(fli:define-foreign-function (C_CreateWindow "C_CreateWindow")
    () :result-type HWND :calling-convention :stdcall)

;
; Exports from Lisp
;

; The WndProc that Windows will call when an event is
; sent to the window.  Written in lisp, made callable
; from C/Windows (using :stdcall convention).
; The function closely resembles the hellowin.c code
; found in Petzhold (page 45, 5th ed), except that
; the "WM_CREATE" stuff is handled in C.
; (nb: we don't care what the name is - we use
; a pointer to this function)
(fli:define-foreign-callable
    ("func_Lisp_WndProc" :result-type :long
                         :calling-convention :stdcall)
    ((window HWND) (message (:unsigned :int))
     (wParam (:unsigned :int)) (lParam (:unsigned :int)))

  (case message

    (#.WM_PAINT
     (fli:with-dynamic-foreign-objects ((hdc HDC)
                                        (ps PAINTSTRUCT)
                                        (rect RECT))
       (fli:with-coerced-pointer (p-ps) ps
         (fli:with-coerced-pointer (p-rect) rect
                                   (setf hdc (BeginPaint window p-ps))
                                   (GetClientRect window p-rect)
                                   (fli:with-foreign-string
                                       (p-str ecount bcount :external-format (ext-format))
                                     "Hello" (declare (ignore ecount bcount))
                                     (DrawText hdc p-str -1 p-rect
                                               (logior DT_SINGLELINE DT_CENTER DT_VCENTER))
                                     (EndPaint window p-ps)
                                     0)))))

    (#.WM_DESTROY 0)  ;; if we use PostQuitMessage here, LWW will also
    exit

    (otherwise (DefWindowProc window message wParam lParam))))

(defun ext-format ()
  (if (string= (software-type) "Windows NT")
      :unicode
      :ascii))

;
; The test program
;

(defun run ()
  ; set up the DLL
  (fli:register-module "debug/wintest.dll")

  ; poke the function pointer for the lisp windows proc
  (setf (Lisp_WndProc)
        (fli:make-pointer :symbol-name "func_Lisp_WndProc"))

  ; create the Windows class for ExWindow
  (C_CreateClass)

  ; instantiate an ExWindow
  (C_CreateWindow)

  ; the windows loop takes care of the rest
  ; nb - we've hooked to the windows loop of LWW by
  ; using GetWindowHandle(0) in the C code.
  )

Page source: ja/win32.md

T
O
C