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 ;;wrong -- TODO: process struct name from arg.
  20 (defmacro-exported defcstructex-exported (&whole form name-and-options &body fields)
  21   (declare (ignorable))
  22   `(progn
  23      (eval-when (:compile-toplevel :load-toplevel :execute)
  24        (export ',(if (atom name-and-options)
  25                      name-and-options
  26                      (car name-and-options))))
  27      (defcstruct-extended ,@(cdr form))))
  28
  29 ;;wrong  -- TODO: process lisp-name from arg.
  30 (defmacro-exported defcfunex-exported
  31     (&whole form (c-name lisp-name &rest other-options) return-type &body args)
  32   (declare (ignorable c-name other-options return-type args))
  33   `(progn
  34      (eval-when (:compile-toplevel :load-toplevel :execute)
  35        (export ',lisp-name))
  36      (defcfun-extended ,@(cdr form))))
  37
  38 (defmacro-exported define-abbrev-exported (short long)
  39   `(progn (eval-when (:compile-toplevel :load-toplevel :execute)
  40             (export ',short))
  41           (eval-when (:load-toplevel :execute)
  42             (cond
  43               ((macro-function ',long) (setf (macro-function ',short)
  44                                              (macro-function ',long)))
  45               ((fdefinition    ',long) (setf (fdefinition ',short)
  46                                              (fdefinition    ',long)))
  47               (t (error "~S is not defined!" ',long))))))