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

Contents of /slime/swank-loader.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.12 - (show annotations)
Tue Jan 6 13:10:29 2004 UTC (10 years, 3 months ago) by heller
Branch: MAIN
CVS Tags: SLIME-0-10
Changes since 1.11: +5 -7 lines
(user-init-file): Use mergepathame.  Fix Windows support.  Patch by
Ignas Mikalajunas <i.mikalajunas@mbt.lt>.
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 ;;; $Id: swank-loader.lisp,v 1.12 2004/01/06 13:10:29 heller Exp $
11 ;;;
12
13 (cl:defpackage :swank-loader
14 (:use :common-lisp))
15
16 (in-package :swank-loader)
17
18 (defun make-swank-pathname (name &optional (type "lisp"))
19 "Return a pathname with name component NAME in the Slime directory."
20 (merge-pathnames name
21 (make-pathname
22 :type type
23 :directory
24 (pathname-directory
25 (or *compile-file-pathname* *load-pathname*
26 *default-pathname-defaults*)))))
27
28 (defparameter *sysdep-pathnames*
29 (mapcar #'make-swank-pathname
30 #+cmu '("swank-source-path-parser" "swank-cmucl")
31 #+sbcl '("swank-sbcl" "swank-source-path-parser" "swank-gray")
32 #+openmcl '("swank-openmcl" "swank-gray")
33 #+lispworks '("swank-lispworks" "swank-gray")
34 #+allegro '("swank-allegro" "swank-gray")
35 #+clisp '("xref" "swank-clisp" "swank-gray")
36 ))
37
38 (defparameter *swank-pathname* (make-swank-pathname "swank"))
39
40 (defun file-newer-p (new-file old-file)
41 "Returns true if NEW-FILE is newer than OLD-FILE."
42 (> (file-write-date new-file) (file-write-date old-file)))
43
44 (defun compile-files-if-needed-serially (files)
45 "Compile each file in FILES if the source is newer than
46 its corresponding binary, or the file preceding it was
47 recompiled."
48 (with-compilation-unit ()
49 (let ((needs-recompile nil))
50 (dolist (source-pathname files)
51 (let ((binary-pathname (compile-file-pathname source-pathname)))
52 (handler-case
53 (progn
54 (when (or needs-recompile
55 (not (probe-file binary-pathname))
56 (file-newer-p source-pathname binary-pathname))
57 (format t "~&;; Compiling ~A...~%" source-pathname)
58 (compile-file source-pathname)
59 (setq needs-recompile t))
60 (load binary-pathname))
61 (error ()
62 ;; If an error occurs compiling, load the source instead
63 ;; so we can try to debug it.
64 (load source-pathname))))))))
65
66 (defun user-init-file ()
67 "Return the name of the user init file or nil."
68 (probe-file
69 (merge-pathnames (user-homedir-pathname)
70 #-mswindows (make-pathname :name ".swank" :type "lisp")
71 #+mswindows (make-pathname :name "_swank" :type "lsp"))))
72
73 (compile-files-if-needed-serially
74 (list* (make-swank-pathname "swank-backend") *swank-pathname*
75 *sysdep-pathnames*))
76
77 (when (user-init-file)
78 (load (user-init-file)))
79

  ViewVC Help
Powered by ViewVC 1.1.5