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

Contents of /slime/swank-loader.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.25 - (hide annotations)
Thu Jun 10 17:57:16 2004 UTC (9 years, 10 months ago) by heller
Branch: MAIN
Changes since 1.24: +6 -0 lines
Initialize swank::*readtable-alist* for SBCL.
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     (merge-pathnames name
19     (make-pathname
20     :type type
21 lgorrie 1.20 :device
22     (pathname-device
23     (or *compile-file-pathname* *load-pathname*
24     *default-pathname-defaults*))
25 jbielman 1.1 :directory
26     (pathname-directory
27     (or *compile-file-pathname* *load-pathname*
28     *default-pathname-defaults*)))))
29    
30 heller 1.3 (defparameter *sysdep-pathnames*
31     (mapcar #'make-swank-pathname
32 heller 1.21 (append
33     '("nregex")
34     #+cmu '("swank-source-path-parser" "swank-cmucl")
35     #+sbcl '("swank-sbcl" "swank-source-path-parser" "swank-gray")
36     #+openmcl '("swank-openmcl" "swank-gray")
37     #+lispworks '("swank-lispworks" "swank-gray")
38     #+allegro '("swank-allegro" "swank-gray")
39     #+clisp '("xref" "metering" "swank-clisp" "swank-gray")
40 heller 1.24 #+armedbear '("swank-abcl" "swank-gray")
41 heller 1.21 )))
42 jbielman 1.1
43 heller 1.17 (defparameter *lisp-name*
44 lgorrie 1.22 #+cmu (format nil "cmu-~A" (lisp-implementation-version))
45     #+sbcl (format nil "sbcl-~A" (lisp-implementation-version))
46     #+openmcl "openmcl"
47 heller 1.17 #+lispworks "lispworks"
48 lgorrie 1.22 #+allegro "allegro"
49 heller 1.23 #+clisp (format nil "clisp-~A" (let ((s (lisp-implementation-version)))
50     (subseq s 0 (position #\space s))))
51 heller 1.24 #+armedbear "abcl"
52 heller 1.21 )
53 heller 1.17
54 jbielman 1.1 (defparameter *swank-pathname* (make-swank-pathname "swank"))
55    
56     (defun file-newer-p (new-file old-file)
57     "Returns true if NEW-FILE is newer than OLD-FILE."
58     (> (file-write-date new-file) (file-write-date old-file)))
59    
60 heller 1.17 (defun binary-pathname (source-pathname)
61     (merge-pathnames
62     (make-pathname :directory `(:relative "fasl" ,*lisp-name*))
63     (merge-pathnames (compile-file-pathname source-pathname))))
64    
65 heller 1.4 (defun compile-files-if-needed-serially (files)
66 jbielman 1.1 "Compile each file in FILES if the source is newer than
67     its corresponding binary, or the file preceding it was
68     recompiled."
69 heller 1.6 (with-compilation-unit ()
70     (let ((needs-recompile nil))
71     (dolist (source-pathname files)
72 heller 1.17 (let ((binary-pathname (binary-pathname source-pathname)))
73 heller 1.6 (handler-case
74     (progn
75     (when (or needs-recompile
76     (not (probe-file binary-pathname))
77     (file-newer-p source-pathname binary-pathname))
78     (format t "~&;; Compiling ~A...~%" source-pathname)
79 heller 1.17 (ensure-directories-exist binary-pathname)
80     (compile-file source-pathname :output-file binary-pathname)
81 heller 1.6 (setq needs-recompile t))
82     (load binary-pathname))
83 heller 1.13 #+(or)
84 heller 1.6 (error ()
85     ;; If an error occurs compiling, load the source instead
86     ;; so we can try to debug it.
87 heller 1.13 (load source-pathname))
88     ))))))
89 jbielman 1.1
90 heller 1.4 (defun user-init-file ()
91 heller 1.6 "Return the name of the user init file or nil."
92 heller 1.12 (probe-file
93     (merge-pathnames (user-homedir-pathname)
94     #-mswindows (make-pathname :name ".swank" :type "lisp")
95     #+mswindows (make-pathname :name "_swank" :type "lsp"))))
96 heller 1.4
97 heller 1.24
98 lgorrie 1.5 (compile-files-if-needed-serially
99 heller 1.18 (append (list (make-swank-pathname "swank-backend"))
100     *sysdep-pathnames*
101     (list *swank-pathname*)))
102 lgorrie 1.14
103 heller 1.18 (funcall (intern (string :warn-unimplemented-interfaces) :swank-backend))
104 heller 1.4
105 heller 1.25 #+sbcl
106     (let ((readtable (swank-backend::shebang-readtable)))
107     (dolist (p (list-all-packages))
108     (when (swank-backend::sbcl-package-p p)
109     (push (cons (package-name p) readtable) swank::*readtable-alist*))))
110    
111 heller 1.4 (when (user-init-file)
112     (load (user-init-file)))
113 jbielman 1.1

  ViewVC Help
Powered by ViewVC 1.1.5