高機能なエディタを使っている人には必要ないものかもしれませんが、
クリップボードに文字列を出し入れするライブラリを作ってみました。
Cで書かれた部分は思いっきりWindowsに依存しています。
Schemeで書かれた部分はOSとは無関係なはずです。
Visual C++でコンパイルするときは
関数の宣言や定義で__declspec(dllexport)
と書きます。
これはGCCでは不要です。
/* 例 */ __declspec(dllexport) char *clip_get(void) { ... }
関数は以下の3つ。
ソースファイル名はclip.cとします。
#include <stdlib.h> #include <windows.h> #define error_if(x) if (x) exit(1) char *clip_get(void) { HANDLE hText; size_t size; char *p, *q; if (!OpenClipboard(NULL)) {return NULL;} hText = GetClipboardData(CF_TEXT); if (!hText) { q = NULL; } else { p = (char *) GlobalLock(hText); size = strlen(p) + 1; q = (char *) malloc(size); error_if(!q); strcpy(q, p); GlobalUnlock(hText); } CloseClipboard(); return q; } void clip_free(char *p) { if (p) { free(p); } } void clip_set(const char *p) { HGLOBAL hText; DWORD size; char *q; if (!p || !OpenClipboard(NULL)) {return;} size = strlen(p) + 1; hText = GlobalAlloc(GMEM_DDESHARE | GMEM_MOVEABLE, size); error_if(!hText); q = (char *) GlobalLock(hText); strcpy(q, p); GlobalUnlock(hText); EmptyClipboard(); SetClipboardData(CF_TEXT, hText); CloseClipboard(); }
コンパイルするには
gcc -c clip.c gcc -shared -o clip.dll clip.o
とする。
上で作ったDLLはMzSchemeに依存しませんが、
ここではMzSchemeで利用する例を示します。
以下のモジュールでDLLをロードします。
モジュールの意味が分からないという人は、
最初の行と最後の行を削除してもよいです。
(module clip mzscheme (require (lib "foreign.ss")) (unsafe!) (define _clip (ffi-lib "clip")) (define _clip_get (get-ffi-obj "clip_get" _clip (_fun -> _bytes))) (define _clip_free (get-ffi-obj "clip_free" _clip (_fun _bytes -> _void))) (define _clip_set (get-ffi-obj "clip_set" _clip (_fun _bytes -> _void))) (define (clip-get) (let ((x (_clip_get))) (and x (let ((y (bytes-copy x))) (_clip_free x) y)))) (define clip-set! _clip_set) (provide clip-get clip-set!))
FFIが自動的に(char *)型のデータをbyte stringに変換してくれます。
NULLは#fに変換されます。逆もまた然り。
(define (clip-eval) (let ((s (clip-get))) (if (not s) #f (let ((in (open-input-bytes s)) (out (open-output-bytes))) (write (eval (read in)) out) (clip-set! (get-output-bytes out)) #t))))
(define (ampersand) (let ((s (clip-get))) (if (not s) #f (let ((in (open-input-bytes s)) (out (open-output-bytes))) (let loop () (let ((c (read-byte in))) (cond ((eof-object? c) (clip-set! (get-output-bytes out)) #t) ((= c (char->integer #\&)) (write-bytes #"&" out) (loop)) ((= c (char->integer #\<)) (write-bytes #"<" out) (loop)) ((= c (char->integer #\>)) (write-bytes #">" out) (loop)) ((= c (char->integer #\")) (write-bytes #""" out) (loop)) (else (write-byte c out) (loop)))))))))