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))))