foreign-vars.lisp - clic - Clic is an command line interactive client for gopher written in Common LISP
 (HTM) git clone git://bitreich.org/clic/ git://enlrupgkhuxnvlhsf6lc3fziv5h2hhfrinws65d7roiv6bfj7d652fid.onion/clic/
 (DIR) Log
 (DIR) Files
 (DIR) Refs
 (DIR) Tags
 (DIR) README
 (DIR) LICENSE
       ---
       foreign-vars.lisp (4066B)
       ---
            1 ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
            2 ;;;
            3 ;;; foreign-vars.lisp --- High-level interface to foreign globals.
            4 ;;;
            5 ;;; Copyright (C) 2005-2008, Luis Oliveira  <loliveira(@)common-lisp.net>
            6 ;;;
            7 ;;; Permission is hereby granted, free of charge, to any person
            8 ;;; obtaining a copy of this software and associated documentation
            9 ;;; files (the "Software"), to deal in the Software without
           10 ;;; restriction, including without limitation the rights to use, copy,
           11 ;;; modify, merge, publish, distribute, sublicense, and/or sell copies
           12 ;;; of the Software, and to permit persons to whom the Software is
           13 ;;; furnished to do so, subject to the following conditions:
           14 ;;;
           15 ;;; The above copyright notice and this permission notice shall be
           16 ;;; included in all copies or substantial portions of the Software.
           17 ;;;
           18 ;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
           19 ;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
           20 ;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
           21 ;;; NONINFRINGEMENT.  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
           22 ;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
           23 ;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
           24 ;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
           25 ;;; DEALINGS IN THE SOFTWARE.
           26 ;;;
           27 
           28 (in-package #:cffi)
           29 
           30 ;;;# Accessing Foreign Globals
           31 
           32 ;;; Called by FOREIGN-OPTIONS in functions.lisp.
           33 (defun parse-defcvar-options (options)
           34   (destructuring-bind (&key (library :default) read-only) options
           35     (list :library library :read-only read-only)))
           36 
           37 (defun get-var-pointer (symbol)
           38   "Return a pointer to the foreign global variable relative to SYMBOL."
           39   (foreign-symbol-pointer (get symbol 'foreign-var-name)
           40                           :library (get symbol 'foreign-var-library)))
           41 
           42 ;;; Note: this will lookup not only variables but also functions.
           43 (defun foreign-symbol-pointer (name &key (library :default))
           44   (check-type name string)
           45   (%foreign-symbol-pointer
           46    name (if (eq library :default)
           47             :default
           48             (foreign-library-handle
           49              (get-foreign-library library)))))
           50 
           51 (defun fs-pointer-or-lose (foreign-name library)
           52   "Like foreign-symbol-ptr but throws an error instead of
           53 returning nil when foreign-name is not found."
           54   (or (foreign-symbol-pointer foreign-name :library library)
           55       (error "Trying to access undefined foreign variable ~S." foreign-name)))
           56 
           57 (defmacro defcvar (name-and-options type &optional documentation)
           58   "Define a foreign global variable."
           59   (multiple-value-bind (lisp-name foreign-name options)
           60       (parse-name-and-options name-and-options t)
           61     (let ((fn (symbolicate '#:%var-accessor- lisp-name))
           62           (read-only (getf options :read-only))
           63           (library (getf options :library)))
           64       ;; We can't really setf an aggregate type.
           65       (when (aggregatep (parse-type type))
           66         (setq read-only t))
           67       `(progn
           68          (setf (documentation ',lisp-name 'variable) ,documentation)
           69          ;; Save foreign-name and library for posterior access by
           70          ;; GET-VAR-POINTER.
           71          (setf (get ',lisp-name 'foreign-var-name) ,foreign-name)
           72          (setf (get ',lisp-name 'foreign-var-library) ',library)
           73          ;; Getter
           74          (defun ,fn ()
           75            (mem-ref (fs-pointer-or-lose ,foreign-name ',library) ',type))
           76          ;; Setter
           77          (defun (setf ,fn) (value)
           78            ,(if read-only '(declare (ignore value)) (values))
           79            ,(if read-only
           80                 `(error ,(format nil
           81                                  "Trying to modify read-only foreign var: ~A."
           82                                  lisp-name))
           83                 `(setf (mem-ref (fs-pointer-or-lose ,foreign-name ',library)
           84                                 ',type)
           85                        value)))
           86          ;; While most Lisps already expand DEFINE-SYMBOL-MACRO to an
           87          ;; EVAL-WHEN form like this, that is not required by the
           88          ;; standard so we do it ourselves.
           89          (eval-when (:compile-toplevel :load-toplevel :execute)
           90            (define-symbol-macro ,lisp-name (,fn)))))))