;;;
;;; Autoloading
;;;

(in-package "SYSTEM")
(export '(define-autoload-module register-autoloads
          create-autoload-path))

(defun autoload-function (name)
  (let ((modpath (find-function-module-path name))
        (restart (find-restart 'continue))
        (*load-verbose* nil))
    (when (and modpath restart)
          (load modpath)
          (when (fboundp name)
                (invoke-restart restart)))))

(defun autoload-variable (name)
  (let ((modpath (find-variable-module-path name))
        (restart (find-restart 'continue))
        (*load-verbose* nil))
    (when (and modpath restart)
          (load modpath)
          (when (boundp name)
                (invoke-restart restart)))))

(let ((function-modules (make-hash-table))
      (variable-modules (make-hash-table)))
  (defun find-function-module-path (name)
    (gethash name function-modules))
  (defun find-variable-module-path (name)
    (gethash name variable-modules))
  (defun add-function-module (name module)
    (setf (gethash name function-modules) module))
  (defun add-variable-module (name module)
    (setf (gethash name variable-modules) module)))

(defmacro define-autoload-module (module &rest clauses)
  `(let ((mname (make-pathname :name ',module
                               :directory (pathname-directory *load-truename*)
                               :device (pathname-device *load-truename*)
                               :host (pathname-host *load-truename*)))
         (clist ',clauses))
     (dolist (c clist)
       (ecase (first c)
         (variable (dolist (n (rest c)) (add-variable-module n mname)))
         (function (dolist (n (rest c)) (add-function-module n mname)))))))

(defun register-autoloads (dir)
  (let ((idx (merge-pathnames "_autoidx" dir))
        (dirlist (system::base-directory dir)))
    #+(or unix msdos) (setf dirlist (delete "." dirlist :test #'equal))
    #+(or unix msdos) (setf dirlist (delete ".." dirlist :test #'equal))
    (load idx :verbose nil :if-does-not-exist nil)
    (dolist (d dirlist)
      (let ((dpath (make-pathname :directory (list :relative d))))
        (register-autoloads (merge-pathnames dpath dir))))))

(defun create-autoload-path ()
  (list (merge-pathnames (make-pathname :directory '(:relative "Autoload"))
                         *default-path*)))