w32api-utils.lisp

   1 (in-package cl-user)
   2
   3 (require 'lucifer-luciffi)
   4
   5 (defpackage cl-w32api.utils
   6   (:nicknames w32apiutils)
   7   (:use :cl :lutilities :luciffi))
   8
   9 (in-package cl-w32api.utils)
  10
  11 (defvar-exported +win32-string-encoding+ :cp1251)
  12 (defvar-exported +win32-wstring-encoding+ :ucs-2le)
  13
  14 ;;export macros for cffi macros.
  15 (defmacro-exported defctype-exported (&whole form name base-type &optional documentation)
  16   (declare (ignore name base-type documentation))
  17   `(defexport defctype ,@(cdr form)))
  18
  19 (defmacro-exported defcfunex-exported
  20     (&whole form (c-name lisp-name &rest other-options) return-type &body args)
  21   (declare (ignorable c-name other-options return-type args))
  22   `(progn
  23      (eval-when (:compile-toplevel :load-toplevel :execute)
  24        (export ',lisp-name))
  25      (defcfun-extended ,@(cdr form))))
  26
  27 (defun ansi-pp-fn (form)
  28   `(let ((luciffi::*default-foreign-encoding* +win32-string-encoding+))
  29      ,form ))
  30
  31 (defun unicode-pp-fn (form)
  32   `(let ((luciffi::*default-foreign-encoding* +win32-wstring-encoding+))
  33      ,form ))
  34
  35
  36 (defmacro-exported defcfunex-a-exported
  37     ((c-name lisp-name &rest other-options) return-type &body args)
  38   (declare (ignorable c-name other-options return-type args))
  39   `(progn
  40      (eval-when (:compile-toplevel :load-toplevel :execute)
  41        (export ',lisp-name))
  42      (defcfun-extended-with-fn (,c-name ,lisp-name ,@other-options)
  43          ,return-type ,#'ansi-pp-fn ,@args)))
  44
  45 (defmacro-exported defcfunex-w-exported
  46     ((c-name lisp-name &rest other-options) return-type &body args)
  47   (declare (ignorable c-name other-options return-type args))
  48   `(progn
  49      (eval-when (:compile-toplevel :load-toplevel :execute)
  50        (export ',lisp-name))
  51      (defcfun-extended-with-fn (,c-name ,lisp-name ,@other-options)
  52          ,return-type ,#'unicode-pp-fn ,@args)))
  53
  54
  55 (defmacro-exported define-abbrev-exported (short long)
  56   `(defmacro-exported ,short (&rest args)
  57      `(,',long ,@args)))