home *** CD-ROM | disk | FTP | other *** search
/ Otherware / Otherware_1_SB_Development.iso / mac / developm / source / oodleutl.cpt / oodles-of-utils / oou-init.lisp
Encoding:
Text File  |  1992-07-14  |  5.0 KB  |  155 lines
  1. ;; -*- package: oou -*-
  2. (provide :oou)
  3. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  4. ;; oou-init.Lisp
  5. ;;
  6. ;; Copyright ⌐ 1991 Northwestern University Institute for the Learning Sciences
  7. ;; All Rights Reserved
  8. ;;
  9. ;; author: Michael S. Engber
  10. ;;
  11. ;; load this file before using oodles-of-utils
  12. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  13.  
  14.  
  15. (defpackage :oou
  16.   (:nicknames :oodles-of-utils)
  17.   (:use :common-lisp :ccl)
  18.   (:import-from :ccl
  19.                 :find-field-descriptor
  20.                 :with-cstrs
  21.                 :%put-point
  22.                 :%getport
  23.                 :%clear-block
  24.                 :window-erase-region
  25.                 :*simple-view-clip-region*
  26.                 :color-list
  27.                 :rletz
  28.                 ))
  29.  
  30. (in-package :oou)
  31.  
  32. (export '(oou-dependencies compile-oou))
  33.  
  34. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  35.  
  36.  
  37. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  38. ;;;set up logical pathnames
  39.  
  40. (setf (logical-pathname-translations "mcl")
  41.       `((#P"**;*.*" "ccl:**;*.*"))
  42.       
  43.       (logical-pathname-translations "oou-top")
  44.       `((#P"**;" "mcl:oodles-of-utils;**;"))
  45.       
  46.       (logical-pathname-translations "oou-fasl")
  47.       `((#P"**;+*.*" "oou-top:NotInROM;*.*")
  48.         (#P"**;*.*"  "oou-top:oou-fasl;*.*"))
  49.       
  50.       (logical-pathname-translations "oou-mods")
  51.       `((#P"**;*.*" "oou-top:oou-mods;*.*"))
  52.       
  53.       (logical-pathname-translations "oou-patches")
  54.       `((#P"**;*.*" "oou-top:patches;*.*"))
  55.       
  56.       (logical-pathname-translations "oou")
  57.       `((#P"**;*.fasl" "oou-fasl:*.*")
  58.         (#P"**;*.*"    "oou-top:**;*.*")))
  59.  
  60.  
  61. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  62. ;; primitive dependency/require facility - should be improved
  63. ;; or maybe switched over to defsystem
  64.  
  65. (defvar *oou-modules* nil)
  66.  
  67. (defun oou-pick-load-file (name)
  68.   (let ((mods (merge-pathnames name "oou-mods:*.lisp"))
  69.         (fasl (merge-pathnames name "oou-fasl:*.fasl"))
  70.         (lisp (first (directory (merge-pathnames name "oou:**;*.lisp")))))
  71.     (cond
  72.      ((probe-file mods) (merge-pathnames name "oou-mods:*"))
  73.      ((null (probe-file fasl)) lisp)
  74.      ((null (probe-file lisp)) fasl)
  75.      ((> (file-write-date lisp) (file-write-date fasl)) lisp)
  76.      (fasl))))
  77.  
  78. (defun oou-require (module)
  79.   (let ((module-string (etypecase module
  80.                          (symbol (symbol-name module))
  81.                          (string module))))
  82.     (unless (find module-string *oou-modules* :test #'string-equal)
  83.       (let ((path (oou-pick-load-file module-string))
  84.             (loaded-p nil))
  85.         (unless path (error "couldn't find file named ~a in oodles-of-utils" module-string))
  86.         (unwind-protect
  87.           (progn
  88.             (pushnew module-string *oou-modules* :test #'string-equal)
  89.             (load path)
  90.             (setf loaded-p t))
  91.           (unless loaded-p
  92.             (setf *oou-modules* (delete module-string *oou-modules* :test #'string-equal))))))))
  93.  
  94. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  95. ;; primitive compilation facility
  96.  
  97. (defparameter *oou-no-compile-paths* `("**;work-in-progress;**;"
  98.                                        "**;boondoggles;**;"
  99.                                        "**;examples;**;"
  100.                                        "**;oou-fasl;**;"
  101.                                        "**;oou-mods;**;"
  102.                                        "**;*-example.lisp"
  103.                                        "**;*-test.lisp"
  104.                                        "**;*-scrap.lisp"
  105.                                        "oou-init.lisp"
  106.                                        ))
  107.  
  108. (defun oou-source-files ()
  109.   (directory
  110.    "oou:**;*.lisp"
  111.    :test #'(lambda (file) (not (find file *oou-no-compile-paths* :test #'pathname-match-p)))))
  112.  
  113. (defun compile-oou ()
  114.   (dolist (lisp-path (oou-source-files))
  115.     (let ((fasl-path (merge-pathnames  "oou-fasl:.fasl" lisp-path)))
  116.       (when (or (null (probe-file fasl-path))
  117.                 (< (file-write-date fasl-path) (file-write-date lisp-path)))
  118.         (format t "~%;Compiling ~s~%" lisp-path)
  119.         (compile-file lisp-path :output-file fasl-path :verbose *compile-verbose* :print *compile-print*)))))
  120.  
  121. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  122. ;;
  123.  
  124. (defun load-oou ()
  125.   (dolist (file (oou-source-files))
  126.     (load (oou-pick-load-file (pathname-name file)))))
  127.  
  128.  
  129. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  130. ;; oou's version of provide and require
  131.  
  132. (defmacro oou-provide (module) (declare (ignore module)) (values))
  133.  
  134. (defmacro oou-dependencies (&rest modules)
  135.   `(eval-when (:compile-toplevel :load-toplevel :execute)
  136.      ,@(mapcar #'(lambda (m) `(oou-require ,m)) modules)))
  137.  
  138.  
  139. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  140. ;;executed forms
  141.  
  142. (use-package :oou :cl-user) ;cl-user uses oou
  143.  
  144. (push #4P"oou:NotInRom;" *module-search-path*)
  145.  
  146. (oou-require :patches)
  147.  
  148.  
  149. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  150.  
  151. #|
  152. (compile-oou)
  153.  
  154. (load-oou)
  155. |#