/[slime]/slime/swank-loader.lisp
ViewVC logotype

Contents of /slime/swank-loader.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (hide annotations)
Sat Oct 18 05:06:44 2003 UTC (10 years, 6 months ago) by jbielman
Branch: MAIN
CVS Tags: SLIME-0-5, BACKHACKATTACK-1, SLIME-0-7, SLIME-0-6
Branch point for: backhackattack-1
Changes since 1.1: +2 -1 lines
(compile-files-if-needed-serially): Be a little
more verbose when compiling files.
1 jbielman 1.1 ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
2     ;;;
3     ;;; swank-loader.lisp --- Compile and load the Slime backend.
4     ;;;
5     ;;; Created 2003, James Bielman <jamesjb@jamesjb.com>
6     ;;;
7     ;;; This code has been placed in the Public Domain. All warranties
8     ;;; are disclaimed.
9     ;;;
10 jbielman 1.2 ;;; $Id: swank-loader.lisp,v 1.2 2003/10/18 05:06:44 jbielman Exp $
11 jbielman 1.1 ;;;
12    
13     (defpackage :swank-loader
14     (:use :common-lisp))
15     (in-package :swank-loader)
16    
17     (defun make-swank-pathname (name &optional (type "lisp"))
18     "Return a pathname with name component NAME in the Slime directory."
19     (merge-pathnames name
20     (make-pathname
21     :type type
22     :directory
23     (pathname-directory
24     (or *compile-file-pathname* *load-pathname*
25     *default-pathname-defaults*)))))
26    
27     (defparameter *sysdep-pathname*
28     (make-swank-pathname (or #+cmu "swank-cmucl"
29     #+sbcl "swank-sbcl"
30     #+openmcl "swank-openmcl")))
31    
32     (defparameter *swank-pathname* (make-swank-pathname "swank"))
33    
34     (defun file-newer-p (new-file old-file)
35     "Returns true if NEW-FILE is newer than OLD-FILE."
36     (> (file-write-date new-file) (file-write-date old-file)))
37    
38     (defun compile-files-if-needed-serially (&rest files)
39     "Compile each file in FILES if the source is newer than
40     its corresponding binary, or the file preceding it was
41     recompiled."
42     (let ((needs-recompile nil))
43     (dolist (source-pathname files)
44     (let ((binary-pathname (compile-file-pathname source-pathname)))
45     (handler-case
46     (progn
47     (when (or needs-recompile
48     (not (probe-file binary-pathname))
49     (file-newer-p source-pathname binary-pathname))
50 jbielman 1.2 (format t "~&;; Compiling ~A...~%" source-pathname)
51 jbielman 1.1 (compile-file source-pathname)
52     (setq needs-recompile t))
53     (load binary-pathname))
54     (error ()
55     ;; If an error occurs compiling, load the source instead
56     ;; so we can try to debug it.
57     (load source-pathname)))))))
58    
59     (compile-files-if-needed-serially *swank-pathname* *sysdep-pathname*)
60    

  ViewVC Help
Powered by ViewVC 1.1.5