[mcclim-cvs] CVS mcclim/Experimental/freetype

[rgoldman]

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

Modified Files:
	mcclim-freetype-cffi.asd 
Log Message:
modified font-finding for ACL and added cl-user variable to set it.

--- /project/mcclim/cvsroot/mcclim/Experimental/freetype/mcclim-freetype-cffi.asd	2006/05/25 19:23:22	1.1
+++ /project/mcclim/cvsroot/mcclim/Experimental/freetype/mcclim-freetype-cffi.asd	2006/05/25 22:44:16	1.2
@@ -47,6 +47,9 @@
 ;;; Freetype autodetection
 
 (defun parse-fontconfig-output (s)
+  (when (stringp s)
+    (setf s
+	  (make-string-input-stream s)))
   (let* ((match-string (concatenate 'string (string #\Tab) "file:"))
          (matching-line
           (loop for l = (read-line s nil nil)
@@ -68,19 +71,53 @@
   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))))
+(defun find-bitstream-fonts ()
   (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))))))
+	nil
+      (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))))
+	font-path))))
+
+#+allegro
+(defun find-bitstream-fonts ()
+  (let* ((fc-match (excl.osi:find-in-path "fc-match"))
+	 (command (format nil "~A -v Bitstream Vera" fc-match)))
+    (if (null fc-match)
+	nil
+	(multiple-value-bind (output error-output exit-code)
+	    (excl.osi:command-output
+	     command
+	     :whole t)
+	  (if (not (= exit-code 0))
+	      (progn
+		(format t "~&Tried to autoset font path, but was unable to find Bitstream Vera fonts.~%~T~A error output was ~%~T~T~A~%"
+			command error-output)
+		nil)
+	      (let ((font-path (parse-fontconfig-output output)))
+		(if (null font-path)
+		    (progn
+		      (format t "~&Tried to autoset font path, using command:~%~T~A~%~Tbut was unable to find Bitstream Vera fonts.~%"
+			      command)
+		      nil)
+		    font-path)))))))
+
+;;;#-(or sbcl allegro)
+;;;(defmethod perform :after ((o load-op) (s (eql (asdf:find-system :mcclim-freetype))))
+;;;  (warn-about-unset-font-path))
+
+(defvar cl-user::*mcclim-freetype-font-path* nil
+  "Set this variable to tell mcclim-freetype where to find the bitstream 
+Vera fonts (instead of having it look for them.")
 
-#-sbcl
 (defmethod perform :after ((o load-op) (s (eql (asdf:find-system :mcclim-freetype))))
-  (warn-about-unset-font-path))
+  (let (font-path)
+    (cond (cl-user::*mcclim-freetype-font-path*
+	   (setf  (symbol-value (intern "*FREETYPE-FONT-PATH*" :mcclim-freetype))
+		  cl-user::*mcclim-freetype-font-path*))
+	  ((setf font-path (find-bitstream-fonts))
+	   (setf (symbol-value (intern "*FREETYPE-FONT-PATH*" :mcclim-freetype))
+		 font-path))
+	  (t (warn-about-unset-font-path)))))