Re: Could there be a way to disable LOAD-PREFERENCES?

Gary King <[email protected]> Mon, 25 Feb 2008 23:18:01 -0500
Newsgroups gmane.lisp.cclan.general
Message-ID <[email protected]>
Here is my diff for the suggested change. If there are no squawks,  
I'll commit tomorrow sometime.


Index: asdf.lisp
===================================================================
RCS file: /cvsroot/cclan/asdf/asdf.lisp,v
retrieving revision 1.115
diff -u -w -r1.115 asdf.lisp
--- asdf.lisp	15 Feb 2008 12:14:48 -0000	1.115
+++ asdf.lisp	26 Feb 2008 04:15:53 -0000
@@ -764,9 +764,10 @@
    (map nil #'ensure-directories-exist (output-files operation c)))

  (defmethod perform :after ((operation operation) (c component))
+  (when (getf (operation-original-initargs operation) :load- 
preferences t)
    (setf (gethash (type-of operation) (component-operation-times c))
          (get-universal-time))
-  (load-preferences c operation))
+    (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
@@ -957,8 +958,9 @@
  (setf (documentation 'operate 'function)
        *operate-docstring*)

-(defun oos (operation-class system &rest args &key force (verbose t)  
version)
-  (declare (ignore force verbose version))
+(defun oos (operation-class system &rest args
+	    &key force (verbose t) version load-preferences)
+  (declare (ignore force verbose version load-preferences))
    (apply #'operate operation-class system args))

  (setf (documentation 'oos 'function)
@@ -1261,7 +1263,8 @@
                   :defaults (system-source-file system-name)))

  (defun system-relative-pathname (system pathname &key name type)
-  (let ((directory (pathname-directory pathname)))
+  ;; you're isn't allowed to muck with the return value of pathname-X
+  (let ((directory (copy-list (pathname-directory pathname))))
      (when (eq (car directory) :absolute)
        (setf (car directory) :relative))
      (merge-pathnames

--
Gary Warren King, metabang.com
Cell: (413) 559 8738
Fax: (206) 338-4052
gwkkwg on Skype * garethsan on AIM





-------------------------------------------------------------------------
This SF.net email is sponsored by: Microsoft
Defy all challenges. Microsoft(R) Visual Studio 2008.
http://clk.atdmt.com/MRT/go/vse0120000070mrt/direct/01/