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

Diff of /slime/swank-loader.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.44 by lgorrie, Sun Mar 13 00:39:41 2005 UTC revision 1.45 by heller, Wed Mar 16 22:07:44 2005 UTC
# Line 24  Line 24 
24    (mapcar #'make-swank-pathname    (mapcar #'make-swank-pathname
25            (append            (append
26             '("nregex")             '("nregex")
27             #+cmu '("swank-source-path-parser"  "swank-source-file-cache" "swank-cmucl")             #+cmu '("swank-source-path-parser" "swank-source-file-cache"
28             #+sbcl '("swank-sbcl" "swank-source-path-parser" "swank-source-file-cache" "swank-gray")                     "swank-cmucl")
29               #+sbcl '("swank-sbcl" "swank-source-path-parser"
30                        "swank-source-file-cache" "swank-gray")
31             #+openmcl '("metering" "swank-openmcl" "swank-gray")             #+openmcl '("metering" "swank-openmcl" "swank-gray")
32             #+lispworks '("swank-lispworks" "swank-gray")             #+lispworks '("swank-lispworks" "swank-gray")
33             #+allegro '("swank-allegro" "swank-gray")             #+allegro '("swank-allegro" "swank-gray")
# Line 34  Line 36 
36             )))             )))
37    
38  (defparameter *implementation-features*  (defparameter *implementation-features*
39    '(:allegro :sbcl :openmcl :cmu :clisp :ccl :corman :armedbear :gcl))    '(:allegro :sbcl :openmcl :cmu :clisp :ccl :corman :armedbear))
40    
41  (defparameter *os-features*  (defparameter *os-features*
42    '(:macosx :linux :windows :mswindows :solaris :darwin :sunos :unix))    '(:macosx :linux :windows :mswindows :solaris :darwin :sunos :unix))
# Line 42  Line 44 
44  (defparameter *architecture-features*  (defparameter *architecture-features*
45    '(:powerpc :ppc :x86 :x86-64 :i686 :pc386 :sparc))    '(:powerpc :ppc :x86 :x86-64 :i686 :pc386 :sparc))
46    
47    (defun lisp-version-string ()
48      #+cmu       (substitute #\- #\/ (lisp-implementation-version))
49      #+sbcl      (lisp-implementation-version)
50      #+openmcl   (format nil "~d.~d"
51                          ccl::*openmcl-major-version*
52                          ccl::*openmcl-minor-version*)
53      #+lispworks (lisp-implementation-version)
54      #+allegro   excl::*common-lisp-version-number*
55      #+clisp     (let ((s (lisp-implementation-version)))
56                    (subseq s 0 (position #\space s)))
57      #+armedbear (lisp-implementation-version))
58    
59  (defun unique-directory-name ()  (defun unique-directory-name ()
60    "Return a name that can be used as a directory name that is    "Return a name that can be used as a directory name that is
61  unique to a Lisp implementation, Lisp implementation version,  unique to a Lisp implementation, Lisp implementation version,
62  operating system, and hardware architecture."  operating system, and hardware architecture."
63    (flet ((first-of (features)    (flet ((first-of (features)
64             (loop for f in features             (loop for f in features
65                when (find f *features*) return it)))                   when (find f *features*) return it))
66      (let ((lisp         (first-of *implementation-features*))           (maybe-warn (value fstring &rest args)
67            (os           (first-of *os-features*))             (cond (value)
68            (architecture (first-of *architecture-features*))                   (t (apply #'warn fstring args)
69            (version                      "unknown"))))
70             (block nil      (let ((lisp (maybe-warn (first-of *implementation-features*)
71               #+cmu                              "No implementation feature found in ~a."
72               (return (substitute #\- #\/ (lisp-implementation-version)))                              *implementation-features*))
73               #+sbcl            (os   (maybe-warn (first-of *os-features*)
74               (return (lisp-implementation-version))                              "No os feature found in ~a." *os-features*))
75               #+gcl            (arch (maybe-warn (first-of *architecture-features*)
76               (let ((s (lisp-implementation-version))) (subseq s 4))                              "No architecture feature found in ~a."
77               #+openmcl                              *architecture-features*))
78               (return (format nil "~d.~d"            (version (maybe-warn (lisp-version-string)
79                               ccl::*openmcl-major-version*                                 "Don't know how to get Lisp ~
80                               ccl::*openmcl-minor-version*))                                  implementation version.")))
81               #+lispworks        (format nil "~(~@{~a~^-~}~)" lisp version os arch))))
              (return (lisp-implementation-version))  
              #+allegro  
              (return excl::*common-lisp-version-number*)  
              #+clisp  
              (return (let ((s (lisp-implementation-version)))  
                        (subseq s 0 (position #\space s))))  
              #+armedbear  
              (return "unknown")  
   
              (warn "Don't know how to get Lisp implementation version.")  
              (return "unknown"))))  
   
       (unless lisp  
         (warn "No implementation feature found in ~a."  
               *implementation-features*)  
         (setf lisp "unknown"))  
       (unless os  
         (warn "No os feature found in ~a." *os-features*)  
         (setf os "unknown"))  
       (unless architecture  
         (warn "No architecture feature found in ~a."  
               *architecture-features*)  
         (setf architecture "unknown"))  
   
       (format nil "~(~@{~a~^-~}~)" lisp version os architecture))))  
82    
83  (defparameter *swank-pathname* (make-swank-pathname "swank"))  (defparameter *swank-pathname* (make-swank-pathname "swank"))
84    

Legend:
Removed from v.1.44  
changed lines
  Added in v.1.45

  ViewVC Help
Powered by ViewVC 1.1.5