GopherProxy

	tfeatures.lisp - clic - Clic is an command line interactive client for gopher w…
	git clone git://bitreich.org/clic/ git://hg6vgqziawt5s4dj.onion/clic/
	Log
	Files
	Refs
	Tags
	LICENSE
	---
	tfeatures.lisp (3965B)
	---
	1 ;;;; -- Mode: lisp; indent-tabs-mode: nil --
	2 ;;;
	3 ;;; features.lisp --- CFFI-specific features (DEPRECATED).
	4 ;;;
	5 ;;; Copyright (C) 2006-2007, Luis Oliveira <[email protected]>
	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 #:cl-user)
	29
	30 (eval-when (:compile-toplevel :load-toplevel :execute)
	31 (pushnew :cffi features))
	32
	33 ;;; CFFI-SYS backends take care of pushing the appropriate features to
	34 ;;; features. See each cffi-*.lisp file.
	35 ;;;
	36 ;;; Not anymore, I think we should use TRIVIAL-FEATURES for the
	37 ;;; platform features instead. Less pain. CFFI-FEATURES is now
	38 ;;; deprecated and this code will stay here for a while for backwards
	39 ;;; compatibility purposes, to be removed in a future release.
	40
	41 (defpackage #:cffi-features
	42 (:use #:cl)
	43 (:export
	44 #:cffi-feature-p
	45
	46 ;; Features related to the CFFI-SYS backend. Why no-*? This
	47 ;; reflects the hope that these symbols will go away completely
	48 ;; meaning that at some point all lisps will support long-longs,
	49 ;; the foreign-funcall primitive, etc...
	50 #:no-long-long
	51 #:no-foreign-funcall
	52 #:no-stdcall
	53 #:flat-namespace
	54
	55 ;; Only SCL supports long-double...
	56 ;;#:no-long-double
	57
	58 ;; Features related to the operating system.
	59 ;; More should be added.
	60 #:darwin
	61 #:unix
	62 #:windows
	63
	64 ;; Features related to the processor.
	65 ;; More should be added.
	66 #:ppc32
	67 #:x86
	68 #:x86-64
	69 #:sparc
	70 #:sparc64
	71 #:hppa
	72 #:hppa64))
	73
	74 (in-package #:cffi-features)
	75
	76 (defun cffi-feature-p (feature-expression)
	77 "Matches a FEATURE-EXPRESSION against those symbols in FEATURES
	78 that belong to the CFFI-FEATURES package."
	79 (when (eql feature-expression t)
	80 (return-from cffi-feature-p t))
	81 (let ((features-package (find-package '#:cffi-features)))
	82 (flet ((cffi-feature-eq (name feature-symbol)
	83 (and (eq (symbol-package feature-symbol) features-package)
	84 (string= name (symbol-name feature-symbol)))))
	85 (etypecase feature-expression
	86 (symbol
	87 (not (null (member (symbol-name feature-expression) features
	88 :test #'cffi-feature-eq))))
	89 (cons
	90 (ecase (first feature-expression)
	91 (:and (every #'cffi-feature-p (rest feature-expression)))
	92 (:or (some #'cffi-feature-p (rest feature-expression)))
	93 (:not (not (cffi-feature-p (cadr feature-expression))))))))))
	94
	95 ;;; for backwards compatibility
	96 (mapc (lambda (sym) (pushnew sym features))
	97 '(#+darwin darwin
	98 #+unix unix
	99 #+windows windows
	100 #+ppc ppc32
	101 #+x86 x86
	102 #+x86-64 x86-64
	103 #+sparc sparc
	104 #+sparc64 sparc64
	105 #+hppa hppa
	106 #+hppa64 hppa64
	107 #+cffi-sys::no-long-long no-long-long
	108 #+cffi-sys::flat-namespace flat-namespace
	109 #+cffi-sys::no-foreign-funcall no-foreign-funcall
	110 #+cffi-sys::no-stdcall no-stdcall
	111 ))