(defpackage "ATK"
- (:use "GLIB" "COMMON-LISP" "AUTOEXPORT")
- (:shadowing-import-from "PCL"
- "CLASS-NAME" "CLASS-OF" "FIND-CLASS"))
+ (:use "GLIB" "COMMON-LISP" "AUTOEXPORT"))
(defpackage "GDK"
(:use "GLIB" "COMMON-LISP" "AUTOEXPORT")
- (:shadowing-import-from "PCL"
- "CLASS-NAME" "CLASS-OF" "FIND-CLASS")
(:shadow "ATOM"))
;; License along with this library; if not, write to the Free Software
;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-;; $Id: gdktypes.lisp,v 1.11 2005/01/30 15:08:03 espen Exp $
+;; $Id: gdktypes.lisp,v 1.12 2005/02/03 23:09:07 espen Exp $
(in-package "GDK")
(:alien-name "GdkRectangle"))
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (define-types-by-introspection "Gdk"
- ("GdkFunction" :type gc-function)
- ("GdkWMDecoration" :type wm-decoration)
- ("GdkWMFunction" :type wm-function)
- ("GdkGC" :type gc)
- ("GdkGCX11" :type gc-x11)
- ("GdkGCValuesMask" :type gc-values-mask)
- ("GdkDrawableImplX11" :ignore t)
- ("GdkWindowImplX11" :ignore t)
- ("GdkPixmapImplX11" :ignore t)
- ("GdkGCX11" :ignore t)
- ("GdkColor" :ignore t)
- ("GdkEvent" :ignore t)
- ("GdkRectngle" :ignore t)
- ("GdkFont" :ignore t) ; deprecated
-
- ("GdkDrawable"
- :slots
- ((display
- :allocation :virtual
- :getter "gdk_drawable_get_display"
- :reader drawable-display
- :type display)
- (screen
- :allocation :virtual
- :getter "gdk_drawable_get_screen"
- :reader drawable-screen
- :type screen)
- (visual
- :allocation :virtual
- :getter "gdk_drawable_get_visual"
- :reader drawable-visual
- :type visual)
- (colormap
- :allocation :virtual
- :getter "gdk_drawable_get_colormap"
- :setter "gdk_drawable_set_colormap"
- :unbound nil
- :accessor drawable-colormap
- :initarg :colormap
- :type colormap)
- (depth
- :allocation :virtual
- :getter "gdk_drawable_get_depth"
- :reader drawable-depth
- :type int)
- (with
- :allocation :virtual
- :getter drawable-width)
- (height
- :allocation :virtual
- :getter drawable-height)))
-
- ("GdkWindow"
- :slots
- ((state
- :allocation :virtual
- :getter "gdk_window_get_state"
- :reader window-state
- :type window-state)
- (parent
- :allocation :virtual
- :getter "gdk_window_get_parent"
- :reader window-parent
- :type window)
- (toplevel
- :allocation :virtual
- :getter "gdk_window_get_toplevel"
- :reader window-toplevel
- :type window)
- (children
- :allocation :virtual
- :getter "gdk_window_get_children"
- :reader window-children
- :type (glist window))
- (events
- :allocation :virtual
- :getter "gdk_window_get_events"
- :setter "gdk_window_set_events"
- :accessor window-events
- :type event-mask)
- (group
- :allocation :virtual
- :getter "gdk_window_get_group"
- :setter "gdk_window_set_group"
- :unbound nil
- :accessor window-group
- :type window)
-
- ))
-))
+(define-types-by-introspection "Gdk"
+ ("GdkFunction" :type gc-function)
+ ("GdkWMDecoration" :type wm-decoration)
+ ("GdkWMFunction" :type wm-function)
+ ("GdkGC" :type gc)
+ ("GdkGCX11" :type gc-x11)
+ ("GdkGCValuesMask" :type gc-values-mask)
+ ("GdkDrawableImplX11" :ignore t)
+ ("GdkWindowImplX11" :ignore t)
+ ("GdkPixmapImplX11" :ignore t)
+ ("GdkGCX11" :ignore t)
+ ("GdkColor" :ignore t)
+ ("GdkEvent" :ignore t)
+ ("GdkRectngle" :ignore t)
+ ("GdkCursor" :ignore t)
+ ("GdkFont" :ignore t) ; deprecated
+
+ ("GdkDrawable"
+ :slots
+ ((display
+ :allocation :virtual
+ :getter "gdk_drawable_get_display"
+ :reader drawable-display
+ :type display)
+ (screen
+ :allocation :virtual
+ :getter "gdk_drawable_get_screen"
+ :reader drawable-screen
+ :type screen)
+ (visual
+ :allocation :virtual
+ :getter "gdk_drawable_get_visual"
+ :reader drawable-visual
+ :type visual)
+ (colormap
+ :allocation :virtual
+ :getter "gdk_drawable_get_colormap"
+ :setter "gdk_drawable_set_colormap"
+ :unbound nil
+ :accessor drawable-colormap
+ :initarg :colormap
+ :type colormap)
+ (depth
+ :allocation :virtual
+ :getter "gdk_drawable_get_depth"
+ :reader drawable-depth
+ :type int)
+ (with
+ :allocation :virtual
+ :getter drawable-width)
+ (height
+ :allocation :virtual
+ :getter drawable-height)))
+
+ ("GdkWindow"
+ :slots
+ ((state
+ :allocation :virtual
+ :getter "gdk_window_get_state"
+ :reader window-state
+ :type window-state)
+ (parent
+ :allocation :virtual
+ :getter "gdk_window_get_parent"
+ :reader window-parent
+ :type window)
+ (toplevel
+ :allocation :virtual
+ :getter "gdk_window_get_toplevel"
+ :reader window-toplevel
+ :type window)
+ (children
+ :allocation :virtual
+ :getter "gdk_window_get_children"
+ :reader window-children
+ :type (glist window))
+ (events
+ :allocation :virtual
+ :getter "gdk_window_get_events"
+ :setter "gdk_window_set_events"
+ :accessor window-events
+ :type event-mask)
+ (group
+ :allocation :virtual
+ :getter "gdk_window_get_group"
+ :setter "gdk_window_set_group"
+ :unbound nil
+ :accessor window-group
+ :type window))))
(deftype bitmap () 'pixmap)
-(defclass cursor (struct)
+(defclass cursor (boxed)
((type
:allocation :alien
:reader cursor-type
:getter "gdk_cursor_get_display"
:reader cursor-display
:type display))
- (:metaclass struct-class))
+ (:metaclass boxed-class)
+ (:alien-name "GdkColor"))
-(defclass device (struct)
- ()
- (:metaclass struct-class))
(defclass geometry (struct)
((min-width
;; License along with this library; if not, write to the Free Software
;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-;; $Id: defpackage.lisp,v 1.4 2004/12/29 21:06:22 espen Exp $
+;; $Id: defpackage.lisp,v 1.5 2005/02/03 23:09:03 espen Exp $
;(export 'kernel::type-expand-1 "KERNEL")
(defpackage "GLIB"
- (:use "ALIEN" "SYSTEM" "COMMON-LISP" "PCL" "AUTOEXPORT")
- (:import-from "PCL"
+ (:use "COMMON-LISP""AUTOEXPORT")
+ #+cmu(:use "SYSTEM" "KERNEL" "PCL" "EXT")
+ #+sbcl(:use "SB-SYS" "SB-KERNEL" "SB-PCL" "SB-EXT")
+ #+cmu(:shadowing-import-from "PCL"
+ "CLASS-DIRECT-SUPERCLASSES" "CLASS-DIRECT-SUPERCLASSES")
+ (:shadow "POINTER")
+ (:import-from #+cmu"PCL" #+sbcl"SB-PCL"
"LOCATION" "ALLOCATION" "DIRECT-SLOTS"
"READER-FUNCTION" "WRITER-FUNCTION" "BOUNDP-FUNCTION"
"INITIALIZE-INTERNAL-SLOT-FUNCTIONS" "COMPUTE-SLOT-ACCESSOR-INFO"
"COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS"
"INITIALIZE-INTERNAL-SLOT-GFS")
+ #+sbcl(:import-from "SB-EXT" "COLLECT")
+ #+cmu(:import-from "ALIEN" "CALLBACK")
+ (:import-from #+cmu"ALIEN" #+sbcl"SB-ALIEN"
+ "WITH-ALIEN" "ALIEN-FUNCALL" "%HEAP-ALIEN" "MAKE-HEAP-ALIEN-INFO"
+ "ADDR" "PARSE-ALIEN-TYPE" "SYSTEM-AREA-POINTER" "EXTERN-ALIEN")
+ (:import-from #+cmu"C-CALL" #+sbcl"SB-ALIEN" "%NATURALIZE-C-STRING" "VOID")
(:export "DEFTYPE-METHOD" "TRANSLATE-TYPE-SPEC" "TRANSLATE-TO-ALIEN"
"TRANSLATE-FROM-ALIEN" "CLEANUP-ALIEN" "UNREFERENCE-ALIEN"
"SIZE-OF" "UNBOUND-VALUE")
(:export "DEFBINDING" "DEFINE-FOREIGN" "MKBINDING" "USE-PREFIX"
- "PACKAGE-PREFIX" "DEFCALLBACK")
+ "PACKAGE-PREFIX" "DEFCALLBACK" "CALLBACK")
(:export "LONG" "UNSIGNED-LONG" "INT" "UNSIGNED-INT" "SHORT" "UNSIGNED-SHORT"
- "SIGNED" "UNSIGNED" "CHAR" "POINTER")
- (:export "INTERN-ARGUMENT-TRANSLATOR" "INTERN-RETURN-VALUE-TRANSLATOR"
- "INTERN-CLEANUP-FUNCTION" "INTERN-WRITER-FUNCTION"
- "INTERN-READER-FUNCTION" "INTERN-DESTROY-FUNCTION"))
+ "SIGNED" "UNSIGNED" "CHAR" "POINTER" "COPY-OF")
+ (:export "LOCATION" "ALLOCATION" "DIRECT-SLOTS" "READER-FUNCTION"
+ "WRITER-FUNCTION" "BOUNDP-FUNCTION"
+ "INITIALIZE-INTERNAL-SLOT-FUNCTIONS"
+ "COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS"))
;; License along with this library; if not, write to the Free Software
;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-;; $Id: ffi.lisp,v 1.12 2005/01/03 16:35:05 espen Exp $
+;; $Id: ffi.lisp,v 1.13 2005/02/03 23:09:03 espen Exp $
(in-package "GLIB")
c-name lisp-name (or supplied-lambda-list (nreverse lambda-list))
return-type (reverse docs) (reverse args)))))
-#+cmu
+#+(or cmu sbcl)
(defun %defbinding (foreign-name lisp-name lambda-list return-type docs args)
- (ext:collect ((alien-types) (alien-bindings) (alien-parameters)
- (return-values) (cleanup-forms))
+ (collect ((alien-types) (alien-bindings) (alien-parameters)
+ (return-values) (cleanup-forms))
(dolist (arg args)
(destructuring-bind (var expr type style) arg
(let ((declaration (alien-type type))
(alien-funcall `(alien-funcall ,alien-name ,@(alien-parameters))))
`(defun ,lisp-name ,lambda-list
,@docs
- (declare (optimize (ext:inhibit-warnings 3)))
+ #+cmu(declare (optimize (inhibit-warnings 3)))
+ #+sbcl(declare (muffle-conditions compiler-note))
(with-alien ((,alien-name
(function
,(alien-type return-type)
;;; Creates bindings at runtime
(defun mkbinding (name return-type &rest arg-types)
- (declare (optimize (ext:inhibit-warnings 3)))
+ #+cmu(declare (optimize (inhibit-warnings 3)))
+ #+sbcl(declare (muffle-conditions compiler-note))
(let* ((ftype
`(function ,@(mapcar #'alien-type (cons return-type arg-types))))
(alien
- (alien::%heap-alien
- (alien::make-heap-alien-info
- :type (alien::parse-alien-type ftype)
- :sap-form (system:foreign-symbol-address name :flavor :code))))
+ (%heap-alien
+ (make-heap-alien-info
+ :type (parse-alien-type ftype #+sbcl nil)
+ :sap-form (foreign-symbol-address name))))
(translate-arguments (mapcar #'to-alien-function arg-types))
(translate-return-value (from-alien-function return-type))
(cleanup-arguments (mapcar #'cleanup-function arg-types)))
(map-into args #'funcall translate-arguments args)
(prog1
(funcall translate-return-value
- (apply #'alien:alien-funcall alien args))
+ (apply #'alien-funcall alien args))
(mapc #'funcall cleanup-arguments args)))))
(defmacro defcallback (name (return-type &rest args) &body body)
- `(def-callback ,name
- (,(alien-type return-type)
- ,@(mapcar #'(lambda (arg)
- (destructuring-bind (name type) arg
- `(,name ,(alien-type type))))
- args))
- ,(to-alien-form
- `(let (,@(mapcar #'(lambda (arg)
- (destructuring-bind (name type) arg
- `(,name ,(from-alien-form name type))))
- args))
- ,@body)
- return-type)))
-
+ (let ((def-callback #+cmu'alien:def-callback
+ #+sbcl'sb-alien:define-alien-function))
+ `(,def-callback ,name
+ (,(alien-type return-type)
+ ,@(mapcar #'(lambda (arg)
+ (destructuring-bind (name type) arg
+ `(,name ,(alien-type type))))
+ args))
+ ,(to-alien-form
+ `(let (,@(mapcar #'(lambda (arg)
+ (destructuring-bind (name type) arg
+ `(,name ,(from-alien-form name type))))
+ args))
+ ,@body)
+ return-type))))
+
+#+sbcl
+(defun callback (af)
+ (sb-alien:alien-function-sap af))
;;;; Definitons and translations of fundamental types
(declare (ignore type))
(destructuring-bind (&optional (size '*)) args
(ecase size
- (#.+bits-of-byte+ '(signed-byte 8))
- (#.+bits-of-short+ 'c-call:short)
- ((* #.+bits-of-int+) 'c-call:int)
- (#.+bits-of-long+ 'c-call:long))))
+ (#.+bits-of-byte+ #+cmu'(alien:signed 8) #+sbcl'(sb-alien:signed 8))
+ (#.+bits-of-short+ #+cmu 'c-call:short #+sbcl 'sb-alien:short)
+ ((* #.+bits-of-int+) #+cmu 'c-call:int #+sbcl 'sb-alien:int)
+ (#.+bits-of-long+ #+cmu 'c-call:long #+sbcl 'sb-alien:long))))
(defmethod size-of ((type (eql 'signed-byte)) &rest args)
(declare (ignore type))
(defmethod alien-type ((type (eql 'unsigned-byte)) &rest args)
(destructuring-bind (&optional (size '*)) args
(ecase size
- (#.+bits-of-byte+ '(unsigned #|-byte|# 8))
- (#.+bits-of-short+ 'c-call:unsigned-short)
- ((* #.+bits-of-int+) 'c-call:unsigned-int)
- (#.+bits-of-long+ 'c-call:unsigned-long))))
+ (#.+bits-of-byte+ #+cmu'(alien:unsigned 8) #+sbcl'(sb-alien:unsigned 8))
+ (#.+bits-of-short+ #+cmu 'c-call:unsigned-short
+ #+sbcl 'sb-alien:unsigned-short)
+ ((* #.+bits-of-int+) #+cmu 'c-call:unsigned-int
+ #+sbcl 'sb-alien:unsigned-int)
+ (#.+bits-of-long+ #+cmu 'c-call:unsigned-long
+ #+sbcl 'sb-alien:unsigned-long))))
(defmethod size-of ((type (eql 'unsigned-byte)) &rest args)
(apply #'size-of 'signed args))
(defmethod alien-type ((type (eql 'single-float)) &rest args)
(declare (ignore type args))
- 'alien:single-float)
+ #+cmu 'alien:single-float #+sbcl 'sb-alien:single-float)
(defmethod size-of ((type (eql 'single-float)) &rest args)
(declare (ignore type args))
(defmethod alien-type ((type (eql 'double-float)) &rest args)
(declare (ignore type args))
- 'alien:double-float)
+ #+cmu 'alien:double-float #+sbcl 'sb-alien:double-float)
(defmethod size-of ((type (eql 'double-float)) &rest args)
(declare (ignore type args))
(defmethod alien-type ((type (eql 'base-char)) &rest args)
(declare (ignore type args))
- 'c-call:char)
+ #+cmu 'c-call:char #+sbcl 'sb-alien:char)
(defmethod size-of ((type (eql 'base-char)) &rest args)
(declare (ignore type args))
`(let ((string ,string))
;; Always copy strings to prevent seg fault due to GC
(copy-memory
- (make-pointer (1+ (kernel:get-lisp-obj-address string)))
+ (vector-sap (coerce string 'simple-base-string))
(1+ (length string)))))
(defmethod to-alien-function ((type (eql 'string)) &rest args)
(declare (ignore type args))
#'(lambda (string)
(copy-memory
- (make-pointer (1+ (kernel:get-lisp-obj-address string)))
+ (vector-sap (coerce string 'simple-base-string))
(1+ (length string)))))
(defmethod from-alien-form (string (type (eql 'string)) &rest args)
`(let ((string ,string))
(unless (null-pointer-p string)
(prog1
- (c-call::%naturalize-c-string string)
+ (%naturalize-c-string string)
(deallocate-memory string)))))
(defmethod from-alien-function ((type (eql 'string)) &rest args)
#'(lambda (string)
(unless (null-pointer-p string)
(prog1
- (c-call::%naturalize-c-string string)
+ (%naturalize-c-string string)
(deallocate-memory string)))))
(defmethod cleanup-form (string (type (eql 'string)) &rest args)
(declare (ignore type args))
`(let ((string ,string))
(unless (null-pointer-p string)
- (c-call::%naturalize-c-string string))))
+ (%naturalize-c-string string))))
+
(defmethod copy-from-alien-function ((type (eql 'string)) &rest args)
(declare (ignore type args))
#'(lambda (string)
(unless (null-pointer-p string)
- (c-call::%naturalize-c-string string))))
+ (%naturalize-c-string string))))
(defmethod writer-function ((type (eql 'string)) &rest args)
(declare (ignore type args))
(assert (null-pointer-p (sap-ref-sap location offset)))
(setf (sap-ref-sap location offset)
(copy-memory
- (make-pointer (1+ (kernel:get-lisp-obj-address string)))
+ (vector-sap (coerce string 'simple-base-string))
(1+ (length string))))))
(defmethod reader-function ((type (eql 'string)) &rest args)
(declare (ignore type args))
#'(lambda (location &optional (offset 0))
(unless (null-pointer-p (sap-ref-sap location offset))
- (c-call::%naturalize-c-string (sap-ref-sap location offset)))))
+ (%naturalize-c-string (sap-ref-sap location offset)))))
(defmethod destroy-function ((type (eql 'string)) &rest args)
(declare (ignore type args))
(defmethod alien-type ((type (eql 'nil)) &rest args)
(declare (ignore type args))
- 'c-call:void)
+ 'void)
(defmethod from-alien-function ((type (eql 'nil)) &rest args)
(declare (ignore type args))
(defmethod writer-function ((type (eql 'copy-of)) &rest args)
(declare (ignore type))
(writer-function (first args)))
-
-(export 'copy-of)
;; License along with this library; if not, write to the Free Software
;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-;; $Id: gcallback.lisp,v 1.18 2005/01/30 14:23:20 espen Exp $
+;; $Id: gcallback.lisp,v 1.19 2005/02/03 23:09:04 espen Exp $
(in-package "GLIB")
(check-type function (or null symbol function))
(register-user-data function))
-(defcallback %destroy-user-data (nil (id unsigned-int))
- (destroy-user-data id))
-
;; Callback marshal for regular signal handlers
(defcallback closure-marshal (nil
(gclosure pointer)
(interval unsigned-int)
((callback source-callback-marshal) pointer)
((register-callback-function function) unsigned-long)
- ((callback %destroy-user-data) pointer))
+ ((callback user-data-destroy-func) pointer))
(defun timeout-remove (timeout)
(source-remove timeout))
(priority int)
((callback source-callback-marshal) pointer)
((register-callback-function function) unsigned-long)
- ((callback %destroy-user-data) pointer))
+ ((callback user-data-destroy-func) pointer))
(defun idle-remove (idle)
(source-remove idle))
(detail quark)
((callback signal-emission-hook) pointer)
((register-callback-function function) unsigned-int)
- ((callback %destroy-user-data) pointer))
+ ((callback user-data-destroy-func) pointer))
(defbinding signal-remove-emission-hook (type signal hook-id) nil
((ensure-signal-id-from-type signal type) unsigned-int)
(instance ginstance)
((ensure-signal-id signal-id instance) unsigned-int)
((or detail 0) quark)
- (may-be-blocked boolean))
+ (blocked boolean))
(defbinding %signal-connect-closure-by-id () unsigned-int
(instance ginstance)
(values
(callback-closure-new
callback-id (callback closure-marshal)
- (callback %destroy-user-data))
+ (callback user-data-destroy-func))
callback-id)))
(defmethod create-callback-function ((gobject gobject) function arg1)
(apply #'signal-emit-with-detail object signal 0 args))
-
;;; Message logging
-;; TODO: define and signal conditions based on log-level
+TODO: define and signal conditions based on log-level
-(def-callback log-handler (c-call:void (domain c-call:c-string)
- (log-level c-call:int)
- (message c-call:c-string))
+(defcallback log-handler (nil (domain (copy-of string))
+ (log-level int)
+ (message (copy-of string)))
(error "~A: ~A" domain message))
(setf (extern-alien "log_handler" system-area-pointer) (callback log-handler))
;; License along with this library; if not, write to the Free Software
;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-;; $Id: ginterface.lisp,v 1.6 2005/02/01 15:24:52 espen Exp $
+;; $Id: ginterface.lisp,v 1.7 2005/02/03 23:09:04 espen Exp $
(in-package "GLIB")
(call-next-method))
-(defmethod validate-superclass
- ((class ginterface-class) (super pcl::standard-class))
+(defmethod validate-superclass ((class ginterface-class) (super standard-class))
(subtypep (class-name super) 'ginterface))
(defpackage "GLIB-SYSTEM"
(:use "COMMON-LISP" "ASDF" "PKG-CONFIG"))
-(ext:unlock-all-packages)
+#+cmu(ext:unlock-all-packages)
+#+sbcl
+(progn
+ (sb-ext:unlock-package "COMMON-LISP")
+ (sb-ext:unlock-package "SB-PCL"))
;;; Better put this in ~/.cmucl-init.lisp or some other file read at startup
;; (setf
(defsystem glib
:depends-on (clg-tools)
:components ((:file "defpackage")
- (:file "pcl")
- ;; It is necessary to load this before libglib-2.0.so,
- ;; otherwise our implementation of g_logv won't be
- ;; used by the library
- (:unix-dso "alien"
- :components ((:c-source-file "callback"
- :definitions ("CMUCL")
- :include-paths (#.*cmucl-include-path*)
- :cflags #.(pkg-cflags "glib-2.0"))
- (:c-source-file "gobject"
- :cflags #.(pkg-cflags "glib-2.0"))))
+ #+cmu(:file "pcl")
(:library "libglib-2.0"
- :libdir #.(pkg-variable "glib-2.0" "libdir")
- :depends-on ("alien"))
+ :libdir #.(pkg-variable "glib-2.0" "libdir"))
(:library "libgobject-2.0"
:libdir #.(pkg-variable "glib-2.0" "libdir")
:depends-on ("libglib-2.0"))
+ (:unix-dso "alien"
+ :components ((:c-source-file "callback"
+ :cflags #.(pkg-cflags "glib-2.0"))
+ (:c-source-file "gobject"
+ :cflags #.(pkg-cflags "glib-2.0")))
+ :depends-on ("libgobject-2.0"))
(:file "utils" :depends-on ("defpackage"))
(:file "ffi" :depends-on ("utils"))
(:file "glib" :depends-on ("ffi" "libglib-2.0"))
- (:file "proxy" :depends-on ("pcl" "glib"))
- (:file "gtype" :depends-on ("proxy" "libgobject-2.0"))
+ (:file "proxy" :depends-on (#+cmu"pcl" "glib"))
+ (:file "gtype" :depends-on ("proxy" "alien" "libgobject-2.0"))
(:file "gboxed" :depends-on ("gtype"))
(:file "genums" :depends-on ("gtype"))
(:file "gparam" :depends-on ("genums"))
;; License along with this library; if not, write to the Free Software
;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-;; $Id: glib.lisp,v 1.24 2005/01/30 14:26:41 espen Exp $
+;; $Id: glib.lisp,v 1.25 2005/02/03 23:09:04 espen Exp $
(in-package "GLIB")
;; (declare (ignore address)))
(defun copy-memory (from length &optional (to (allocate-memory length)))
- (kernel:system-area-copy from 0 to 0 (* 8 length))
+ (;#+cmu kernel:system-area-copy
+ ;#+sbcl sb-impl::system-area-copy
+ system-area-copy from 0 to 0 (* 8 length))
to)
(destructuring-bind (element-type) args
`(map-glist 'list #'identity ,gslist ',element-type)))
-(defmethod from-alien-function ((type (eql 'gslist)) &rest args)
+(defmethod copy-from-alien-function ((type (eql 'gslist)) &rest args)
(declare (ignore type))
(destructuring-bind (element-type) args
#'(lambda (gslist)
;; License along with this library; if not, write to the Free Software
;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-;; $Id: gobject.lisp,v 1.30 2005/02/01 15:24:52 espen Exp $
+;; $Id: gobject.lisp,v 1.31 2005/02/03 23:09:04 espen Exp $
(in-package "GLIB")
(defclass gobject-class (ginstance-class)
())
- (defmethod validate-superclass ((class gobject-class)
- (super pcl::standard-class))
+ (defmethod validate-superclass ((class gobject-class) (super standard-class))
; (subtypep (class-name super) 'gobject)
t))
(when (and (not (slot-boundp slotd 'getter)) (slot-readable-p slotd))
(setf
(slot-value slotd 'getter)
- (let ((reader nil))
+ (let ((reader (reader-function type)))
#'(lambda (object)
- (unless reader
- (setq reader (reader-function type))) ;(type-from-number type-number))))
(let ((gvalue (gvalue-new type-number)))
(%object-get-property object pname gvalue)
(unwind-protect
(when (and (not (slot-boundp slotd 'setter)) (slot-writable-p slotd))
(setf
(slot-value slotd 'setter)
- (let ((writer nil))
+ (let ((writer (writer-function type)))
#'(lambda (value object)
- (unless writer
- (setq writer (writer-function type))) ;(type-from-number type-number))))
(let ((gvalue (gvalue-new type-number)))
(funcall writer value gvalue +gvalue-value-offset+)
(%object-set-property object pname gvalue)
(data unsigned-long)
(destroy-marshal pointer))
+(defcallback user-data-destroy-func (nil (id unsigned-int))
+ (destroy-user-data id))
+
+(export 'user-data-destroy-func)
+
(defun (setf user-data) (data object key)
(%object-set-qdata-full object (quark-intern key)
- (register-user-data data) (callback %destroy-user-data))
+ (register-user-data data) (callback user-data-destroy-func))
data)
;; deprecated
;; License along with this library; if not, write to the Free Software
;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-;; $Id: gparam.lisp,v 1.14 2005/01/12 13:31:57 espen Exp $
+;; $Id: gparam.lisp,v 1.15 2005/02/03 23:09:04 espen Exp $
(in-package "GLIB")
(deallocate-memory gvalue)))
(defun gvalue-type (gvalue)
- (type-from-number (system:sap-ref-32 gvalue 0)))
+ (type-from-number (sap-ref-32 gvalue 0)))
(defun gvalue-get (gvalue)
(funcall (reader-function (gvalue-type gvalue))
(defclass param-spec-class (ginstance-class)
())
- (defmethod validate-superclass
- ((class param-spec-class) (super pcl::standard-class))
+ (defmethod validate-superclass ((class param-spec-class) (super standard-class))
t ;(subtypep (class-name super) 'param)
))
;; License along with this library; if not, write to the Free Software
;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-;; $Id: gtype.lisp,v 1.24 2005/02/01 15:24:52 espen Exp $
+;; $Id: gtype.lisp,v 1.25 2005/02/03 23:09:04 espen Exp $
(in-package "GLIB")
(type-from-number type-number)))
(defmethod writer-function ((type (eql 'gtype)) &rest args)
- (declare (ignore type))
+ (declare (ignore type args))
(let ((writer (writer-function 'type-number)))
#'(lambda (gtype location &optional (offset 0))
(funcall writer (find-type-number gtype t) location offset))))
(defmethod reader-function ((type (eql 'gtype)) &rest args)
- (declare (ignore type))
+ (declare (ignore type args))
(let ((reader (reader-function 'type-number)))
#'(lambda (location &optional (offset 0))
(type-from-number (funcall reader location offset)))))
(or
type-number
(and error (error "Type not registered: ~A" type)))))
- (pcl::class (find-type-number (class-name type) error))))
+ (class (find-type-number (class-name type) error))))
(defun type-from-number (type-number &optional error)
(multiple-value-bind (type found)
(mklist init)))
(defun %init-types-in-library (pathname prefix ignore)
- (let ((process (ext:run-program
- "nm" (list "-D" (namestring (truename pathname)))
+ (let ((process (run-program
+ "/usr/bin/nm" (list "--defined-only" "-D" (namestring (truename pathname)))
:output :stream :wait nil))
(fnames ()))
(labels ((read-symbols ()
- (let ((line (read-line (ext:process-output process) nil)))
+ (let ((line (read-line (process-output process) nil)))
(when line
(let ((symbol (subseq line 11)))
(when (and
(push symbol fnames)))
(read-symbols)))))
(read-symbols)
- (ext:process-close process)
+ (process-close process)
`(init-type ',fnames))))
(defmacro init-types-in-library (filename &key (prefix "") ignore)
;; License along with this library; if not, write to the Free Software
;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-;; $Id: proxy.lisp,v 1.18 2005/01/12 13:35:19 espen Exp $
+;; $Id: proxy.lisp,v 1.19 2005/02/03 23:09:04 espen Exp $
(in-package "GLIB")
((setter :reader slot-definition-setter :initarg :setter)
(getter :reader slot-definition-getter :initarg :getter)
(unbound :reader slot-definition-unbound :initarg :unbound)
- (boundp :reader slot-definition-boundp :initarg :boundp)))
+ (boundp :reader slot-definition-boundp :initarg :boundp))))
(defvar *unbound-marker* (gensym "UNBOUND-MARKER-"))
instances)))
(if object
(slot-value object slot)
- default))))
+ default)));)
(defun cache-instance (instance)
(setf
- (gethash (system:sap-int (proxy-location instance)) *instance-cache*)
- (ext:make-weak-pointer instance)))
+ (gethash (sap-int (proxy-location instance)) *instance-cache*)
+ (make-weak-pointer instance)))
(defun find-cached-instance (location)
- (let ((ref (gethash (system:sap-int location) *instance-cache*)))
+ (let ((ref (gethash (sap-int location) *instance-cache*)))
(when ref
- (ext:weak-pointer-value ref))))
+ (weak-pointer-value ref))))
(defun instance-cached-p (location)
- (gethash (system:sap-int location) *instance-cache*))
+ (gethash (sap-int location) *instance-cache*))
(defun remove-cached-instance (location)
- (remhash (system:sap-int location) *instance-cache*))
+ (remhash (sap-int location) *instance-cache*))
;; For debuging
(defun cached-instances ()
(let ((instances ()))
(maphash #'(lambda (location ref)
(declare (ignore location))
- (push (ext:weak-pointer-value ref) instances))
+ (push (weak-pointer-value ref) instances))
*instance-cache*)
instances))
(setf (slot-value instance 'location) location)
(call-next-method))
(cache-instance instance)
- (ext:finalize instance (instance-finalizer instance))
+ (finalize instance (instance-finalizer instance))
instance)
(defmethod instance-finalizer ((instance proxy))
;;;; Metaclass used for subclasses of proxy
+(defgeneric most-specific-proxy-superclass (class))
+(defgeneric direct-proxy-superclass (class))
+
+
(eval-when (:compile-toplevel :load-toplevel :execute)
(defclass proxy-class (virtual-slots-class)
((size :reader proxy-instance-size)))
(defclass effective-alien-slot-definition (effective-virtual-slot-definition)
((offset :reader slot-definition-offset :initarg :offset)))
-
(defmethod most-specific-proxy-superclass ((class proxy-class))
(find-if
#'(lambda (class)
(subtypep (class-name class) 'proxy))
(cdr (compute-class-precedence-list class))))
-
+
(defmethod direct-proxy-superclass ((class proxy-class))
(find-if
#'(lambda (class)
`(reference-foreign ',(class-name class) (proxy-location ,instance)))
(defmethod copy-to-alien-function ((class proxy-class) &rest args)
- (declare (ignore class args))
+ (declare (ignore args))
#'(lambda (instance)
(reference-foreign class (proxy-location instance))))
;; License along with this library; if not, write to the Free Software
;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-;; $Id: utils.lisp,v 1.2 2004/12/05 16:59:58 espen Exp $
+;; $Id: utils.lisp,v 1.3 2005/02/03 23:09:05 espen Exp $
(in-package "GLIB")
(defun type-expand-1 (form)
(let ((def (cond ((symbolp form)
- (kernel::info type expander form))
+ #+cmu(kernel::info type expander form)
+ #+sbcl(sb-impl::info :type :expander form))
((and (consp form) (symbolp (car form)))
- (kernel::info type expander (car form)))
+ #+cmu(kernel::info type expander (car form))
+ #+sbcl(sb-impl::info :type :expander (car form)))
(t nil))))
(if def
(values (funcall def (if (consp form) form (list form))) t)
(defmacro with-gc-disabled (&body body)
(let ((gc-inhibit (make-symbol "GC-INHIBIT")))
`(progn
- (let ((,gc-inhibit lisp::*gc-inhibit*))
- (ext:gc-off)
+ (let ((,gc-inhibit #+cmu lisp::*gc-inhibit*
+ #+sbcl sb-impl::*gc-inhibit*))
+ (gc-off)
(unwind-protect
,@body
(unless ,gc-inhibit
- (ext:gc-on)))))))
+ (gc-on)))))))
(defun mklist (obj)
(if (and obj (atom obj)) (list obj) obj))
(defun split-string (string delimiter)
(declare (simple-string string) (character delimiter))
- (check-type string string)
- (check-type delimiter character)
(let ((pos (position delimiter string)))
(if (not pos)
(list string)
(defun split-string-if (string predicate)
(declare (simple-string string))
- (check-type string string)
- (check-type predicate (or symbol function))
(let ((pos (position-if predicate string :start 1)))
(if (not pos)
(list string)
(defpackage "GTK"
- (:use "GLIB" "COMMON-LISP" "PCL" "ALIEN" "AUTOEXPORT")
+ (:use "GLIB" "COMMON-LISP" "AUTOEXPORT")
+ #+cmu(:use "PCL" "EXT")
+ #+sbcl(:use "SB-PCL" "SB-EXT")
(:shadowing-import-from "GLIB" "DEFTYPE")
- (:import-from "PCL"
- "LOCATION" "ALLOCATION" "DIRECT-SLOTS"
- "READER-FUNCTION" "WRITER-FUNCTION" "BOUNDP-FUNCTION"
- "INITIALIZE-INTERNAL-SLOT-FUNCTIONS"
- "COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS")
+ (:import-from #+cmu"PCL" #+sbcl"SB-PCL"
+ "ADD-READER-METHOD" "ADD-WRITER-METHOD")
+ (:import-from #+cmu"SYSTEM" #+sbcl"SB-SYS" "SAP-INT" "ADD-FD-HANDLER")
+ (:import-from #+cmu"LISP" #+sbcl"SB-IMPL"
+ "*PERIODIC-POLLING-FUNCTION*" "*MAX-EVENT-TO-SEC*"
+ "*MAX-EVENT-TO-USEC*")
(:export "*CLG-VERSION*")
(:export "OBJECT" "OBJECT-ARG" "OBJECT-SINK")
(:export "REGISTER-USER-DATA" "FIND-USER-DATA" "REGISTER-CALLBACK-FUNCTION"
(:export "SIGNAL-EMIT-STOP" "SIGNAL-CONNECT" "SIGNAL-DISCONNECT"
"SIGNAL-HANDLER-BLOCK" "SIGNAL-HANDLER-UNBLOCK")
(:export "OBJECT-CLASS" "WIDGET-CLASS" "CONTAINER-CLASS" "CHILD-CLASS"))
-
\ No newline at end of file
;; License along with this library; if not, write to the Free Software
;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-;; $Id: gtk.lisp,v 1.31 2005/01/13 00:17:55 espen Exp $
+;; $Id: gtk.lisp,v 1.32 2005/02/03 23:09:07 espen Exp $
(in-package "GTK")
(gtk-init)
(prog1
(gdk:display-open display)
- (system:add-fd-handler
- (gdk:display-connection-number) :input #'main-iterate-all)
- (setq lisp::*periodic-polling-function* #'main-iterate-all)
- (setq lisp::*max-event-to-sec* 0)
- (setq lisp::*max-event-to-usec* 1000))))
+ (add-fd-handler (gdk:display-connection-number) :input #'main-iterate-all)
+ (setq *periodic-polling-function* #'main-iterate-all)
+ (setq *max-event-to-sec* 0)
+ (setq *max-event-to-usec* 1000))))
;;; Acccel group
(defbinding accel-groups-from-object () (gslist accel-groups)
(object gobject))
-(defbinding accelerator-valid-p (key &optional mask) boolean
+(defbinding accelerator-valid-p (key &optional modifiers) boolean
(key unsigned-int)
(modifiers gdk:modifier-type))
(check-menu-item check-menu-item))
-
-;;; Clipboard
-
-
;;; Color selection
(defbinding (color-selection-is-adjusting-p
(completion entry-completion)
((callback %entry-completion-match-func) pointer)
((register-callback-function function) unsigned-int)
- ((callback %destroy-user-data) pointer))
+ ((callback user-data-destroy-func) pointer))
(defbinding entry-completion-complete () nil
(completion entry-completion))
(def-callback-marshal %file-filter-func (boolean file-filter-info))
-(defbinding file-filter-add-custom () nil
+(defbinding file-filter-add-custom (filter needed function) nil
(filter file-filter)
(needed file-filter-flags)
((callback %file-filter-func) pointer)
((register-callback-function function) unsigned-int)
- ((callback %destroy-user-data) pointer))
+ ((callback user-data-destroy-func) pointer))
(defbinding file-filter-get-needed () file-filter-flags
(filter file-filter))
;; License along with this library; if not, write to the Free Software
;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-;; $Id: gtkaction.lisp,v 1.2 2004/12/17 00:13:33 espen Exp $
+;; $Id: gtkaction.lisp,v 1.3 2005/02/03 23:09:09 espen Exp $
(in-package "GTK")
(defmethod initialize-instance ((action radio-action) &key group value)
(call-next-method)
- (setf (slot-value action '%value) (system:sap-int (proxy-location action)))
+ (setf (slot-value action '%value) (sap-int (proxy-location action)))
(setf (object-data action 'radio-action-value) value)
(when group
(radio-action-add-to-group action group)))
;; License along with this library; if not, write to the Free Software
;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-;; $Id: gtkobject.lisp,v 1.22 2005/02/01 15:24:56 espen Exp $
+;; $Id: gtkobject.lisp,v 1.23 2005/02/03 23:09:09 espen Exp $
(in-package "GTK")
(defbinding %object-sink () nil
(object %object))
-;;;; Main loop, timeouts and idle functions
+;;;; Main loop and event handling
(declaim (inline events-pending-p main-iteration))
-(defbinding (events-pending-p "gtk_events_pending") () boolean)
+(defbinding events-pending-p () boolean)
(defbinding get-current-event () gdk:event)
(defun main-iterate-all (&rest args)
(declare (ignore args))
- (when (events-pending-p)
- (main-iteration-do nil)
- (main-iterate-all)))
+ (loop
+ while (events-pending-p)
+ do (main-iteration-do nil)))
;;;; Metaclass for child classes
(call-next-method)))
(progn
- (declaim (optimize (ext:inhibit-warnings 3)))
+ #+cmu(declaim (optimize (inhibit-warnings 3)))
+ #+sbcl(declaim (muffle-conditions compiler-note))
(defun %container-child-get-property (parent child pname gvalue))
(defun %container-child-set-property (parent child pname gvalue)))
(call-next-method)))
-(defmethod pcl::add-reader-method ((class child-class) generic-function slot-name)
+(defmethod add-reader-method ((class child-class) generic-function slot-name)
(add-method
generic-function
(make-instance 'standard-method
(declare (ignore next-methods))
(child-property-value (first args) slot-name)))))
-(defmethod pcl::add-writer-method
+(defmethod add-writer-method
((class child-class) generic-function slot-name)
(add-method
generic-function
(setf (child-property-value widget slot-name) value))))))
-(defmethod validate-superclass ((class child-class) (super pcl::standard-class))
+(defmethod validate-superclass ((class child-class) (super standard-class))
;(subtypep (class-name super) 'container-child)
t)
;; License along with this library; if not, write to the Free Software
;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-;; $Id: gtktext.lisp,v 1.4 2005/01/12 13:36:40 espen Exp $
+;; $Id: gtktext.lisp,v 1.5 2005/02/03 23:09:09 espen Exp $
(in-package "GTK")
(iter text-iter)
((%ensure-tag tag iter) text-tag))
-(def-callback-marshal %text-char-prediacte (boolean int))
+(def-callback-marshal %text-char-predicate (boolean int))
(defbinding text-iter-forward-find-char (iter predicate &optional limit) boolean
(iter text-iter)
- ((callback %text-char-redicate) pointer)
+ ((callback %text-char-predicate) pointer)
((register-callback-function predicate) unsigned-int)
(limit (or null text-iter)))
(defbinding text-iter-backward-find-char (iter predicate &optional limit) boolean
(iter text-iter)
- ((callback %text-char-redicate) pointer)
+ ((callback %text-char-predicate) pointer)
((register-callback-function predicate) unsigned-int)
(limit (or null text-iter)))
;; License along with this library; if not, write to the Free Software
;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-;; $Id: gtktree.lisp,v 1.5 2005/01/06 21:50:11 espen Exp $
+;; $Id: gtktree.lisp,v 1.6 2005/02/03 23:09:09 espen Exp $
(in-package "GTK")
(cell cell-renderer)
((callback %cell-layout-data-func) pointer)
((register-callback-function function) unsigned-int)
- ((callback %destroy-user-data) pointer))
+ ((callback user-data-destroy-func) pointer))
(defbinding cell-layout-clear-attributes () nil
(cell-layout cell-layout)
(iter tree-iter))
(defbinding tree-model-iter-nth-child
- (tree-model parent &optional (iter (make-instance 'tree-iter))) boolean
+ (tree-model parent n &optional (iter (make-instance 'tree-iter))) boolean
(tree-model tree-model)
(iter tree-iter :return)
(parent (or null tree-iter))
(selection tree-selection)
((callback %tree-selection-func) pointer)
((register-callback-function function) unsigned-int)
- ((callback %destroy-user-data) pointer))
+ ((callback user-data-destroy-func) pointer))
(defbinding tree-selection-get-selected
(selection &optional (iter (make-instance 'tree-iter))) boolean
(parent (or null tree-iter))
(sibling (or null tree-iter)))
-(defun tree-store-insert-after
+(defun tree-store-insert-before
(store parent sibling &optional data (iter (make-instance 'tree-iter)))
(%tree-store-insert-before store iter parent sibling)
(when data (%tree-model-set store iter data))
(tree-view tree-view)
(tree-view-column tree-view-column))
-(defbinding tree-view-insert-column (view columnd position) int
+(defbinding tree-view-insert-column (view column position) int
(view tree-view)
(column tree-view-column)
((if (eq position :end) -1 position) int))
(defpackage "PANGO"
- (:use "GLIB" "COMMON-LISP" "AUTOEXPORT")
- (:shadowing-import-from "PCL"
- "CLASS-NAME" "CLASS-OF" "FIND-CLASS"))
-
+ (:use "GLIB" "COMMON-LISP" "AUTOEXPORT"))
(defsystem pango
:depends-on (glib)
- :components ((:library "libpango-1.0"
- :libdir #.(pkg-variable "pango" "libdir"))
- (:file "defpackage")
- (:file "pango" :depends-on ("defpackage" "libpango-1.0"))
+ :components ((:library "libpango-1.0" :libdir #.(pkg-variable "pango" "libdir"))
+ (:library "libpangoxft-1.0" :libdir #.(pkg-variable "pango" "libdir")) (:file "defpackage")
+ (:file "pango" :depends-on ("defpackage" "libpango-1.0" "libpangoxft-1.0"))
(:file "export" :depends-on ("pango"))))
;; License along with this library; if not, write to the Free Software
;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-;; $Id: pango.lisp,v 1.6 2004/11/06 21:39:58 espen Exp $
+;; $Id: pango.lisp,v 1.7 2005/02/03 23:09:06 espen Exp $
(in-package "PANGO")
(eval-when (:compile-toplevel :load-toplevel :execute)
- (init-types-in-library
- #.(concatenate 'string (pkg-config:pkg-variable "atk" "libdir")
- "/libpango-1.0.so")
- :prefix "pango_" :ignore ("_pango_fribidi_get_type")))
+ (init-types-in-library #.(concatenate 'string
+ (pkg-config:pkg-variable "pango" "libdir")
+ "/libpango-1.0.so") :prefix "pango_")
+ (init-types-in-library #.(concatenate 'string
+ (pkg-config:pkg-variable "pango" "libdir")
+ "/libpangoxft-1.0.so") :prefix "pango_xft"))
(define-types-by-introspection "Pango")
(concatenate-strings (rest strings) delimiter))))
;;; The following code is more or less copied frm sb-bsd-sockets.asd,
-;;; but extended to allow flags set in a general way
+;;; but extended to allow flags to be set in a general way
(defclass unix-dso (module) ())
(defun unix-name (pathname)
(module-components dso)))))
(error 'operation-error :operation operation :component dso))))
-;; Taken from foreign.lisp in the CMUCL tree, but modified to delay
-;; resolving of symbols until they are used
-(defun load-dso (file)
- (system::ensure-lisp-table-opened)
- ; rtld global: so it can find all the symbols previously loaded
- ; rtld lazy: that way dlopen will not fail if not all symbols are defined.
- (let ((filename (namestring file)))
- (format t ";;; Loading shared library ~A ...~%" filename)
- (let ((sap (system::dlopen filename (logior system::rtld-lazy system::rtld-global))))
- (cond ((zerop (system:sap-int sap))
- (let ((err-string (system::dlerror)))
-
- ;; For some reason dlerror always seems to return NIL,
- ;; which isn't very informative.
- (error "Can't open object ~S: ~S" file err-string)))
- ((null (assoc sap system::*global-table* :test #'system:sap=))
- (setf system::*global-table* (acons sap file system::*global-table*))
- t)
- (t nil)))))
+
+(defun load-dso (filename)
+ #+sbcl(sb-alien:load-shared-object filename)
+ #+cmu(system::load-object-file filename))
(defmethod perform ((o load-op) (c unix-dso))
(defmethod output-files ((op compile-op) (c c-source-file))
- (list
- (make-pathname :type "o" :defaults
- (component-pathname c))))
+ (list (make-pathname :type "o" :defaults (component-pathname c))))
(defmethod perform ((op compile-op) (c c-source-file))
(defpackage #:pkg-config
- (:use #:common-lisp)
+ (:use #:common-lisp #+cmu #:ext #+sbcl #:sb-ext)
(:export #:pkg-cflags #:pkg-libs #:pkg-exists-p #:pkg-version
#:pkg-variable))
(in-package #:pkg-config)
-(defparameter *pkg-config* "pkg-config")
+(defparameter *pkg-config* "/usr/bin/pkg-config")
(defun split-string (string &key (start 0) (end (length string)))
(let ((position (position #\sp string :start start :end end)))
(defun run-pkg-config (package error &rest options)
(let ((process
- (ext:run-program
+ (run-program
*pkg-config* (cons package options) :wait t :output :stream)))
(unless process
(error "Unable to run ~A" *pkg-config*))
- (let ((exit-code (ext:process-exit-code process)))
+ (let ((exit-code (process-exit-code process)))
(unless (or (not error) (zerop exit-code))
(error
(or
- (read-string (ext:process-error process) nil)
+ (read-string (process-error process) nil)
(format nil "~A terminated with exit code ~A"
*pkg-config* exit-code))))
- (let ((output (read-lines (ext:process-output process))))
- (ext:process-close process)
+ (let ((output (read-lines (process-output process))))
+ (process-close process)
(values output exit-code)))))
~mdw / clg / commitdiff