lispdoc: implemented the whole URI syntax; updated URIs in all docstrings to be writt...
[com-informatimago:com-informatimago.git] / tools / clext-compile.lisp
1 ;;;; -*- coding:utf-8 -*-
2 ;;;;****************************************************************************
3 ;;;;FILE:               compile.lisp
4 ;;;;LANGUAGE:           Common-Lisp
5 ;;;;SYSTEM:             Common-Lisp
6 ;;;;USER-INTERFACE:     NONE
7 ;;;;DESCRIPTION
8 ;;;;    
9 ;;;;    Replaces the Makefile.
10 ;;;;    
11 ;;;;    Usage:   (load "compile.lisp")
12 ;;;;
13 ;;;;    will compile all outdated files.
14 ;;;;
15 ;;;;AUTHORS
16 ;;;;    <PJB> Pascal J. Bourguignon <pjb@informatimago.com>
17 ;;;;MODIFICATIONS
18 ;;;;    2005-08-13 <PJB> Added generation of ASD file and use of ASDF.
19 ;;;;    2004-07-23 <PJB> Created.
20 ;;;;BUGS
21 ;;;;LEGAL
22 ;;;;    AGPL3
23 ;;;;    
24 ;;;;    Copyright Pascal J. Bourguignon 2004 - 2012
25 ;;;;    
26 ;;;;    This program is free software: you can redistribute it and/or modify
27 ;;;;    it under the terms of the GNU Affero General Public License as published by
28 ;;;;    the Free Software Foundation, either version 3 of the License, or
29 ;;;;    (at your option) any later version.
30 ;;;;    
31 ;;;;    This program is distributed in the hope that it will be useful,
32 ;;;;    but WITHOUT ANY WARRANTY; without even the implied warranty of
33 ;;;;    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
34 ;;;;    GNU Affero General Public License for more details.
35 ;;;;    
36 ;;;;    You should have received a copy of the GNU Affero General Public License
37 ;;;;    along with this program.  If not, see <http://www.gnu.org/licenses/>
38 ;;;;****************************************************************************
39
40 ;; (defpackage "COM.INFORMATIMAGO.COMMON-LISP.COMPILE"
41 ;;   (:use "COMMON-LISP")
42 ;;   (:export "MAIN"))
43 ;; (in-package "COM.INFORMATIMAGO.COMMON-LISP.COMPILE")
44
45
46 ;;; Not used yet:
47 (defvar *prefix* "/usr/local/")
48 (defvar *module* "clext")
49 (defvar *package-path* "com/informatimago/clext")
50 ;;; ----
51
52 (defun logger (ctrl &rest args)
53   (format *trace-output* "~&;;;;~%;;;; ~?~%;;;;~%" ctrl args))
54 (logger "*** COMPILING COM.INFORMATIMAGO.CLEXT ***")
55
56 (load "init.lisp")
57 ;; package.lisp is loaded by init.lisp.
58 #+(or allegro ccl ecl) (load (compile-file #p"PACKAGES:net;sourceforge;cclan;asdf;asdf.lisp"))
59 #-(or allegro ccl ecl) (load (compile-file #p"PACKAGES:NET;SOURCEFORGE;CCLAN;ASDF;ASDF.LISP"))
60 (push (function package:package-system-definition)
61       asdf:*system-definition-search-functions*)
62
63 (asdf:oos 'asdf:load-op :com.informatimago.common-lisp)
64 (unless (fboundp 'com.informatimago.common-lisp.html-generator.html:title)
65   (error "~S is not fbound" 'com.informatimago.common-lisp.html-generator.html:title))
66
67 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
68
69 (defparameter *sources*
70   '(
71     closer-weak
72     ;; closer-weak-test.lisp
73     ;; tests.lisp
74     )) ;;*SOURCES*
75
76 (defparameter *source-type* "lisp")
77
78
79 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
80
81 (defun version++ (&optional path)
82   "
83 DO:      Increment the version compilation number.
84          The version is persistent, stored in a file named VERSION.DAT
85          in the same directory as *LOAD-PATHNAME*, or at PATH.
86 RETURN:  The version as a string \"major.minor.compilation\"
87 "
88   (flet ((read-version (file)
89            (loop
90               :for line = (read-line file nil nil)
91               :for =pos = (when line (position (character "=") line))
92               :while line
93               :when =pos
94               :collect (list (intern (string-upcase (subseq line 0 =pos)) "KEYWORD")
95                              (read-from-string (subseq line (1+ =pos)))))))
96     (let* ((default-path       (or *load-pathname* *default-pathname-defaults*))
97            (version.path       (or path 
98                                    (make-pathname :name "VERSION" :type "DAT"
99                                                   :version :newest
100                                                   :defaults default-path)))
101            (version             (with-open-file (file version.path
102                                                       :direction :input
103                                                       :if-does-not-exist :error)
104                                   (read-version file)))
105            (version.major           (or (second (assoc :major       version)) 0))
106            (version.minor           (or (second (assoc :minor       version)) 0))
107            (version.compilation (1+ (or (second (assoc :compilation version)) 0)))
108            (new-version `((:major       ,version.major)
109                           (:minor       ,version.minor)
110                           (:compilation ,version.compilation))))
111       (with-open-file (file version.path
112                             :direction :output
113                             :if-does-not-exist :create
114                             :if-exists :supersede)
115         (format file "~(~:{~A=~A~%~}~)" new-version))
116       (values (format nil "~A.~A.~A"
117                       version.major version.minor version.compilation)
118               version.major version.minor version.compilation))))
119
120
121 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
122 ;;; Generate the asdf system file, loading the sources.
123
124 (logger "GENERATING THE ASDF SYSTEM FILE")
125
126 (handler-bind ((warning #'muffle-warning))
127   (com.informatimago.common-lisp.make-depends.make-depends:generate-asd
128    :com.informatimago.clext *sources* *source-type*
129    :version (version++)
130    :licence "GPL"
131    :depends-on '()
132    :implicit-dependencies '()
133    :vanillap t))
134
135
136
137 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
138 ;;; Now, we generate a summary.html page.
139 ;;;
140 (logger "GENERATING THE SUMMARY.HTML")
141 (handler-bind ((warning #'muffle-warning))
142   (com.informatimago.common-lisp.make-depends.make-depends:generate-summary
143    *sources*
144    :verbose t
145    :source-type *source-type*
146    :summary-path "summary.html"
147    :repository-url (lambda (pp)
148                      (format nil
149                              ;; "http://darcs.informatimago.com~
150                              ;;  /darcs/public/lisp/~(~A/~A~).lisp"
151                              ;; "com/informatimago/~(~A/~A~).lisp"
152                              "~(~*~A~).lisp"
153                              (car (last (pathname-directory pp)))
154                              (pathname-name pp)))))
155
156
157 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
158 ;;; Cleanup before asdf:load-op:
159 ;;; we delete the package to let asdf:load-op load them cleanly.
160 ;;;
161
162 (logger "CLEANING THE LOADED PACKAGES")
163
164 (defun package-use*-package-p (p q)
165   "
166 RETURN: Whether the package P uses the package Q, or a package 
167         that uses the package Q.
168 NOTE:   By definition, (PACKAGE-USE*-PACKAGE-P X X)
169 "
170   (setf p (find-package p)
171         q (find-package q))
172   (loop
173      :with processed = '()
174      :with used = (list p)
175      :while used
176      ;; :do (print (list used processed))
177      :do (let ((current (pop used)))
178            (if (eq current q)
179                (return-from package-use*-package-p t)
180                (progn
181                  (push current processed)
182                  (dolist (new (package-use-list current))
183                    (unless (member new processed)
184                      (pushnew new used))))))
185      :finally (return-from package-use*-package-p nil)))
186
187
188 (defun topological-sort (nodes lessp)
189   "
190 RETURN: A list of NODES sorted topologically according to 
191         the partial order function LESSP.
192         If there are cycles (discounting reflexivity), 
193         then the list returned won't contain all the NODES.
194 "
195   (loop
196      :with sorted = '()
197      :with incoming = (map 'vector (lambda (to)
198                                      (loop
199                                         :for from :in nodes
200                                         :when (and (not (eq from to))
201                                                    (funcall lessp from to))
202                                         :sum 1))
203                            nodes)
204      :with q = (loop
205                   :for node :in nodes
206                   :for inco :across incoming
207                   :when (zerop inco)
208                   :collect node) 
209      :while q
210      :do (let ((n (pop q)))
211            (push n sorted)
212            (loop
213               :for m :in nodes
214               :for i :from 0
215               :do (when (and (and (not (eq n m))
216                                   (funcall lessp n m))
217                              (zerop (decf (aref incoming i))))
218                     (push m q))))
219      :finally (return (nreverse sorted))))
220
221
222 ;; (defun print-graph (nodes edge-predicate)
223 ;;   (flet ((initiale (package)
224 ;;            (if (< (length "COM.INFORMATIMAGO.COMMON-LISP.")
225 ;;                   (length (package-name package)))
226 ;;                (subseq (package-name package)
227 ;;                        (length "COM.INFORMATIMAGO.COMMON-LISP.")
228 ;;                        (1+ (length "COM.INFORMATIMAGO.COMMON-LISP.")))
229 ;;                (subseq (package-name package) 0 1))))
230 ;;     (let* ((nodes (coerce nodes 'vector))
231 ;;            (width (ceiling (log (length nodes) 10))))
232 ;;       (loop
233 ;;          :for i :from 0
234 ;;          :for node :across nodes
235 ;;          :initially (format t "~2%")
236 ;;          :do (format t " ~VD: ~A~%" width i node)
237 ;;          :finally (format t "~2%"))
238 ;;       (loop
239 ;;          :for j :from 0 :below (length nodes)
240 ;;          :initially (format t " ~VD " width "")
241 ;;          :do (format t " ~VD" width j)
242 ;;          :finally (format t "~%"))
243 ;;       (loop
244 ;;          :for i :from 0 :below (length nodes)
245 ;;          :do (loop
246 ;;                 :for j :from 0 :below (length nodes)
247 ;;                 :initially (format t "~A ~VD:"  (initiale (aref nodes i)) width i)
248 ;;                 :do (format t " ~VD"
249 ;;                             width
250 ;;                             (if (funcall edge-predicate
251 ;;                                          (aref nodes i) (aref nodes j))
252 ;;                                 (concatenate 'string
253 ;;                                   (initiale (aref nodes i))
254 ;;                                   (initiale (aref nodes j)))
255 ;;                                  ""))
256 ;;                 :finally (format t "~%"))
257 ;;          :finally (format t "~%")))))
258
259
260
261 ;;; With topological-sort, we mustn't use a total order function like this one:
262 ;; (defun package<= (p q)
263 ;;   (cond ((eq p q) t)
264 ;;         ((package-use*-package-p p q)
265 ;;          (assert (not (package-use*-package-p q p))
266 ;;                  (p q) "A circle could happen but it should not.")
267 ;;          t)                                ; p<q
268 ;;         ((package-use*-package-p q p) nil) ; p>q
269 ;;         (t (string<= (package-name p) (package-name q)))))
270
271
272
273 (dolist (p (let* ((nodes
274                     (delete-if-not
275                      (lambda (p)
276                        (let ((prefix "COM.INFORMATIMAGO.CLMISC."))
277                          (and (<  (length prefix) (length (package-name p)))
278                               (string= prefix (package-name p)
279                                        :end2 (length prefix)))))
280                      (copy-list (list-all-packages))))
281                    (sorted
282                     (topological-sort nodes
283                                       (function package-use*-package-p)))
284                    (cyclic (set-difference nodes sorted)))
285               (when cyclic
286                 (format t "Cyclic nodes = ~S~%" cyclic))
287               (nconc cyclic sorted)))
288   (delete-package p))
289
290
291
292
293 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
294 ;;; Finally, we compile and load the system
295 ;;;
296
297 (logger "COMPILING THE ASDF SYSTEM")
298 (setf asdf:*compile-file-warnings-behaviour* :ignore)
299 (let ((*load-verbose* t)
300       (*compile-verbose* t)
301       (asdf::*verbose-out* t))
302   (asdf:operate 'asdf:load-op :com.informatimago.clext))
303
304
305
306
307
308 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;