クリップボード

高機能なエディタを使っている人には必要ないものかもしれませんが、
クリップボードに文字列を出し入れするライブラリを作ってみました。
Cで書かれた部分は思いっきりWindowsに依存しています。
Schemeで書かれた部分はOSとは無関係なはずです。

DLLを作ってみる

Visual C++でコンパイルするときは
関数の宣言や定義で__declspec(dllexport)と書きます。
これはGCCでは不要です。

/* 例 */
__declspec(dllexport) char *clip_get(void)
{
  ...
}

関数は以下の3つ。

clip_get
クリップボードにテキストデータがあれば文字列を返す。
clip_free
clip_getで得た文字列のメモリを解放する。
clip_set
クリップボードに文字列をコピーする。

ソースファイル名は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

とする。

MzSchemeから呼び出す

上で作った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に変換されます。逆もまた然り。

例: eval

(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 #"&amp;" out) (loop))
              ((= c (char->integer #\<))
               (write-bytes #"&lt;" out) (loop))
              ((= c (char->integer #\>))
               (write-bytes #"&gt;" out) (loop))
              ((= c (char->integer #\"))
               (write-bytes #"&quot;" out) (loop))
              (else (write-byte c out) (loop)))))))))

参考

inserted by FC2 system