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

Contents of /slime/swank-loader.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.5 - (hide annotations)
Sun Nov 23 05:00:13 2003 UTC (10 years, 4 months ago) by lgorrie
Branch: MAIN
Changes since 1.4: +4 -2 lines
* swank-sbcl.lisp (describe-symbol-for-emacs): Don't ask for
(documentation SYM 'class), CLHS says there isn't any 'class
documentation (and SBCL warns).

* swank.lisp, swank-cmucl.lisp, swank-sbcl.lisp: Refactored
interface through swank-backend.lisp for: swank-compile-file,
swank-compile-string, describe-symbol-for-emacs (apropos),
macroexpand-all, arglist-string.

* swank-backend.lisp: New file defining the interface between
swank.lisp and the swank-*.lisp implementation 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 lgorrie 1.5 ;;; $Id: swank-loader.lisp,v 1.5 2003/11/23 05:00:13 lgorrie Exp $
11 jbielman 1.1 ;;;
12    
13     (defpackage :swank-loader
14     (:use :common-lisp))
15 heller 1.4
16 jbielman 1.1 (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 heller 1.3 (defparameter *sysdep-pathnames*
29     (mapcar #'make-swank-pathname
30     #+cmu '("swank-cmucl")
31     #+sbcl '("swank-sbcl" "swank-gray")
32     #+openmcl '("swank-openmcl" "swank-gray")))
33 jbielman 1.1
34     (defparameter *swank-pathname* (make-swank-pathname "swank"))
35    
36     (defun file-newer-p (new-file old-file)
37     "Returns true if NEW-FILE is newer than OLD-FILE."
38     (> (file-write-date new-file) (file-write-date old-file)))
39    
40 heller 1.4 (defun compile-files-if-needed-serially (files)
41 jbielman 1.1 "Compile each file in FILES if the source is newer than
42     its corresponding binary, or the file preceding it was
43     recompiled."
44     (let ((needs-recompile nil))
45     (dolist (source-pathname files)
46     (let ((binary-pathname (compile-file-pathname source-pathname)))
47     (handler-case
48     (progn
49     (when (or needs-recompile
50     (not (probe-file binary-pathname))
51     (file-newer-p source-pathname binary-pathname))
52 jbielman 1.2 (format t "~&;; Compiling ~A...~%" source-pathname)
53 jbielman 1.1 (compile-file source-pathname)
54     (setq needs-recompile t))
55     (load binary-pathname))
56     (error ()
57     ;; If an error occurs compiling, load the source instead
58     ;; so we can try to debug it.
59     (load source-pathname)))))))
60    
61 heller 1.4 (defun user-init-file ()
62     "Return a the name of the user init file or nil."
63     (let ((filename (format nil "~A/.swank.lisp"
64     (namestring (user-homedir-pathname)))))
65     (cond ((probe-file filename) filename)
66     (t nil))))
67    
68 lgorrie 1.5 (compile-files-if-needed-serially
69     (list* (make-swank-pathname "swank-backend") *swank-pathname*
70     *sysdep-pathnames*))
71 heller 1.4
72     (when (user-init-file)
73     (load (user-init-file)))
74 jbielman 1.1

  ViewVC Help
Powered by ViewVC 1.1.5