quickref.lisp 1.75 KB
Newer Older
Antoine Martin's avatar
Antoine Martin committed
1
(defpackage quickref
2
  (:use :cl :split-sequence)
Antoine Martin's avatar
Antoine Martin committed
3
  (:import-from :alexandria
4
   :starts-with-subseq)
5
6
  (:export :print-primary-systems
	   :get-primary-system-name
Antoine Martin's avatar
Antoine Martin committed
7
	   :build-texis
Antoine Martin's avatar
Antoine Martin committed
8
	   :build-index
Antoine Martin's avatar
Antoine Martin committed
9
10
	   :build-releases
	   :refresh))
11

Antoine Martin's avatar
Antoine Martin committed
12
13
(in-package :quickref)

Antoine Martin's avatar
Antoine Martin committed
14
15
16
17
18
(defun remove-cl-prefix (name)
  (if (starts-with-subseq "cl-" name)
      (subseq name 3)
      name))

19
(defun get-release-name (system)
20
  (ql-dist:name (ql-dist:release system)))
21

22
23
(defun get-provided-systems (release)
  (let* ((all-provided-systems (ql-dist:provided-systems t))
24
	 (first-system-found (find release all-provided-systems
25
26
				   :key #'get-release-name
				   :test #'string=)))
27
28
    (unless first-system-found
      (error "Release not found"))
29
    (ql-dist:provided-systems (ql-dist:release first-system-found))))
Antoine Martin's avatar
Antoine Martin committed
30

31
32
33
34
35
36
37
(defun get-trimmed-system-name (system)
  (remove-cl-prefix (ql-dist:name system)))

(defun get-primary-system-name (release)
  (let ((project (remove-cl-prefix release))
	(provided-systems (get-provided-systems release)))
    (ql-dist:name
38
     (or (find project provided-systems
39
	       :key #'get-trimmed-system-name
40
41
42
	       :test #'string=
	       :from-end t)
	 (car (last provided-systems))))))
43

Antoine Martin's avatar
Antoine Martin committed
44
(defun print-primary-systems ()
45
46
  (dolist (release (ql-dist:provided-releases t))
    (print (get-primary-system-name (ql-dist:name release)))))
Antoine Martin's avatar
Antoine Martin committed
47
48
49
50
51

(defun build-releases ()
  (qlmapper:map-releases
   (concatenate 'string
		(namestring (asdf:system-source-directory "quickref"))
Antoine Martin's avatar
Antoine Martin committed
52
		"map-declt.lisp")))
53
54
55
56
57
58
59
60
61
62

(defun uninstall-releases ()
  (dolist (release (ql-dist:provided-releases t))
    (ql-dist:uninstall release)))

(defun refresh (makeinfo-path)
  (uninstall-releases)
  (ql:update-all-dists :prompt nil)
  (ql:update-client :prompt nil)
  (build-releases)
63
  (build-texis makeinfo-path)
64
  (build-index))