Re: MCL 2.0 final defsys package screw

["Mark A. Tapia" <markt@dgp.toronto.edu>]

Nathan Wilson (nathan@akbar.teleos.com) writes about problems loading the
Prime Computer version of defsys, wondering whether to replace the
following:

(defun ...
 
  (if package
    (let ((spackage *package*))
      (unwind-protect
          (progn (in-package package)
                 (load path))
        (in-package (package-name spackage))))
    (load path))
 
...)

by the following code:
  (if package
    (let ((*package* (find-package package)))
      (load path))
    (load path))


You might consider using the defsys developed and distributed by Mark Kantorwitz
at CMU.

The principal changes that affected the defsys package from CMU were the
result of changes to in-package and the way that logical names are defined
in MCL.

Here is the old version that defines the defsys package:
(in-package #-:allegro "DEFSYSTEM" #+:allegro "MAKE"
	    :nicknames '("DEFSYS" "MAKE" "MK")
	    :use '("COMMON-LISP-USER" "CCL"
		   "CL-USER"
		   "COMMON-LISP"))
Here is the corrected version:
(defpackage #-:allegro "DEFSYSTEM" #+:allegro "MAKE"
  (:nicknames "DEFSYS" "MAKE" "MK")
    (:use "COMMON-LISP-USER" "CCL"
          "CL-USER"
          "COMMON-LISP"))

(in-package defsys)

As for the logical name translations, the following code works:
(defmacro logical-to-name (logical-name &optional rest)
  "Allow the expansion of logical pathnames"
    `(if ,rest
	 (format nil "~a~a" (mac-directory-namestring 
				  (truename ,logical-name))
					       ,rest)
						    (mac-directory-namestring (truename ,logical-name))))

(defun translate-name (top-dir &optional sub-dirs file)
   (let (main-dir)
      (if file
	(setq main-dir (logical-to-name top-dir sub-dirs))
        (setq main-dir (logical-to-name top-dir)
              file sub-dirs))
										      (format nil "~a~a"  main-dir file)))

Here is how to define the logical directory for the example folder:
(setf (logical-pathname-translations "Examples")
	    (list (list (concatenate 'string "Examples:**;*.*")
			(concatenate 'string "ccl:Examples;**;*.*"))))

To load the scrolling windows file:
   (load (logical-to-name "Examples:" "scrolling-windows"))