w32api-module.lisp

   1 (in-package cl-user)
   2
   3 (require 'lucifer-lutilities)
   4 (require 'lucifer-luciffi)
   5
   6 (defpackage cl-w32api.module
   7   (:nicknames w32apimod)
   8   (:use :cl :lutilities :luciffi :cl-w32api.utils)
   9   )
  10
  11 (in-package w32apimod)
  12
  13 (defvar *w32api-modules* (make-hash-table :test 'equal))
  14 (defvar *w32api-module-path* (or #.*compile-file-truename*
  15                                  #.*load-truename*))
  16
  17 (defmacro-exported define-w32api-module (name &rest module-names)
  18   (let ((new-package-name (intern (concatenate 'string
  19                                                (string-upcase "cl-w32api.module.")
  20                                             (symbol-name name)) (symbol-package name))))
  21     `(progn (defpackage ,new-package-name
  22               (:use :cl :lutilities :luciffi :cl-w32api.module :cl-w32api.utils))
  23             (eval-when (:load-toplevel :execute)
  24               (let ((new-package (find-package ',new-package-name)))
  25                 ,@(loop for module-name in module-names
  26                        collecting `(setf (gethash ,module-name *w32api-modules*)
  27                                          new-package))))
  28             )))
  29
  30 (defmacro-exported w32api-sync-exported-names ()
  31   `(eval-when (:load-toplevel :execute)
  32      (let ((w32api-package (find-package 'w32api)))
  33        (when w32api-package
  34          (do-external-symbols (s (find-package *package*))
  35            (import s w32api-package)
  36            (export s w32api-package))))))
  37
  38 (defun-exported load-module-from-file (filename)
  39   (let ((path-of-this-file *w32api-module-path*)
  40         (filename-string (format nil "~a" filename)))
  41     (load (make-pathname :directory (append (pathname-directory path-of-this-file)
  42                                        (list "modules"))
  43                           :name filename-string :defaults path-of-this-file))))
  44
  45 (defun-exported load-all-modules ()
  46   (let* ((path-of-this-file *w32api-module-path*)
  47          (filelist (directory
  48                     (make-pathname :directory
  49                                    (append (pathname-directory path-of-this-file)
  50                                            (list "modules"))
  51                                    :name "*"
  52                                    :defaults path-of-this-file))))
  53     (dolist (filespec filelist t)
  54       (load-module-from-file (pathname-name filespec))
  55     )))
  56
  57
  58 (defmacro-exported define-w32api-module-ctor (params &body code)
  59   (let* ((module-package-name (package-name *package*))
  60          (module-constructor (intern module-package-name *package*)))
  61     `(defun ,module-constructor ,params
  62        ,@code)))
  63
  64 (defun enable-module-by-package (module-package)
  65   (assert module-package)
  66   (let* ((module-package-name (package-name module-package))
  67          (module-constructor (intern module-package-name module-package)))
  68     (when (fboundp module-constructor)
  69       (funcall module-constructor))
  70     (let ((*package* module-package))
  71       (w32api-sync-exported-names))
  72     t
  73     ))
  74
  75 (defun-exported enable-module (module)
  76   (let ((module-package (gethash module *w32api-modules*)))
  77     (when module-package
  78       (enable-module-by-package module-package))))
  79
  80 (defun-exported enable-all-modules (&optional (load-first nil))
  81   (when load-first (load-all-modules))
  82   (dolist (module-package (remove-duplicates
  83                            (loop for module-package being the hash-values
  84                               in *w32api-modules*
  85                               collecting module-package)) t)
  86     (enable-module-by-package module-package)))
  87
  88 (defun-exported finish-loading-modules ()
  89   (fmakunbound 'load-module-from-file)
  90   (fmakunbound 'load-all-modules)
  91   )