quickref.lisp 1.24 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
5
6
   :starts-with-subseq)
  (:export :print-primary-systems :get-primary-system-name))

Antoine Martin's avatar
Antoine Martin committed
7
8
(in-package :quickref)

Antoine Martin's avatar
Antoine Martin committed
9
10
11
12
13
(defun remove-cl-prefix (name)
  (if (starts-with-subseq "cl-" name)
      (subseq name 3)
      name))

14
(defun get-release-name (system)
15
  (ql-dist:name (ql-dist:release system)))
16

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

26
27
28
29
30
31
32
(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
33
     (or (find project provided-systems
34
	       :key #'get-trimmed-system-name
35
36
37
	       :test #'string=
	       :from-end t)
	 (car (last provided-systems))))))
38

Antoine Martin's avatar
Antoine Martin committed
39
(defun print-primary-systems ()
40
41
  (dolist (release (ql-dist:provided-releases t))
    (print (get-primary-system-name (ql-dist:name release)))))