Update of /project/phemlock/cvsroot/phemlock In directory common-lisp.net:/tmp/cvs-serv6898
Modified Files: hemlock.asd Log Message: Make hemlock compile under sbcl running in any locale.
Date: Sun Jan 30 06:51:35 2005 Author: crhodes
Index: phemlock/hemlock.asd diff -u phemlock/hemlock.asd:1.6 phemlock/hemlock.asd:1.7 --- phemlock/hemlock.asd:1.6 Mon Dec 27 10:53:14 2004 +++ phemlock/hemlock.asd Sun Jan 30 06:51:33 2005 @@ -4,10 +4,42 @@
(defpackage #:hemlock-system (:use #:cl) - (:export #:*hemlock-base-directory*)) + (:export #:*hemlock-base-directory* #:iso-8859-1-file))
(in-package #:hemlock-system)
+(defclass iso-8859-1-file (asdf:cl-source-file) ()) +(defmethod asdf:perform ((o asdf:compile-op) (c iso-8859-1-file)) + ;; Darn. Can't just CALL-NEXT-METHOD; have to reimplement the + ;; world. + (let ((source-file (asdf:component-pathname c)) + (output-file (car (asdf:output-files o c)))) + (multiple-value-bind (output warnings-p failure-p) + (compile-file source-file :output-file output-file + #+sbcl #+sbcl :external-format :iso-8859-1) + (when warnings-p + (case (asdf:operation-on-warnings o) + (:warn (warn + "~@<COMPILE-FILE warned while performing ~A on ~A.~@:>" + o c)) + (:error (error 'compile-warned :component c :operation o)) + (:ignore nil))) + (when failure-p + (case (asdf:operation-on-failure o) + (:warn (warn + "~@<COMPILE-FILE failed while performing ~A on ~A.~@:>" + o c)) + (:error (error 'compile-failed :component c :operation o)) + (:ignore nil))) + (unless output + (error 'asdf:compile-error :component c :operation o))))) +(defmethod perform ((o asdf:load-source-op) (c iso-8859-1-file)) + ;; likewise, have to reimplement rather than closily extend + (let ((source (asdf:component-pathname c))) + (setf (asdf:component-property c 'asdf::last-loaded-as-source) + (and (load source #+sbcl #+sbcl :external-format :iso-8859-1) + (get-universal-time))))) + (pushnew :command-bits *features*) (pushnew :buffered-lines *features*)
@@ -79,7 +111,7 @@ (:file "decls") ; early declarations of functions and stuff (:file "struct") #+port-core-struct-ed (:file "struct-ed") - (:file "charmacs") + (hemlock-system:iso-8859-1-file "charmacs") (:file "key-event"))) (:module bitmap-1 :pathname #.(merge-pathnames