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