├── .gitignore ├── .travis.yml ├── Makefile ├── README.md ├── docs.lisp ├── quicksys.asd ├── run-tests.lisp ├── src ├── package.lisp └── quicksys.lisp └── t └── test.lisp /.gitignore: -------------------------------------------------------------------------------- 1 | system-index.txt 2 | doc/ 3 | tmp/ 4 | *.fasl 5 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | services: 2 | - docker 3 | 4 | script: make ci-check 5 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | LISP_FLAGS = --noinform --disable-debugger --load 2 | LISP := sbcl $(LISP_FLAGS) 3 | IMAGE = commonlispbr/emacs:sbcl 4 | 5 | check: 6 | @$(LISP) run-tests.lisp 7 | 8 | 9 | docs: 10 | rm -rf doc/ 11 | @$(LISP) docs.lisp 12 | @if which tidy > /dev/null; then \ 13 | echo Formatting HTML...; \ 14 | tidy -i -q -o doc/index.html \ 15 | doc/index.html || echo Finished!; \ 16 | fi 17 | 18 | ci-check: 19 | @docker run -t --entrypoint=/usr/bin/sbcl \ 20 | -v $(shell pwd):/workspace \ 21 | --security-opt seccomp=unconfined \ 22 | $(IMAGE) \ 23 | $(LISP_FLAGS) \ 24 | run-tests.lisp 25 | @docker run --entrypoint=/bin/rm -t \ 26 | -v $(shell pwd):/workspace \ 27 | $(IMAGE) \ 28 | -rf system-index.txt 29 | 30 | .PHONY: check 31 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | [![Build Status](https://travis-ci.org/commonlispbr/quicksys.svg?branch=master)](https://travis-ci.org/commonlispbr/quicksys) 2 | 3 | # Quicksys 4 | 5 | ## Description 6 | 7 | Quicksys is a tool for fetching Common Lisp systems, regardless of the Quicklisp 8 | distribution they are catalogued in. To achieve that, this software is purposely 9 | built as a hardcoded catalog of famous Quicklisp distributions, including: 10 | 11 | + cl-bodge 12 | + cl21 13 | + shirakumo 14 | + ultralisp 15 | 16 | You may also add your own distributions at your will. 17 | 18 | ## Motivation 19 | 20 | [Quicklisp](https://www.quicklisp.org/beta/) is an awesome tool for fetching 21 | systems, which you may use on your Common Lisp projects. However, Quicklisp only 22 | fetches systems from its central repository, by default. Adding a new repository 23 | implies manual management of distributions (here called _dists_), in order to 24 | fetch systems that are not in the central repo. 25 | 26 | In an effort to speed up the development of software in Common Lisp, we present 27 | Quicksys as a means of unifying some of the most popular distributions. This 28 | way, one can load specific systems, given that one also knows in which 29 | distribution it is; or even, one may also install a distribution on Quicklisp 30 | without ever manually configurating it. 31 | 32 | ## Requirements 33 | 34 | + A Common Lisp implementation 35 | + Quicklisp 36 | 37 | ## How to use 38 | 39 | Quicksys exports some symbols which may be easily used. The following 40 | instructions relate to the most important operations. 41 | 42 | ### Installing a system 43 | 44 | Systems may be loaded regardless of whether its dists were installed under 45 | Quicklisp or not. 46 | 47 | To install a system *from a dist that was not installed*, use the following: 48 | 49 | ```lisp 50 | (qs:quickload system-atom :dist dist-name) 51 | ``` 52 | 53 | Where `system-name` is the proper identifier for the desired system, and 54 | `dist-name` is a proper name for a dist -- see "Installing a dist". 55 | 56 | You may also use `qs:quickload` in the same way one would use `ql:quickload`. 57 | The effect is the same, for dists that are already installed. 58 | 59 | ### Installing a dist 60 | 61 | One may easily install a dist by using: 62 | 63 | ```lisp 64 | (qs:install-dist dist-name) 65 | ``` 66 | 67 | Where `dist-name` is a name (symbol or string) for a specific dist. 68 | Available dists may be listed using Quicksys' apropos command: 69 | 70 | ```lisp 71 | (qs:dist-apropos "") 72 | ``` 73 | 74 | This outputs a list of all available dists currently hardcoded, with their 75 | respective symbols and URLs. 76 | 77 | After installing a dist, you may install any system using Quicklisp or Quicksys 78 | normally. 79 | 80 | ### Removing a dist 81 | 82 | Just like installation, one may remove an already installed dist by using a 83 | single command: 84 | 85 | ```lisp 86 | (qs:uninstall-dist dist-name) 87 | ``` 88 | 89 | ## License 90 | 91 | This project is distributed under the MIT License. 92 | -------------------------------------------------------------------------------- /docs.lisp: -------------------------------------------------------------------------------- 1 | (pushnew (uiop/os:getcwd) asdf:*central-registry*) 2 | (ql:register-local-projects) 3 | (ql:quickload :quicksys :silent t) 4 | (ql:quickload :staple :silent t) 5 | 6 | (staple:generate :quicksys 7 | :packages '(#:quicksys)) 8 | 9 | (sb-ext:exit :code 0) 10 | -------------------------------------------------------------------------------- /quicksys.asd: -------------------------------------------------------------------------------- 1 | ;;;; quicksys.asd 2 | 3 | (asdf:defsystem #:quicksys 4 | :description "QUICKSYS install systems from multiple Quicklisp distributions" 5 | :author "Manoel Vilela & Lucas Vieira" 6 | :license "MIT" 7 | :version "0.1.0" 8 | :homepage "https://github.com/commonlispbr/quicksys" 9 | :bug-tracker "https://github.com/commonlispbr/quicksys/issues" 10 | :source-control (:git "https://github.com/commonlispbr/quicksys.git") 11 | :serial t 12 | :pathname "src" 13 | :depends-on (:quicklisp) 14 | :components ((:file "package") 15 | (:file "quicksys"))) 16 | 17 | (asdf:defsystem #:quicksys/test 18 | :description "QUICKSYS test suit" 19 | :author "Manoel Vilela & Lucas Vieira" 20 | :license "MIT" 21 | :version "0.1.0" 22 | :serial t 23 | :pathname "t" 24 | :depends-on (:quicksys :prove) 25 | :components ((:file "test")) 26 | :perform (asdf:test-op :after (op c) 27 | (funcall (intern #.(string :run) :prove) c))) 28 | -------------------------------------------------------------------------------- /run-tests.lisp: -------------------------------------------------------------------------------- 1 | (ql:quickload '(:prove) :silent t) 2 | (eval-when (:load-toplevel :execute) 3 | (pushnew (truename (sb-unix:posix-getcwd/)) 4 | ql:*local-project-directories*) 5 | (ql:register-local-projects) 6 | (ql:quickload :quicksys/test :silent t) 7 | (setf prove:*enable-colors* t) 8 | (if (prove:run "t/test.lisp") 9 | (sb-ext:exit :code 0) 10 | (sb-ext:exit :code 1))) 11 | -------------------------------------------------------------------------------- /src/package.lisp: -------------------------------------------------------------------------------- 1 | ;;;; package.lisp 2 | 3 | (defpackage #:quicksys 4 | (:use #:cl) 5 | (:nicknames :qs) 6 | (:export #:*dists* 7 | #:install-dist 8 | #:installedp 9 | #:uninstall-dist 10 | #:dist-name 11 | #:dist-url 12 | #:dist-properties 13 | #:get-dist 14 | #:get-dists-urls 15 | #:get-dists-names 16 | #:dist-apropos 17 | #:dist-apropos-list 18 | #:quickload) 19 | (:documentation 20 | "QUICKSYS provides a collection of tools to load systems from 21 | multiple quicklisp dists. 22 | 23 | EXAMPLES 24 | 25 | ;; search for a dist 26 | * (quicksys:dist-apropos '*) 27 | # 28 | # 29 | # 30 | # 31 | 32 | ;; install a dist 33 | * (quicksys:install-dist :ultralisp) 34 | 35 | 36 | ;; install a dist temporary just to load a system 37 | * (quicksys:quickload 'trivial-gamekit :dist 'bodge ) 38 | " 39 | )) 40 | -------------------------------------------------------------------------------- /src/quicksys.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | 3 | Manoel Vilela & Lucas Vieira © 2019 MIT 4 | 5 | |# 6 | 7 | (in-package #:quicksys) 8 | 9 | 10 | ;; DIST: alist :: key -> plist 11 | ;; key: symbol 12 | (defparameter *dists* 13 | '((bodge (:url "http://bodge.borodust.org/dist/org.borodust.bodge.txt" 14 | :realname org.borodust.bodge)) 15 | (bodge-testing (:url "http://bodge.borodust.org/dist/org.borodust.bodge.testing.txt" 16 | :realname org.borodust.bodge.testing)) 17 | (cl21 (:url "http://dists.cl21.org/cl21.txt")) 18 | (goheecus (:url "http://hyperprostor.g6.cz/ql/goheecus.txt")) 19 | (monkeylib (:url "http://www.gigamonkeys.com/quicklisp/monkeylib/current.txt")) 20 | (ultralisp (:url "http://dist.ultralisp.org")) 21 | (shirakumo (:url "http://dist.tymoon.eu/shirakumo.txt"))) 22 | "*DISTS* is an ALIST of PLISTS, each being one of the distributions available 23 | in QL-META.") 24 | 25 | 26 | 27 | (defun %dist-id (dist-name) 28 | "%DIST-ID converts DIST-NAME to an inner key representation." 29 | (if (typep dist-name 'string) 30 | (intern (string-upcase dist-name) :quicksys) 31 | (intern (symbol-name dist-name) :quicksys))) 32 | 33 | (defun %dist-realname (dist) 34 | "%DIST-REALNAME generates the name of a DIST as a downcase string." 35 | (string-downcase 36 | (symbol-name (or (getf (cadr dist) :realname) 37 | (car dist))))) 38 | 39 | (defun dist-string (dist) 40 | "DIST-STRING produces a DIST representation in a human-readable format." 41 | (format nil "#" 42 | (car dist) 43 | (dist-url dist))) 44 | 45 | (defun dist-properties (dist) 46 | "DIST-PROPERTIES returns the list of properties of a DIST." 47 | (cadr dist)) 48 | 49 | 50 | (defun dist-url (dist) 51 | "DIST-URL returns the url property of a DIST" 52 | (getf (dist-properties dist) :url)) 53 | 54 | 55 | (defun get-dist (dist-name) 56 | "GET-DIST retrieves a DIST based on DIST-NAME, if existing. Otherwise, returns NIL." 57 | (assoc (%dist-id dist-name) 58 | *dists*)) 59 | 60 | (defun get-dists-urls (&optional (dists *dists*)) 61 | "GET-DISTS-URLS returns a list of all dist urls defined in *DISTS*." 62 | (loop for dist in dists 63 | collect (dist-url dist))) 64 | 65 | 66 | (defun get-dists-names (&optional (dists *dists*)) 67 | "GET-DISTS-NAMES returns a list of all dist names defined in *DISTS*" 68 | (loop for (key plist) in dists 69 | collect key)) 70 | 71 | (defun installedp (dist) 72 | "INSTALLEDP checks whether a DIST was installed through QL-DIST." 73 | (let ((dist-obj (ql-dist:find-dist (%dist-realname dist)))) 74 | (and dist-obj (ql-dist:installedp dist-obj)))) 75 | 76 | (defun install-dist (dist-name &key (force nil)) 77 | "INSTALL-DIST installs a dist DIST-NAME using QL-DIST. 78 | 79 | As default, use the parameters (:prompt nil :replace t) on 80 | ql-dist:install-dist to avoid human interaction. 81 | 82 | If DIST-NAME doesn't exist as a key in *DISTS*, this function 83 | raises an error." 84 | (let ((dist (get-dist dist-name))) 85 | (cond ((null dist) 86 | (error (format nil "error: ~a not found" dist-name))) 87 | ((and (not force) 88 | (installedp dist)) t) 89 | (t (apply #'ql-dist:install-dist 90 | (cons (dist-url dist) 91 | '(:prompt nil :replace t))))))) 92 | 93 | (defun uninstall-dist (dist-name) 94 | "UNINSTALL-DIST a dist DIST-NAME using QL-DIST. 95 | 96 | Returns NIL on uninstallation error and when the dist DIST-NAME were not 97 | installed in the first place. Otherwise, returns T." 98 | (let ((dist (get-dist dist-name))) 99 | (when (and dist (installedp dist)) 100 | (let* ((dist-obj (ql-dist:find-dist (%dist-realname dist)))) 101 | (ql-dist:uninstall dist-obj))))) 102 | 103 | (defun quickload (system &key (dist nil) (silent nil)) 104 | "QUICKLOAD wraps QL:QUICKLOAD. 105 | 106 | If DIST is specified, QUICKLOAD will attempt to fetch the system from it. If the 107 | specified DIST were not installed prior to system installation, it is removed 108 | again. 109 | 110 | Specifying SILENT suppresses output." 111 | (let* ((%dist (get-dist dist)) 112 | (installed-before (and %dist (installedp %dist)))) 113 | (when dist 114 | (install-dist dist)) 115 | (ql:quickload system :silent silent) 116 | (unless installed-before 117 | (uninstall-dist dist)))) 118 | 119 | 120 | (defgeneric dist-apropos-list (term) 121 | (:documentation 122 | "DIST-APROPOS-LIST returns a list of DISTs based in a matching TERM. 123 | 124 | This function considers %dist-realname and dist-url when searching.") 125 | (:method ((term symbol)) 126 | (dist-apropos-list (symbol-name term))) 127 | (:method ((term string)) 128 | (let ((result '()) 129 | (nterm (remove-if (lambda (c) 130 | (eq c #\*)) 131 | (string-downcase term)))) 132 | (dolist (dist *dists* (nreverse result)) 133 | (when (or (search nterm (%dist-realname dist)) 134 | (search nterm (dist-url dist))) 135 | (push dist result)))))) 136 | 137 | (defgeneric dist-apropos (term) 138 | (:documentation 139 | "DIST-APROPOS searches for a dist containing TERM and prints it to *STANDARD-OUTPUT*. 140 | 141 | This function effectively wraps DIST-APROPOS-LIST so it is printed nicely on 142 | console.") 143 | (:method (term) 144 | (mapcan (lambda (dist) 145 | (format t "~A~%" (dist-string dist))) 146 | (dist-apropos-list term)) 147 | (values))) 148 | -------------------------------------------------------------------------------- /t/test.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:quicksys/test 2 | (:use #:cl 3 | #:prove) 4 | (:documentation "Collection of unit tests for QUICKSYS")) 5 | 6 | 7 | (in-package :quicksys/test) 8 | 9 | 10 | (setq quicksys:*dists* 11 | '((test1 (:url "http://test1.com")) 12 | (test2 (:url "http://test2.com")))) 13 | 14 | (plan nil) 15 | 16 | (diag "== Testing: get-dists-names & get-dists-urls!") 17 | 18 | (is (quicksys:get-dists-names) '(test1 test2) 19 | "get-dists-names test 1") 20 | (is (quicksys:get-dists-urls) '("http://test1.com" 21 | "http://test2.com") 22 | "get-dists-urls test 1") 23 | 24 | (diag "== Testing: get-dist!") 25 | (ok (typep (quicksys:get-dist :test1) 'list) 26 | "get-dist keyword") 27 | (ok (typep (quicksys:get-dist 'test2) 'list) 28 | "get-dist symbol") 29 | (is (quicksys:get-dist 'test3) nil 30 | "get-dist symbol invalid") 31 | (ok (typep (quicksys:get-dist "test2") 'list) 32 | "get-dist string") 33 | 34 | (diag "== Testing: dist-apropos-list!") 35 | 36 | (is quicksys:*dists* (quicksys:dist-apropos-list '*) 37 | "dist-apropos-list wildcard *") 38 | (is quicksys:*dists* (quicksys:dist-apropos-list "") 39 | "dist-apropos-list empty string") 40 | (is 'TEST1 (caar (quicksys:dist-apropos-list :test1)) 41 | "dist-apropos-list name search") 42 | (is '(TEST1 TEST2) (mapcar #'car (quicksys:dist-apropos-list ".com")) 43 | "dist-apropos-list url search") 44 | 45 | (finalize) 46 | --------------------------------------------------------------------------------