chiark - git - mdw - clg/blob - tools/config.lisp

   1 (defpackage #:pkg-config
   2   (:use #:common-lisp #:clg-utils #+(or cmu clisp) #:ext #+sbcl #:sb-ext)
   3   #+sbcl
   4   (:import-from #:sb-int #:featurep)
   5   (:export #:pkg-cflags #:pkg-libs #:pkg-exists-p #:pkg-version
   6            #:pkg-variable #:pkg-libdir #:tmpname)
   7   (:export #:featurep #:sbcl>= #:sbcl< #:clisp>=))
   8
   9 (in-package #:pkg-config)
  10
  11 (defparameter *pkg-config* "pkg-config")
  12
  13
  14 (defun tmpname (suffix)
  15   (format nil "~Aclg-~A-~A"
  16    #-win32 "/tmp/" #+win32 "c:/temp/"
  17    #+sbcl(sb-posix:getpid)
  18    #+cmu(unix:unix-getpid)
  19    #+clisp(os:process-id)
  20    suffix))
  21
  22 (defun run-pkg-config (package error-p &rest options)
  23   (let ((outname (tmpname "pkg-config")))
  24     (unwind-protect
  25         (let* ((asdf::*verbose-out* nil)
  26                (exit-code
  27                 (asdf:run-shell-command
  28                  "~A ~A ~:[~;--print-errors ~]~{~A ~} >~A 2>&1"
  29                  *pkg-config* package error-p options outname)))
  30           (cond
  31            ((= exit-code 127) (error "Unable to run ~A" *pkg-config*))
  32            ((and error-p (not (zerop exit-code)))
  33             (with-open-file (output outname)
  34               (let ((errmsg (read-lines output)))
  35                 (error
  36                  (if (not errmsg)
  37                      (format nil "~A terminated with exit code ~A" *pkg-config* exit-code)
  38                    (format nil "~A: ~{~A~%~}" *pkg-config* errmsg))))))
  39            (t
  40             (values
  41              (with-open-file (output outname)
  42                (read-lines output))
  43              exit-code))))
  44       (delete-file outname))))
  45
  46
  47 (defun pkg-cflags (package)
  48   (split-string (first (run-pkg-config package t "--cflags"))))
  49
  50 (defun pkg-libs (package)
  51   (split-string (first (run-pkg-config package t "--libs"))))
  52
  53
  54 ;; With
  55 ;;   (let ((version-check
  56 ;;       (cond
  57 ;;        (version (format nil "= ~A" version))
  58 ;;        (atleast-version (format nil ">= ~A" atleast-version))
  59 ;;        (max-version (format nil "<= ~A" max-version))
  60 ;;        (t ""))))
  61 ;;     ...)
  62 ;; when running
  63 ;;   (PKG-EXISTS-P "glib-2.0" :ATLEAST-VERSION "2.4.0" :ERROR T)
  64 ;; the EXIT-CODE in RUN-PKG-CONFIG will be 1 on ms windows and 0 on linux
  65
  66 ;; Both on ms windows and linux
  67 ;;   "pkg-config glib-2.0 --print-errors -exists >=2.4.0" is O.K. but
  68 ;;   "pkg-config glib-2.0 --print-errors -exists >= 2.4.0" prints out
  69 ;;     an error message.
  70 ;; However,
  71 ;;   "pkg-config glib-2.0 --print-errors -exists =2.12.11" prints out
  72 ;;     an error message but
  73 ;;   "pkg-config glib-2.0 --print-errors -exists = 2.12.11" is O.K.
  74 ;; We can get around this problem by using
  75 ;;   (let ((version-check
  76 ;;       (cond
  77 ;;        (version (format nil "--exact-version=~A" version))
  78 ;;        (atleast-version (format nil "--atleast-version=~A" atleast-version))
  79 ;;        (max-version (format nil "--max-version=~A" max-version))
  80 ;;        (t ""))))
  81 ;;     ...)
  82 ;;  - cph 17-May-2007
  83
  84 ;; Could the problem with --exists on win32 be caused by improper quoting?
  85 ;; Since --exact-version, --atleast-version and --max-version doesn't print
  86 ;; any error message, we stick to --exists on non Win32 platforms.
  87 ;;  - esj 2007-06-14
  88
  89
  90 ;; --fix: in win32 sbcl
  91 ;;        (pkg-exists-p "glib-2.0" :version "3.12.11" :error t)
  92 ;;        will hang indefinitely.   - cph 17-May-2007
  93
  94 (defun pkg-exists-p (package &key version atleast-version max-version error)
  95   (let ((version-check
  96          (cond
  97           (version
  98            #-win32(format nil "--exists \"= ~A\"" version)
  99            #+win32(format nil "--exact-version=~A" version))
 100           (atleast-version
 101            #-win32(format nil "--exists \">= ~A\"" atleast-version)
 102            #+win32(format nil "--atleast-version=~A" atleast-version))
 103           (max-version
 104            #-win32(format nil "--exists \"<= ~A\"" max-version)
 105            #+win32(format nil "--max-version=~A" max-version))
 106           (t ""))))
 107     (zerop (nth-value 1 (run-pkg-config package error version-check)))))
 108
 109 (defun pkg-version (package)
 110   (first (run-pkg-config package t "--modversion")))
 111
 112 (defun pkg-variable (package variable)
 113   (first (run-pkg-config package t "--variable" variable)))
 114
 115 (defun pkg-libdir (package)
 116   #-win32
 117   (pkg-variable package "libdir")
 118   #+win32
 119   (let ((ldir (pkg-variable package "libdir")))
 120     (format nil "~Abin" (subseq ldir 0 (search "lib" ldir :from-end t)))))
 121
 122
 123 (defun |#?-reader| (stream subchar arg)
 124   (declare (ignore subchar arg))
 125   (let ((not-p (when (char= (peek-char nil stream) #\-)
 126                  (read-char stream)))
 127         (conditional (read stream t nil t)))
 128     (cond
 129      (*read-suppress* (read stream t nil t))
 130      ((not *read-eval*)
 131       (error 'reader-error
 132        :format-control "Attempt to read #? while *READ-EVAL* is bound to NIL."
 133        :format-arguments nil :stream stream))
 134      ((if not-p
 135           (eval conditional)
 136         (not (eval conditional)))
 137       (let ((*read-suppress* t))
 138         (read stream t nil t)))))
 139   (values))
 140
 141 (set-dispatch-macro-character #\# #\? #'|#?-reader|)
 142
 143
 144 #+sbcl
 145 (progn
 146   (defun sbcl-version ()
 147     (let* ((dot1 (position #\. (lisp-implementation-version)))
 148            (dot2 (position #\. (lisp-implementation-version) :start (1+ dot1))))
 149       (values
 150        (parse-integer (lisp-implementation-version) :end dot1)
 151        (parse-integer (lisp-implementation-version) :start (1+ dot1) :end dot2)
 152        (if dot2
 153            (parse-integer (lisp-implementation-version) :start (1+ dot2) :junk-allowed t)
 154          0))))
 155   (defun sbcl>= (req-major req-minor req-micro)
 156     (multiple-value-bind (major minor micro) (sbcl-version)
 157       (or
 158        (> major req-major)
 159        (and (= major req-major) (> minor req-minor))
 160        (and (= major req-major) (= minor req-minor) (>= micro req-micro)))))
 161   (defun sbcl< (req-major req-minor req-micro)
 162     (not (sbcl>= req-major req-minor req-micro))))
 163
 164 #-sbcl
 165 (progn
 166   (defun sbcl>= (req-major req-minor req-micro)
 167     (declare (ignore req-major req-minor req-micro))
 168     nil)
 169   (defun sbcl< (req-major req-minor req-micro)
 170     (declare (ignore req-major req-minor req-micro))
 171     nil))
 172
 173 #+clisp
 174 (progn
 175   (defun clisp-version ()
 176     (let* ((dot (position #\. (lisp-implementation-version))))
 177       (values
 178        (parse-integer (lisp-implementation-version) :end dot)
 179        (parse-integer (lisp-implementation-version) :start (1+ dot) :junk-allowed t))))
 180   (defun clisp>= (req-major req-minor)
 181     (multiple-value-bind (major minor) (clisp-version)
 182       (or
 183        (> major req-major)
 184        (and (= major req-major) (> minor req-minor))))))
 185
 186 #-clisp
 187 (defun clisp>= (req-major req-minor)
 188   (declare (ignore req-major req-minor))
 189   nil)