source: trunk/j/src/org/armedbear/lisp/swank-loader.lisp @ 9266

Last change on this file since 9266 was 8464, checked in by piso, 16 years ago

Added support for Allegro Common Lisp.

File size: 3.0 KB
Line 
1;;; swank-loader.lisp
2;;;
3;;; Copyright (C) 2004-2005 Peter Graves
4;;; $Id: swank-loader.lisp,v 1.5 2005-02-04 19:34:54 piso Exp $
5;;;
6;;; This program is free software; you can redistribute it and/or
7;;; modify it under the terms of the GNU General Public License
8;;; as published by the Free Software Foundation; either version 2
9;;; of the License, or (at your option) any later version.
10;;;
11;;; This program is distributed in the hope that it will be useful,
12;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14;;; GNU General Public License for more details.
15;;;
16;;; You should have received a copy of the GNU General Public License
17;;; along with this program; if not, write to the Free Software
18;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
19
20;;; Adapted from SLIME, the "Superior Lisp Interaction Mode for Emacs",
21;;; originally written by Eric Marsden, Luke Gorrie and Helmut Eller.
22
23(defpackage #:swank-loader
24  (:use :common-lisp))
25
26(in-package #:swank-loader)
27
28#+abcl
29(sys:load-system-file "swank-package")
30
31#-abcl
32(load (merge-pathnames "swank-package.lisp" *load-truename*))
33
34#+abcl
35(dolist (file '("swank-protocol.lisp"
36                "swank-abcl.lisp"
37                "swank.lisp"))
38  (let ((device (pathname-device *load-truename*)))
39    (cond ((and (pathnamep device)
40                (equalp (pathname-type device) "jar"))
41           (sys:load-system-file (pathname-name file)))
42          (t
43           (let* ((source-file (merge-pathnames file *load-truename*))
44                  (binary-file (compile-file-pathname source-file)))
45             (if (and (probe-file binary-file)
46                      (> (file-write-date binary-file) (file-write-date source-file)))
47                 (sys:load-system-file (file-namestring binary-file))
48                 (sys:load-system-file (file-namestring (compile-file source-file)))))))))
49
50#-abcl
51(defun binary-pathname (source-pathname)
52  (let ((cfp (compile-file-pathname source-pathname)))
53    (merge-pathnames (make-pathname
54                      :directory `(:relative ".j" "slime" "fasl"
55                                             #+sbcl "sbcl"
56                                             #+allegro "allegro")
57                      :name (pathname-name cfp)
58                      :type (pathname-type cfp))
59                     (user-homedir-pathname))))
60
61#-abcl
62(dolist (file '("swank-protocol.lisp"
63                #+allegro "swank-allegro.lisp"
64                #+sbcl "swank-sbcl.lisp"
65                "swank.lisp"))
66  (let* ((source-file (merge-pathnames file *load-truename*))
67         (binary-file (binary-pathname source-file)))
68    (ensure-directories-exist binary-file)
69    (if (and (probe-file binary-file)
70             (> (file-write-date binary-file)
71                (file-write-date source-file)))
72        (load binary-file)
73        (load (compile-file source-file :output-file binary-file)))))
74
75#-j
76(funcall (intern (string '#:start-server) '#:swank))
Note: See TracBrowser for help on using the repository browser.