Commit 96e47679 authored by Didier Verna's avatar Didier Verna
Browse files

A couple of improvements in the Lisp code.

parent db84e0dc
(asdf:defsystem quickref
:author "Antoine Martin"
:depends-on (:quicklisp
:alexandria
:split-sequence)
:serial t
:components ((:file "quickref")))
:author "Antoine Martin"
:depends-on (:quicklisp :alexandria :split-sequence)
:serial t
:components ((:file "quickref")))
(defpackage quickref
(:use :cl
:split-sequence)
(:use :cl :split-sequence)
(:import-from :alexandria
:starts-with-subseq)
(:export :print-primary-systems))
:starts-with-subseq)
(:export :print-primary-systems :get-primary-system-name))
(in-package :quickref)
(defun remove-cl-prefix (name)
......@@ -13,13 +12,11 @@
name))
(defun get-release-name (system)
(let ((system-release (ql-dist:release system)))
(ql-dist:name system-release)))
(ql-dist:name (ql-dist:release system)))
(defun get-provided-systems (release)
(let* ((all-provided-systems (ql-dist:provided-systems t))
(first-system-found (find release
all-provided-systems
(first-system-found (find release all-provided-systems
:key #'get-release-name
:test #'string=)))
(unless first-system-found
......@@ -33,13 +30,12 @@
(let ((project (remove-cl-prefix release))
(provided-systems (get-provided-systems release)))
(ql-dist:name
(or (find project
(reverse provided-systems)
(or (find project provided-systems
:key #'get-trimmed-system-name
:test #'string=)
(first (reverse provided-systems))))))
:test #'string=
:from-end t)
(car (last provided-systems))))))
(defun print-primary-systems ()
(let ((releases (ql-dist:provided-releases t)))
(dolist (release releases)
(print (get-primary-system-name (ql-dist:name release))))))
(dolist (release (ql-dist:provided-releases t))
(print (get-primary-system-name (ql-dist:name release)))))
......@@ -2,8 +2,12 @@
(ql:quickload "quickref")
(ql:quickload "net.didierverna.declt")
(let ((primary-system (quickref::get-primary-system-name cl-user::*qlmapper-object-name*)))
(let ((primary-system
(quickref:get-primary-system-name cl-user::*qlmapper-object-name*)))
;; #### TODO: encapsulate this into an error catching form.
(format t "STARTED BUILDING PACKAGE ~A~%" primary-system)
(ql:quickload primary-system)
;; #### TODO: See about providing more information to the DECLT call.
(net.didierverna.declt:declt primary-system)
(format t "FINISHED BUILDING PACKAGE ~A~%" primary-system))
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment