;;; -*- Mode: Lisp; Base: 10; Syntax: Common-Lisp; Package: DSYS -*- (in-package "DSYS") (defparameter *clcs-system-date* "CLCS 2/1/90") ; (For akcl-1-530) (defsystem clcs (:pretty-name "Common Lisp Condition System") #+kcl (:module clos pcl (:type :system)) (:parallel #+kcl clos (:forms :compile (proclaim *fast-declaration*) :load (proclaim *fast-declaration*)) (:serial "package" #-(or lucid excl genera cmu) (:serial (:load "precom") "macros" "restart" "handler" "debugger" #+kcl "kcl-cond" #+kcl "top-patches" "conditions" "condition-definitions" (:compile "precom")) "install"))) (defparameter *clcs-files* '((("systems") "lisp" "clcs") (("clcs") "lisp" "sysdef" "package" "macros" "restart" "handler" "debugger" "kcl-cond" "top-patches" "conditions" "condition-definitions" "precom" "install") (("clcs") nil "clcs-readme") (("clcs") "text" "installing-mailed-clcs") (("clcs" "doc") "text" ;;"cond18" "status" ) (("clcs" "doc") nil ;;"clos-conditions" ))) (defvar *clcs-dist-name* "clcs") (defun clcs-distribution-header () (let* ((*subfile-default-root-pathname* (make-pathname :directory '(:absolute "mydirectory" "lisp"))) (dist-dir (namestring (subfile '()))) (dist-file (namestring (subfile '() :name *clcs-dist-name* :type "lisp"))) (sys-file (namestring (subfile '() :name *this-file*)))) (format nil ";;; -*- Mode: LISP; Syntax: Common-lisp; Package: USER; Base: 10 -*- ;;; Common Lisp Condition System Distribution File ;;; Suppose the directory that is to contain the clcs system ;;; is ~S. ;;; To install CLCS: ;;; ~A ;;; (1) Put this file in ~S. ;;; (2) Run lisp, and type: ;;; (load ~S) ;;; To use CLCS: ;;; (1) Run lisp, and type: ;;; (load ~S) " dist-dir #-akcl "" #+akcl ";;; The CLCS system redefines the functions LOAD and OPEN (adding ;;; restart handlers), and the function SYSTEM:ERROR-SET. But AKCL is ;;; set up to compile calls to these functions into direct calls to ;;; C functions. You can fix this by: ;;; A. Edit the file cmpnew/lfun_list.lsp, commenting out every line ;;; that begins with #-clcs. ;;; B. Remake AKCL. ;;; C. Delete the files cmpnew/cmputil.o and lsp/debug.o ;;; (these files call SYSTEM:ERROR-SET). ;;; D. Remake AKCL. ;;; " dist-file dist-file sys-file))) (defun write-clcs-distribution (&key output-file) (dolist (sys '(clcs pcl)) (find-system sys nil)) (unless output-file (setq output-file (subfile '() :name *clcs-dist-name* :type "lisp"))) (write-distribution :files (append *basic-files* *clcs-files* *pcl-files*) :output-file output-file :header (clcs-distribution-header) #+unix :compress-uu-split-p #+unix t)) (defun read-clcs-distribution (&key input-file) (unless input-file (setq input-file (subfile '() :name *clcs-dist-name* :type "lisp"))) (read-distribution :input-file input-file)) (defun clcs-users () (let ((users-file (subfile '("clcs") :name "users" :type "text")) (users nil)) (when (probe-file users-file) (with-open-file (in users-file :direction :input) (loop (push (or (read in nil) (return nil)) users)))) (nreverse users))) #+unix (defun mail-clcs (&key output-file (new-p :ask) (query-users-p t)) (unless output-file (setq output-file (subfile '() :name *clcs-dist-name* :type "lisp"))) (let ((users (clcs-users)) (mail-users nil)) (if query-users-p (dolist (user users) (when (y-or-n-p "Mail CLCS to ~A? " user) (push user mail-users))) (setq mail-users users)) (when (if (eq new-p :ask) (y-or-n-p "~%Make a new distribution first? ") new-p) (write-clcs-distribution :output-file output-file)) (mail-compressed-uu-files :users mail-users :file output-file :intro-subject "How to install CLCS" :intro-file (subfile '("clcs") :name "installing-mailed-clcs" :type "text"))))