[mcclim-cvs] CVS update: mcclim/Experimental/freetype/freetype-fonts.lisp mcclim/Experimental/freetype/mcclim-freetype.asd

[Andreas Fuchs]

Update of /project/mcclim/cvsroot/mcclim/Experimental/freetype
In directory common-lisp.net:/tmp/cvs-serv25410/Experimental/freetype

Modified Files:
	freetype-fonts.lisp mcclim-freetype.asd 
Log Message:
Add Bitstream Vera detection routines to mcclim-freetype's system definition.

This depends on the fontconfig utilties, namely fc-match. If they're not found,
it defaults to the old (warning) behavior.

Date: Fri Jul 29 08:50:20 2005
Author: afuchs

Index: mcclim/Experimental/freetype/freetype-fonts.lisp
diff -u mcclim/Experimental/freetype/freetype-fonts.lisp:1.9 mcclim/Experimental/freetype/freetype-fonts.lisp:1.10
--- mcclim/Experimental/freetype/freetype-fonts.lisp:1.9	Thu Jul 14 14:09:24 2005
+++ mcclim/Experimental/freetype/freetype-fonts.lisp	Fri Jul 29 08:50:20 2005
@@ -487,10 +487,3 @@
       (clim:with-drawing-options (m :clipping-region r)
         (clim:draw-design m r :ink clim:+background-ink+)
         (call-next-method s r)))))
-
-(format t
-"~%~%NOTE:~%~
-* Remember to set mcclim-freetype:*freetype-font-path* to the
-  location of the Bitstream Vera family of fonts on disk. If you
-  don't have them, get them from http://www.gnome.org/fonts/~%~%~%")
-(finish-output t)


Index: mcclim/Experimental/freetype/mcclim-freetype.asd
diff -u mcclim/Experimental/freetype/mcclim-freetype.asd:1.2 mcclim/Experimental/freetype/mcclim-freetype.asd:1.3
--- mcclim/Experimental/freetype/mcclim-freetype.asd:1.2	Sat Jun 18 03:56:43 2005
+++ mcclim/Experimental/freetype/mcclim-freetype.asd	Fri Jul 29 08:50:20 2005
@@ -1,5 +1,14 @@
 ;;;; -*- Lisp -*-
 
+#|
+To autoload mcclim-freetype after mcclim, link this file to a
+directory in your asdf:*central-registry* and add the following to
+your lisp's init file:
+
+ (defmethod asdf:perform :after ((o asdf:load-op) (s (eql (asdf:find-system :clim-clx))))
+   (asdf:oos 'asdf:load-op :mcclim-freetype))
+|#
+
 (defpackage :mcclim-freetype-system (:use :cl :asdf))
 (in-package :mcclim-freetype-system)
 
@@ -12,9 +21,51 @@
   (list (component-pathname c)))
 
 (defsystem :mcclim-freetype
-  :depends-on (:clim :clx)
+  :depends-on (:clim-clx)
   :serial t
   :components
   ((:file "freetype-package")
    (:uncompiled-cl-source-file "freetype-ffi")
    (:file "freetype-fonts")))
+
+
+;;; Freetype autodetection
+
+(defun parse-fontconfig-output (s)
+  (let* ((match-string (concatenate 'string (string #\Tab) "file:"))
+         (matching-line
+          (loop for l = (read-line s nil nil)
+                while l
+                if (= (mismatch l match-string) (length match-string))
+                   do (return l)))
+         (filename (when matching-line
+                     (probe-file
+                      (subseq matching-line
+                              (1+ (position #\" matching-line :from-end nil :test #'char=))
+                              (position #\" matching-line :from-end t   :test #'char=))))))
+    (when filename
+      (make-pathname :directory (pathname-directory filename)))))
+
+(defun warn-about-unset-font-path ()
+  (warn "~%~%NOTE:~%~
+* Remember to set mcclim-freetype:*freetype-font-path* to the
+  location of the Bitstream Vera family of fonts on disk. If you
+  don't have them, get them from http://www.gnome.org/fonts/~%~%~%"))
+
+#+sbcl
+(defmethod perform :after ((o load-op) (s (eql (asdf:find-system :mcclim-freetype))))
+  (let ((fc-match  (sb-ext:find-executable-in-search-path "fc-match")))
+    (if (null fc-match)
+        (warn-about-unset-font-path)
+        (let* ((process (sb-ext:run-program fc-match `("-v" "Bitstream Vera")
+                                            :output :stream
+                                            :input nil))
+               (font-path (parse-fontconfig-output (sb-ext:process-output process))))
+          (if (null font-path)
+              (warn-about-unset-font-path)
+              (setf (symbol-value (intern "*FREETYPE-FONT-PATH*" :mcclim-freetype))
+                    font-path))))))
+
+#-sbcl
+(defmethod perform :after ((o load-op) (s (eql (asdf:find-system :mcclim-freetype))))
+  (warn-about-unset-font-path))
\ No newline at end of file