[mcclim-cvs] CVS mcclim/Experimental/freetype

[dlichteblau]

Update of /project/mcclim/cvsroot/mcclim/Experimental/freetype
In directory clnet:/tmp/cvs-serv18929

Modified Files:
	mcclim-freetype.asd 
Log Message:
restored cffi freetype code


--- /project/mcclim/cvsroot/mcclim/Experimental/freetype/mcclim-freetype.asd	2008/01/17 07:57:55	1.9
+++ /project/mcclim/cvsroot/mcclim/Experimental/freetype/mcclim-freetype.asd	2008/01/30 19:44:42	1.10
@@ -42,7 +42,46 @@
    (:file "freetype-fonts-cffi")))
 
 
+#+sbcl
 (defmethod perform :after ((o load-op) (s (eql (asdf:find-system :mcclim-freetype))))
   "Detect fonts using fc-match"
   (funcall (find-symbol (symbol-name '#:autoconfigure-fonts) :mcclim-freetype)))
 
+
+;;; Freetype autodetection
+#-sbcl
+(progn
+  (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/~%~%~%"))
+
+  (defmethod perform :after ((o load-op) (s (eql (asdf:find-system :mcclim-freetype))))
+    (unless
+	(setf (symbol-value (intern "*FREETYPE-FONT-PATH*" :mcclim-freetype))
+	      (find-bitstream-fonts))
+      (warn-about-unset-font-path)))
+
+  (defun find-bitstream-fonts ()
+    (with-input-from-string
+	(s (with-output-to-string (asdf::*verbose-out*)
+	     (let ((code (asdf:run-shell-command "fc-match -v Bitstream Vera")))
+	       (unless (zerop code)
+		 (warn "~&fc-match failed with code ~D.~%" code)))))
+      (parse-fontconfig-output s))))