File: common-lisp-controller.lisp

package info (click to toggle)
common-lisp-controller 4.15sarge3
  • links: PTS
  • area: main
  • in suites: sarge
  • size: 188 kB
  • ctags: 31
  • sloc: lisp: 361; sh: 215; makefile: 57
file content (125 lines) | stat: -rw-r--r-- 4,027 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
;;; -*- Mode: Lisp; Package: COMMON-LISP-CONTROLLER -*-
;;;
;;; Copyright (C) 2000,2004  Peter Van Eynde and Kevin M. Rosenberg
;;; Licensed under the LLGPL, see debian/copyright file


(in-package #:cl-user)

(defpackage #:common-lisp-controller
  (:use #:common-lisp)
  (:export #:init-common-lisp-controller
	   #:init-common-lisp-controller-v4
	   #:clc-require
	   #:clc-build-all-packages
	   ;; depricated:
	   #:make-clc-send-command-string
	   #:send-clc-command)
  (:nicknames #:clc
	      ; depricated:
	      #:c-l-c))


(in-package #:common-lisp-controller)


;; Some general utilities to make the
;; descriptions shorter

(defvar *fasl-type*
  (load-time-value
   (pathname-type
    (compile-file-pathname "foo.lisp")))
  "This is the type of compiled lisp files.")

(defvar *fasl-root* nil "Root of implementation's directories of binary files")
(defvar *source-root* #p"/usr/share/common-lisp/source/"
	"Root of source directories")
(defvar *systems-root* #p"/usr/share/common-lisp/systems/"
        "Root of systems directory")
(defvar *implementation-name* nil "The name of the implementation,
used to name the directory in /var/cache/common-lisp-controller")

(defun init-common-lisp-controller (fasl-root
                                    &key
                                    (source-root "/usr/share/common-lisp/")
                                    (version 2))
  (declare (ignore source-root version))
  ;; vodoo: extract the name of the implementation
  ;; from the old fasl directory... 
  (init-common-lisp-controller-v4
   (first
    (last
     (pathname-directory
      (parse-namestring
       fasl-root))))))

(defun init-common-lisp-controller-v4 (implementation-name)
  "configures common-lisp-controller. IMPLEMENTATION-NAME
is the name of this implementation.
Fasl's will be created in /var/cache/common-lisp-controller/<userid>/<implementation>"

  (setf *implementation-name* implementation-name)

  ;; force both parameters to directories...
  (let* ((fasl-root (merge-pathnames
		     (make-pathname
		      :directory
		      `(:relative "root" ,*implementation-name*))
		     #p"/var/cache/common-lisp-controller/")))
    (flet ((compile-and-load (package-name filename)
	     (let* ((file (parse-namestring filename))
		    (file-path
		     (merge-pathnames
		      (make-pathname :name (pathname-name file)
				     :type (pathname-type file)
				     :directory (list :relative package-name))
		      *source-root*))
		    (output-path
		     (merge-pathnames
		      (make-pathname :name (pathname-name file)
				     :type (pathname-type file)
				     :directory (list :relative package-name))
		      fasl-root))
		    (compiled-file-pathname
		     (compile-file-pathname output-path)))
	       ;; first make the target directory:
	       (ensure-directories-exist compiled-file-pathname)
	       ;; now compile it:
	       (compile-file file-path
			     :output-file compiled-file-pathname
			     :print nil
			     :verbose nil)
	       ;; then load it:
	       (load compiled-file-pathname))))
      ;; first ourselves:
      (compile-and-load  "common-lisp-controller"
			 "common-lisp-controller.lisp")
      ;; then asdf:
      ;; For SBCL, take advantage of it's REQUIRE/contrib directories integration
      #+sbcl
      (when (boundp 'sb-ext::*module-provider-functions*)
	(pushnew :sbcl-hooks-require cl:*features*))
      (compile-and-load  "asdf" "asdf.lisp")
      (compile-and-load  "asdf" "wild-modules.lisp")
      ;; now patch it::
      (compile-and-load "common-lisp-controller"
			"post-sysdef-install.lisp")
      #+sbcl
      (setq cl:*features* (delete :sbcl-hooks-require  cl:*features*))

      ;; register the systems root:
      (push *systems-root*
	    (symbol-value (intern (symbol-name :*central-registry*)
				  (find-package :asdf))))

      (push '(merge-pathnames ".clc/systems/" 
			      (user-homedir-pathname))
	     (symbol-value (intern (symbol-name :*central-registry*)
			           (find-package :asdf))))))
  (values))