;;; Creates the cs325-user package for CS 325 students.

;;; Update history:
;;; 11-06-09 Generalized GET-CODE-FILE [CKR]
;;; 09-22-09 Updated to remote-load files from EECS 325 site [CKR]
;;; 02-29-08 Updated to load merged mop-examples.lisp [CKR]
;;; 02-28-08 Updated to load just new mops.lisp [CKR]
;;; 02-15-05 Renamed module variable to avoid conflict with ASDF [CKR]
;;; 12-01-04 New include with integrated use-package and pathname defaults [CKR]
;;; 02-04-03 Replaced require with include [CKR]

;;; AllegroServe or PortableAllegroServe must be installed
;;; already by your initialization file.
(eval-when (compile load eval)
  (require :aserve)
  )

(defpackage cs325-user
  (:use :common-lisp)
  )

(in-package :cs325-user)

(defparameter *cs325-defaults*
  (make-pathname :host (pathname-host *load-truename*)
                 :device (pathname-device *load-truename*)
                 :directory (pathname-directory *load-truename*)
                 :type "lisp"))

;;; (INCLUDE name [pathname-defaults])
;;;   Loads the code file for name, uses the package called name,
;;;   adds name to *MODULES*, and returns the code file name, if 
;;;   name is not already in *MODULES* and a code file can be found.
;;;
;;;    Example: (INCLUDE "tables")

(defun include (name &key defaults package)
  (unless (included-p name)
    (let ((file (get-code-file (merge-pathnames name *cs325-defaults*))))
      (cond ((null file)
             (error "~S not found" name))
            (t
             (load file)
             (push name *modules*)
             (let ((module-package (or package (get-module-package name))))
               (unless (null module-package)
                 (use-package module-package)))
             file)))))

;;; (GET-CODE-FILE name [pathname-defaults])
;;;   Returns the code file to load for name. name is
;;;   merged with pathname-defaults, if non-NIL, and
;;;   *CS325-DEFAULTS*, and then the newer of that file
;;;   and its compiled version is returned.

(defun get-code-file (name)
  (let* ((source-path 
          (merge-pathnames name 
                           (or *compile-file-pathname* *load-truename*)))
         (object-path (compile-file-pathname source-path))
         (source-file (probe-file source-path))
         (object-file (probe-file object-path)))
    (cond ((null object-file) source-file)
          ((null source-file) object-file)
          ((> (file-write-date source-file)
              (file-write-date object-file))
           source-file)
          (t object-file))))

(defun included-p (name)
  (member name *modules* :test #'equal))

(defun get-module-package (name)
  (or (find-package name)
      (find-package (string-upcase name))
      (find-package (string-downcase name))))

;;; REMOTE FILE LOADER

(defparameter *cs325-code-url* 
  "http://www.cs.northwestern.edu/academics/courses/325/programs/")

(defun remote-load (source)
  (let* ((url (get-remote-url (file-namestring source)))
         (content (get-response-content url)))
    (if (null content)
        (error "~S not found" url)
      (with-open-file (stream source :direction :output)
        (write-string content stream)
        source))))

(defun get-remote-content (path &key (base-url *cs325-code-url*))
  (get-response-content (get-remote-url path :base-url base-url)))

(defun get-remote-url (path &key (base-url *cs325-code-url*))
  (concatenate 'string base-url path))

(defun get-response-content (url)
  (multiple-value-bind (content code headers uri)
      (net.aserve.client:do-http-request url)
    (if (= code 404) nil content)))

(defun get-response-header (url header)
  (cdr (assoc header (get-response-headers url))))

(defun get-response-headers (url)
  (multiple-value-bind (content code headers uri)
      (net.aserve.client:do-http-request url :method :head)
    (if (= code 404) nil headers)))



;;; Load the modules I always want

(eval-when (:compile-toplevel :load-toplevel :execute)
  (mapc #'include
        '("tables" "mops" "extend-match" "write-wrap" "lisp-unit" "lisp-critic"
          "exercise-tests" "lisp-rules")))

(format t "~&REMINDER: call (in-package #:cs325-user) first.~%")