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

Contents of /slime/swank-loader.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.35 - (hide annotations)
Sun Sep 26 17:09:13 2004 UTC (9 years, 6 months ago) by asimon
Branch: MAIN
Changes since 1.34: +1 -1 lines
Don't load swank-gray for abcl.
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    
11 heller 1.11 (cl:defpackage :swank-loader
12 jbielman 1.1 (:use :common-lisp))
13 heller 1.4
14 jbielman 1.1 (in-package :swank-loader)
15    
16     (defun make-swank-pathname (name &optional (type "lisp"))
17     "Return a pathname with name component NAME in the Slime directory."
18 msimmons 1.33 (merge-pathnames (make-pathname :name name :type type)
19     (or *compile-file-pathname*
20     *load-pathname*
21     *default-pathname-defaults*)))
22 jbielman 1.1
23 heller 1.3 (defparameter *sysdep-pathnames*
24     (mapcar #'make-swank-pathname
25 heller 1.21 (append
26     '("nregex")
27     #+cmu '("swank-source-path-parser" "swank-cmucl")
28     #+sbcl '("swank-sbcl" "swank-source-path-parser" "swank-gray")
29 aruttenberg 1.34 #+openmcl '("metering" "swank-openmcl" "swank-gray")
30 heller 1.21 #+lispworks '("swank-lispworks" "swank-gray")
31     #+allegro '("swank-allegro" "swank-gray")
32     #+clisp '("xref" "metering" "swank-clisp" "swank-gray")
33 asimon 1.35 #+armedbear '("swank-abcl")
34 heller 1.21 )))
35 jbielman 1.1
36 heller 1.17 (defparameter *lisp-name*
37 heller 1.32 #+cmu (format nil "cmu-~A"
38     (substitute #\- #\/ (lisp-implementation-version)))
39 lgorrie 1.22 #+sbcl (format nil "sbcl-~A" (lisp-implementation-version))
40     #+openmcl "openmcl"
41 lgorrie 1.29 #+lispworks (format nil "lispworks-~A" (lisp-implementation-version))
42 lgorrie 1.30 #+allegro (format nil "allegro-~A" excl::*common-lisp-version-number*)
43 heller 1.23 #+clisp (format nil "clisp-~A" (let ((s (lisp-implementation-version)))
44     (subseq s 0 (position #\space s))))
45 heller 1.24 #+armedbear "abcl"
46 heller 1.21 )
47 heller 1.17
48 jbielman 1.1 (defparameter *swank-pathname* (make-swank-pathname "swank"))
49    
50     (defun file-newer-p (new-file old-file)
51     "Returns true if NEW-FILE is newer than OLD-FILE."
52     (> (file-write-date new-file) (file-write-date old-file)))
53    
54 heller 1.17 (defun binary-pathname (source-pathname)
55 lgorrie 1.27 "Return the pathname where SOURCE-PATHNAME's binary should be compiled."
56     (let ((cfp (compile-file-pathname source-pathname)))
57     (merge-pathnames (make-pathname
58 heller 1.32 :directory `(:relative ".slime" "fasl" ,*lisp-name*)
59 lgorrie 1.27 :name (pathname-name cfp)
60     :type (pathname-type cfp))
61     (user-homedir-pathname))))
62 heller 1.17
63 heller 1.4 (defun compile-files-if-needed-serially (files)
64 jbielman 1.1 "Compile each file in FILES if the source is newer than
65     its corresponding binary, or the file preceding it was
66     recompiled."
67 heller 1.6 (with-compilation-unit ()
68     (let ((needs-recompile nil))
69     (dolist (source-pathname files)
70 heller 1.17 (let ((binary-pathname (binary-pathname source-pathname)))
71 heller 1.6 (handler-case
72     (progn
73     (when (or needs-recompile
74     (not (probe-file binary-pathname))
75     (file-newer-p source-pathname binary-pathname))
76     (format t "~&;; Compiling ~A...~%" source-pathname)
77 heller 1.17 (ensure-directories-exist binary-pathname)
78     (compile-file source-pathname :output-file binary-pathname)
79 heller 1.6 (setq needs-recompile t))
80     (load binary-pathname))
81 heller 1.13 #+(or)
82 heller 1.6 (error ()
83     ;; If an error occurs compiling, load the source instead
84     ;; so we can try to debug it.
85 heller 1.13 (load source-pathname))
86     ))))))
87 jbielman 1.1
88 heller 1.4 (defun user-init-file ()
89 heller 1.6 "Return the name of the user init file or nil."
90 lgorrie 1.31 (probe-file (merge-pathnames (user-homedir-pathname)
91     (make-pathname :name ".swank" :type "lisp"))))
92 heller 1.4
93 heller 1.24
94 lgorrie 1.5 (compile-files-if-needed-serially
95 heller 1.18 (append (list (make-swank-pathname "swank-backend"))
96     *sysdep-pathnames*
97     (list *swank-pathname*)))
98 lgorrie 1.14
99 heller 1.18 (funcall (intern (string :warn-unimplemented-interfaces) :swank-backend))
100 heller 1.4
101     (when (user-init-file)
102     (load (user-init-file)))
103 jbielman 1.1

  ViewVC Help
Powered by ViewVC 1.1.5