;;; -*- Mode: LISP; Package: :cl-user; BASE: 10; Syntax: ANSI-Common-Lisp; -*-
;;;
;;;   Time-stamp: <2008-11-10 09:02:51 madhu>
;;;   Touched: Sun May 04 16:17:25 2008 +0530 <enometh@meer.net>
;;;   Bugs-To: enometh@meer.net
;;;   Status: Experimental.  Do not redistribute
;;;   Copyright (C) 2008 Madhu.  All Rights Reserved.
;;;
(in-package "CL-USER")

#+allegro
(progn
(defvar *allegro-mk-defsystem-module-provider-hack-dummy-load-pathname*
  "/tmp/acldummy.cl")
;; system wide resource
(unless (probe-file *allegro-mk-defsystem-module-provider-hack-dummy-load-pathname*)
  (with-open-file (stream
		   *allegro-mk-defsystem-module-provider-hack-dummy-load-pathname*
		   :direction :output)
    (write-string 
";;; -*- Mode: LISP; Package: :cl-user; BASE: 10; Syntax: ANSI-Common-Lisp; -*-
;;; Dummy file
\(in-package :cl-user)
\(defvar *acldummyloadcount* 0)
\(defvar *acldummyloadmodules* nil)
\(incf *acldummyloadcount*)" stream))))

#+nil
(delete-file *allegro-mk-defsystem-module-provider-hack-dummy-load-pathname*)

#+allegro
(defun mk::allegro-mk-defsystem-module-provider-hack ; madhu 20080504
     (supplied-name search-list order check-bundle check-lower-case)
  ;;(declare (ignore search-list order check-bundle))
  (warn "XXX: ~S."
	(pairlis '(supplied-name search-list order check-bundle check-lower-case)
		 (list supplied-name search-list order check-bundle check-lower-case)))
  (let* ((name (if (pathnamep supplied-name)
		   (namestring supplied-name)
		   (string supplied-name)))
	 (module-name (string-downcase name))
	 (dummy-return (mk::compute-system-path module-name nil)))
    (when (mk:find-system module-name :load-or-nil)
      (mk:operate-on-system module-name :load
			    :force mk::*force*
			    :version mk::*version*
			    :test mk::*oos-test*
			    :verbose mk::*oos-verbose*
			    :load-source-if-no-binary mk::*load-source-if-no-binary*
			    :bother-user-if-no-binary mk::*bother-user-if-no-binary*
			    :compile-during-load mk::*compile-during-load*
			    :load-source-instead-of-binary
			    mk::*load-source-instead-of-binary*
			    :minimal-load mk::*minimal-load*)
      (warn "XXX: Returning: ~S." dummy-return)
      ;; this fails when you do not have a .system file.
      (or dummy-return
	  *allegro-mk-defsystem-module-provider-hack-dummy-load-pathname*))))

#+nil
(setq sys::*require-search-list*
      '(:FIRST
	#P"sys:;code;.fasl"
	#P"sys:;private;.fasl" #P"sys:;private;crypto;.fasl"
	#P"sys:;clos;.fasl" #P"sys:;sys;.fasl"
	(:LIB-BUNDLE #P"sys:;code;.fasl") (:LIB-BUNDLE #P"sys:;private;.fasl")
	(:LIB-BUNDLE #P"sys:;private;crypto;.fasl")
	(:LIB-BUNDLE #P"sys:;clos;.fasl") (:LIB-BUNDLE #P"sys:;sys;.fasl")))

#+allegro
(let ((form '(:CALL mk::allegro-mk-defsystem-module-provider-hack)))
  (unless (find form sys::*require-search-list* :test #'equal)
    (setq sys::*require-search-list*
	  (append sys::*require-search-list* (list form)))))