qt-light/chicken-compile-qt-extension.scm

#!/bin/sh
#|
exec "$CHICKEN_CSI" -s "$0" "$@"
|#

;; chicken-compile-qt-extension.scm

(module main ()

(import scheme
        (chicken base)
        (chicken condition)
        (chicken file)
        (chicken file posix)
        (chicken foreign)
        (chicken format)
        (chicken pathname)
        (chicken platform)
        (chicken process)
        (chicken process-context)
        (chicken string)
        shell
        srfi-1)  

(define setup-verbose-mode (make-parameter #f))
(define run-verbose (make-parameter #f))

(define (quit fstr . args)
  (flush-output)
  (fprintf (current-error-port) "~?~%" fstr args)
  (exit 1))

(define (file-execute-access? p)
  (and (file-exists? p)
       (file-readable? p)
       (file-executable? p)))

(define QTDIR
  (or (get-environment-variable "QTDIR")
      (and (file-execute-access? "/usr/bin/qmake") "/usr")
      (and (file-execute-access? "/usr/local/bin/qmake") "/usr/local")
      (and (file-execute-access? "/opt/local/bin/qmake") "/opt/local")
      (quit "please set the QTDIR environment variable") ) )

(define (chicken-prefix)
  (let ((csc-path (get-environment-variable "CHICKEN_CSC")))
    (let-values (((_ _ dir-elems) (decompose-directory csc-path)))
      (pathname-directory (make-absolute-pathname (drop-right dir-elems 2) "csc")))))

(define prefix (chicken-prefix))
(define libpath (make-pathname prefix "lib"))
(define incpath (make-pathname prefix "include"))
(define cincpath (make-pathname incpath "chicken"))
(define binpath (make-pathname prefix "bin"))
(define csc (make-pathname binpath "csc"))
(define keepfiles #f)
(define qmake (make-pathname QTDIR "bin/qmake"))
(define mingw32 (eq? (build-platform) 'mingw32))
(define macosx (eq? (software-version) 'macosx))
(define outfile #f)

(define install_name_tool
  (and macosx
       "/usr/bin/install_name_tool"))

(define gmake
  (cond ((memq (software-version) '(freebsd netbsd openbsd))
	 "gmake")
	(mingw32 "mingw32-make")
	(else "make")))

(define options-with-arguments
  '("-debug" "-output-file" "-heap-size" "-nursery" "-stack-size" "-compiler"
    "-unit" "-uses" "-keyword-style" "-optimize-level" "-include-path"
    "-database-size" "-extend" "-prelude" "-postlude" "-prologue" "-epilogue"
    "-inline-limit" "-profile-name" "-emit-inline-file"
    "-feature" "-debug-level" "-consult-types-file" "-no-feature"
    "-consult-inline-file" "-emit-import-library" "-module" "-link"
    "-D" "-K" "-X" "-j" "-I" "-o" "-R" "-C" "-L" "-emit-link-file"
    "-unroll-limit" "-types"))

(define (filter-options args)
  (let loop ((args args) (opts '()) (files '()))
    (if (null? args)
	(values (reverse opts) (reverse files))
	(let ((arg (car args))
	      (more (cdr args)))
	  (cond ((string=? "-k" arg) (set! keepfiles #t))
		((string=? "-v" arg)
		 (setup-verbose-mode #t)
		 (run-verbose #t))
		((member arg '("--help" "-h" "-help"))
		 (run (csc -h)))
		((and (string=? "-o" arg) (pair? more))
		 (set! outfile (car more))))
	  (if (and (> (string-length arg) 1)
		   (char=? #\- (string-ref arg 0)))
	      (if (member arg options-with-arguments)
		  (if (null? more)
		      (loop more (cons arg opts) files)
		      (loop (cdr more) (cons* (car more) arg opts) files))
		  (loop more (cons arg opts) files))
	      (loop more opts (cons arg files)))))))

(define (compile-qt-extension cppfiles hfiles)
  (let* ((cppfile (car cppfiles))
	 (pro (pathname-replace-extension cppfile "pro"))
	 (name (pathname-file cppfile))
	 (mkfile (qs (pathname-replace-extension cppfile "make")))
	 (output (or outfile (make-pathname #f name "so"))))
    (with-output-to-file pro
      (lambda ()
	(let ((csc (qs (normalize-pathname csc)))
	      (libdir (qs (normalize-pathname libpath)))
	      (incdir (qs (normalize-pathname incpath)))
	      (cincdir (qs (normalize-pathname cincpath))))
	  (print
#<#EOF
SOURCES=#{(string-intersperse cppfiles)}
QT+=uitools gui widgets multimedia
TEMPLATE=lib
HEADERS=#{(string-intersperse hfiles)}
TARGET=#{name}
unix:QMAKE_LFLAGS_RELEASE+= `#{csc} -libs -ldflags` -L#{libdir}
unix:QMAKE_CFLAGS_RELEASE+=-w `#{csc} -cflags` -I#{incdir} -I#{cincdir}
unix:QMAKE_CXXFLAGS_RELEASE+=-w `#{csc} -cflags` -I#{incdir} -I#{cincdir}
unix:QMAKE_CFLAGS_WARN_ON=-w
unix:QMAKE_CXXFLAGS_WARN_ON=-w
win32:QMAKE_LFLAGS_RELEASE+=-L#{libdir}
win32:QMAKE_CFLAGS_RELEASE+=-w -I#{incdir} -I#{cincdir} -DHAVE_CHICKEN_CONFIG_H -DPIC
win32:QMAKE_CXXFLAGS_RELEASE+=-w -I#{incdir} -I#{cincdir} -DHAVE_CHICKEN_CONFIG_H -DPIC
win32:QMAKE_CFLAGS_WARN_ON=--w
win32:QMAKE_CXXFLAGS_WARN_ON=-w
win32:LIBS+=-lchicken -lm -lws2_32
QT+=opengl
EOF
                 ) ) ))
    (run (,qmake ,(qs pro) -o ,mkfile))
    (delete-file* output)
    (display mkfile)
    (run (,gmake -f ,mkfile clean ,(if mingw32 "release" "all")))
    (cp
     (make-pathname 
      (if mingw32 "release" #f)
      (if mingw32 name (string-append "lib" name))
      (cond (mingw32 "dll")
            (macosx "1.0.0.dylib")
	    (else "so.1.0.0")))
     output)
    (when macosx
      (run (,install_name_tool -change "libchicken.dylib" ,(make-pathname libpath "libchicken" "dylib") ,output)))
    ) )

(define (rm-f . files)
  (for-each
   (lambda (fname)
     (when (setup-verbose-mode) (print "  rm -f " (qs fname)))
     (delete-file* fname))
   files))

(define (cp from to)
  (when (setup-verbose-mode)
    (print "  cp " (qs from) " " (qs to)))
  (copy-file from to))

(define (main args)
  (let-values (((opts files) (filter-options args)))
    (let ((cppfiles
	   (filter-map
	    (lambda (fname)
	      (let ((ext (pathname-extension fname)))
		(cond ((member ext '("scm" "ss"))
		       (run ("csc" ,fname "-t" "-c++" ,@opts))
		       (pathname-replace-extension fname "cpp"))
		      ((member ext '("cxx" "c++" "cpp"))
		       fname)
		      (else #f))))
	    files))
	  (hfiles
	   (filter
	    (lambda (fname)
	      (let ((ext (pathname-extension fname)))
		(member ext '("h" "hpp"))))
	    files)))
      (if (null? cppfiles)
	  (quit "no Scheme or C++ files to process")
	  (handle-exceptions ex
	      (begin
		(flush-output)
		(print-error-message ex (current-error-port))
		(exit 1))
	    (compile-qt-extension (append cppfiles (list "main.cpp")) hfiles)))))) 

(main (command-line-arguments))

)