Commit d6c42afd authored by Gary King's avatar Gary King
Browse files

Added load-preferences and preference-file-for-system/operation. Specialized 

them so that preferences are found in ~/.asdf/<name-of-system>.lisp by default
and are loaded on either a load-op or a load-source-op. Refactored load-op and
load-source-op to both be subclasses of basic-load-op to facilitate this.

Added test case in test directory.

Still need to add to documentation of ASDF and will once I figure out where such
a beast truely lives.
parent 135437fb

asdf.lisp

+59 −21
Original line number Diff line number Diff line 
;;; This is asdf: Another System Definition Facility.  $Revision: 1.99 $

;;; This is asdf: Another System Definition Facility.  $Revision: 1.100 $

;;;

;;; Feedback, bug reports, and patches are all welcome: please mail to

;;; <cclan-list@lists.sf.net>.  But note first that the canonical
@@ -101,6 +101,8 @@ 
	   #:retry

	   #:accept                     ; restarts

	   

           #:preference-file-for-system/operation

           #:load-preferences

	   )

  (:use :cl))
@@ -110,7 +112,7 @@ 


(in-package #:asdf)



(defvar *asdf-revision* (let* ((v "$Revision: 1.99 $")

(defvar *asdf-revision* (let* ((v "$Revision: 1.100 $")

			       (colon (or (position #\: v) -1))

			       (dot (position #\. v)))

			  (and v colon dot
@@ -732,7 +734,8 @@ system.")) 


(defmethod perform :after ((operation operation) (c component))

  (setf (gethash (type-of operation) (component-operation-times c))

	(get-universal-time)))

	(get-universal-time))

  (load-preferences c operation))



;;; perform is required to check output-files to find out where to put

;;; its answers, in case it has been overridden for site policy
@@ -773,7 +776,9 @@ system.")) 


;;; load-op



(defclass load-op (operation) ())

(defclass basic-load-op (operation) ())



(defclass load-op (basic-load-op) ())



(defmethod perform ((o load-op) (c cl-source-file))

  (mapcar #'load (input-files o c)))
@@ -792,7 +797,7 @@ system.")) 


;;; load-source-op



(defclass load-source-op (operation) ())

(defclass load-source-op (basic-load-op) ())



(defmethod perform ((o load-source-op) (c cl-source-file))

  (let ((source (component-pathname c)))
@@ -827,6 +832,38 @@ system.")) 
(defmethod perform ((operation test-op) (c component))

  nil)



(defgeneric load-preferences (system operation)

  (:documentation "Called to load system preferences after <perform operation system>. Typical uses are to set parameters that don't exist until after the system has been loaded."))



(defgeneric preference-file-for-system/operation (system operation)

  (:documentation "Returns the pathname of the preference file for this system. Called by 'load-preferences to determine what file to load."))



(defmethod load-preferences ((s t) (operation t))

  ;; do nothing

  (values))



(defmethod load-preferences ((s system) (operation basic-load-op))

  (let* ((*package* (find-package :common-lisp))

         (file (probe-file (preference-file-for-system/operation s operation))))

    (when file 

      (when *verbose-out*

	(format *verbose-out* 

		"~&~@<; ~@;loading preferences for ~A/~(~A~) from ~A~@:>~%"

		(component-name s)

		(type-of operation) file))

      (load file))))



(defmethod preference-file-for-system/operation ((system t) (operation t))

  ;; cope with anything other than systems 

  (preference-file-for-system/operation (find-system system t) operation))



(defmethod preference-file-for-system/operation ((s system) (operation t))

  (merge-pathnames

   (make-pathname :name (component-name s)

                  :type "lisp"

                  :directory '(:relative ".asdf"))

   (truename (user-homedir-pathname))))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; invoking operations
@@ -1173,3 +1210,4 @@ output to *VERBOSE-OUT*. Returns the shell's exit code." 
  (pushnew 'contrib-sysdef-search *system-definition-search-functions*))



(provide 'asdf)

test/test-preferences-1.lisp

0 → 100644
+3 −0
Original line number Diff line number Diff line 
(in-package #:common-lisp-user)



(defvar *test-preferences-variable-1* :default)

test/test-preferences-1.script

0 → 100644
+9 −0
Original line number Diff line number Diff line 
;;; -*- Lisp -*-



(load "../asdf")

(setf asdf:*central-registry* '(*default-pathname-defaults*))

(in-package :asdf)

(asdf:oos 'asdf:load-op 'test-preferences-system-1)

(assert (eq common-lisp-user::*test-preferences-variable-1* :load))

(asdf:oos 'asdf:test-op 'test-preferences-system-1)

(assert (eq common-lisp-user::*test-preferences-variable-1* :test))

test/test-preferences-system-1.asd

0 → 100644
+35 −0
Original line number Diff line number Diff line 
;;; -*- Lisp -*-

(in-package #:common-lisp)



(defpackage #:test-preferences-1-asdf-system 

  (:use #:common-lisp #:asdf))

(in-package #:asdf)



(defsystem test-preferences-system-1

  :components

  ((:file "test-preferences-1"))

  :in-order-to ((test-op (load-op test-preferences-system-1))))



(defmethod operation-done-p 

           ((o test-op)

            (c (eql (find-system 'test-preferences-system-1))))

  (values nil))



(defmethod load-preferences

           ((system (eql (find-system 'test-preferences-system-1))) 

            (operation test-op))

  ;; the default load-preferences does nothing for anything other than a 

  ;; basic-load-op. So, ... we hack it

  (load (make-pathname

         :name "test-preferences-system-test"

         :type "lisp"

         :defaults *default-pathname-defaults*)))



(defmethod preference-file-for-system/operation 

           ((system (eql (find-system 'test-preferences-system-1))) 

            (operation load-op))

  (make-pathname

   :name "test-preferences-system-load"

   :type "lisp"

   :defaults *default-pathname-defaults*))

test/test-preferences-system-load.lisp

0 → 100644
+3 −0
Original line number Diff line number Diff line 
(in-package #:common-lisp-user)



(setf *test-preferences-variable-1* :load)