From 5b8a4ddf32d32df2435b644dfc1ab45a266eafff Mon Sep 17 00:00:00 2001 From: Alexander Artemenko Date: Sun, 7 Feb 2021 16:43:25 +0300 Subject: [PATCH] Setup-lisp action was factored out into a separate repository. --- .github/actions/build-docs/action.yml | 52 ---- .github/actions/build-docs/upload.ros | 247 ------------------ .github/actions/run-tests/action.yml | 19 -- .github/actions/run-tests/run-tests.ros | 89 ------- ChangeLog.rst | 25 +- .../setup-lisp/action.yml => action.yml | 0 cl-info-docs.asd | 6 - cl-info-test.asd | 12 - cl-info.asd | 27 -- docs/scripts/build.ros | 163 ------------ docs/source/docs.lisp | 168 ------------ qlfile | 2 - qlfile.lock | 8 - roswell/cl-info.ros | 38 --- src/core.lisp | 195 -------------- t/core.lisp | 20 -- .../scripts/templater.ros => templater.ros | 0 version.lisp-expr | 1 - 18 files changed, 1 insertion(+), 1071 deletions(-) delete mode 100644 .github/actions/build-docs/action.yml delete mode 100755 .github/actions/build-docs/upload.ros delete mode 100644 .github/actions/run-tests/action.yml delete mode 100755 .github/actions/run-tests/run-tests.ros rename .github/actions/setup-lisp/action.yml => action.yml (100%) delete mode 100644 cl-info-docs.asd delete mode 100644 cl-info-test.asd delete mode 100644 cl-info.asd delete mode 100755 docs/scripts/build.ros delete mode 100644 docs/source/docs.lisp delete mode 100644 qlfile delete mode 100644 qlfile.lock delete mode 100755 roswell/cl-info.ros delete mode 100644 src/core.lisp delete mode 100644 t/core.lisp rename .github/actions/scripts/templater.ros => templater.ros (100%) delete mode 100644 version.lisp-expr diff --git a/.github/actions/build-docs/action.yml b/.github/actions/build-docs/action.yml deleted file mode 100644 index 4c9c171..0000000 --- a/.github/actions/build-docs/action.yml +++ /dev/null @@ -1,52 +0,0 @@ -name: 'Build Docs' - -inputs: - asdf-system: - description: 'ASDF system to build system for' - required: true - qlfile-template: - description: "Djula template for qlfile. All environment variables are available in it's context" - required: false - ngrok-auth-token: - description: "A token to debug processes." - required: false - -runs: - using: composite - steps: - - name: Install Documentation Builder - shell: bash - run: | - echo ::group::Install Documentation Builder - - echo 'github docs-builder 40ants/docs-builder' >> qlfile - echo 'github ngrok 40ants/ngrok' >> qlfile - - qlot update - - qlot exec ros install docs-builder - qlot exec ros install ngrok - echo ::endgroup:: - - name: Build Docs - id: build-docs - shell: bash - run: | - set -Eeuo pipefail - echo ::group::Build Docs - - build-docs ${{ inputs.asdf-system }} output.dir - - echo ::endgroup:: - - - name: Upload Docs - shell: bash - run: | - set -Eeuo pipefail - echo ::group::Upload Docs - - ${{ github.action_path }}/upload.ros "$(cat output.dir)" - - echo ::endgroup:: - env: - GITHUB_TOKEN: ${{ github.token }} - NGROK_AUTH_TOKEN: ${{ inputs.ngrok-auth-token }} diff --git a/.github/actions/build-docs/upload.ros b/.github/actions/build-docs/upload.ros deleted file mode 100755 index d58b551..0000000 --- a/.github/actions/build-docs/upload.ros +++ /dev/null @@ -1,247 +0,0 @@ -#!/bin/sh -#|-*- mode:lisp -*-|# -#| -exec ros -Q -- $0 "$@" -|# -(progn ;;init forms - (ros:ensure-asdf) - #+quicklisp - (ql:quickload '(log4cl - ngrok/slynk) - :silent t)) - -(defpackage :ros.script.upload - (:use :cl)) -(in-package :ros.script.upload) - - -(defvar *current-dir*) - - -(define-condition unable-to-proceed (simple-error) - ((message :initarg :message - :reader get-message)) - (:report (lambda (condition stream) - (format stream (get-message condition))))) - - -(define-condition subprocess-error-with-output (uiop::subprocess-error) - ((stdout :initarg :stdout :reader subprocess-error-stdout) - (stderr :initarg :stderr :reader subprocess-error-stderr)) - (:report (lambda (condition stream) - (format stream "Subprocess ~@[~S~% ~]~@[with command ~S~% ~]exited with error~@[ code ~D ~]~@[~%STDOUT:~% ~S~]~@[~%STDERR:~% ~S~]" - (uiop:subprocess-error-process condition) - (uiop:subprocess-error-command condition) - (uiop:subprocess-error-code condition) - (subprocess-error-stdout condition) - (subprocess-error-stderr condition))))) - - -(defun run (command &key (raise t)) - "Runs command and returns it's stdout stderr and code. - -If there was an error, raises subprocess-error-with-output, but this -behaviour could be overriden by keyword argument ``:raise t``." - - (multiple-value-bind (stdout stderr code) - (uiop:run-program command - :output '(:string :stripped t) - :error-output '(:string :stripped t) - :ignore-error-status t) - - (when (and raise - (not (eql code 0))) - (error 'subprocess-error-with-output - :stdout stdout - :stderr stderr - :code code - :command command)) - (values stdout stderr code))) - - -(defun gh-pages-repository-initialized-p (docs-dir) - "Checks if repository for documentation already initialized" - (uiop:directory-exists-p (uiop:merge-pathnames* #P".git/" - docs-dir))) - - -(defun git (&rest commands) - "Calls git command in gh-pages repository." - - (uiop:with-current-directory (*current-dir*) - (let ((command (apply #'concatenate 'string - "git " - commands))) - - (log:info "Running" command "in" *current-dir*) - (run command)))) - - -(defun git-repository-was-changed-p () - ;; Here we only interested in entries which are starting from 1 (changed in porcelain v2 format). - ;; And not in qlfile and qlfile.lock. - ;; The "cat" at the end is to make 0 status code if there is no changed files. - ;; Because we only want an output from grep. - (> (length (git "status --porcelain=v2 | grep '^1' | grep -v -e qlfile | cat")) - 0)) - - -(defun get-git-upstream () - ;; taken from http://stackoverflow.com/a/9753364/70293 - (let ((upstream (run "git rev-parse --abbrev-ref --symbolic-full-name @{u}" :raise nil))) - (when (> (length upstream) - 0) - (subseq upstream - 0 - (search "/" upstream))))) - - -(defun get-origin-to-push () - (cond - ;; If we are running inside github actions - ((uiop:getenv "GITHUB_ACTIONS") - (unless (uiop:getenv "GITHUB_TOKEN") - (error 'unable-to-proceed - :message "Please, provide GITHUB_TOKEN environment variable.")) - (format nil "https://~A:~A@github.com/~A" - (uiop:getenv "GITHUB_ACTOR") - (uiop:getenv "GITHUB_TOKEN") - (uiop:getenv "GITHUB_REPOSITORY"))) - ;; otherwise make it from travis secret token and repo slug - ((uiop:getenv "TRAVIS_REPO_SLUG") - (let ((repo-slug (uiop:getenv "TRAVIS_REPO_SLUG")) - (repo-token (uiop:getenv "GH_REPO_TOKEN"))) - - (unless (and repo-slug repo-token) - (error 'unable-to-proceed - :message "Current branch does not track any upstream and there is no TRAVIS_REPO_SLUG and GH_REPO_TOKEN env variables. Where to push gh-pages branch?")) - - (format nil "https://~A@github.com/~A" - repo-token - repo-slug))) - ;; If there is already some remote upstream, then use it - (t - (let ((upstream (get-git-upstream))) - (cond - (upstream - (run (concatenate 'string "git remote get-url " upstream))) - (t - (log:error "Unable to guess correct upstream URL") - (values nil))))))) - - -(defun push-gh-pages (docs-dir) - (log:info "Pushing changes to gh-pages branch") - - (let ((*current-dir* docs-dir)) - - (unless (gh-pages-repository-initialized-p docs-dir) - (git "init") - - (git "remote add origin " - (get-origin-to-push))) - - (git "add .") - - (cond - ((git-repository-was-changed-p) - (when (uiop:getenv "GITHUB_ACTIONS") - (git "config --global user.name \"github-actions[bot]\"") - (git "config --global user.email \"actions@github.com\"")) - (git "commit -m 'Update docs'") - - (git "push --force origin master:gh-pages")) - ;; or - (t (log:info "Everything is up to date.")))) - (values)) - - -(defun push-local-changes () - "Some documentation builders, like MGL-PAX, - can update README file as well. In this case, we need - to push the file into the current branch of the repository." - (let ((*current-dir* (probe-file #P""))) - (macrolet ((if-there-are-changes (&body body) - `(cond - ((git-repository-was-changed-p) - (log:info "Pushing local changes to the repository") - ,@body) - (t - (log:info "There is no local changes."))))) - (flet ((make-commit () - (git "add -u") - - ;; We don't want to commit changes to qlfile, - ;; because documentation builders might change them: - (git "reset qlfile*") - - (when (uiop:getenv "GITHUB_ACTIONS") - - (git "config --global user.name \"github-actions[bot]\"") - (git "config --global user.email \"actions@github.com\"")) - - (git "commit -m 'Update docs'"))) - (cond - ((uiop:getenv "GITHUB_HEAD_REF") - (let ((ref (uiop:getenv "GITHUB_HEAD_REF"))) - - ;; Inside github action we are running on - ;; detached commit. Github takes last commit - ;; from the "master" branch and merges - ;; a branch from pull-request settings. - ;; - ;; To push changes back, we need to change - ;; our HEAD back to the pull-request's reference: - (git "checkout " ref) - ;; Here we need to check again if - (if-there-are-changes - (make-commit) - (git "remote add upstream " - (get-origin-to-push)) - (git "push upstream HEAD:" ref)))) - (t - (if-there-are-changes - (make-commit) - (git "push"))))))) - (values)) - - -(defun main (&rest argv) - (log:info "Uploading documentation") - - (unless argv - (log:error "Please, specify a directory with HTML docs.") - (uiop:quit 1)) - - (let ((docs-dir (uiop:parse-unix-namestring (first argv) - :ensure-directory t))) - - (handler-bind ((error (lambda (condition) - (uiop:print-condition-backtrace condition :stream *error-output*) - (uiop:quit 1)))) - (unless (probe-file docs-dir) - (log:error "Directory \"~A not found" - docs-dir) - (uiop:quit 1)) - - (uiop:with-output-file (s (uiop:merge-pathnames* #P".nojekyll" - docs-dir) - :if-exists :overwrite) - (declare (ignorable s))) - - (unless (string= (or (uiop:getenv "NGROK_AUTH_TOKEN") - ;; If var is not given, uiop will return NIL, - ;; but inside github action, not required arguments - ;; are empty strings and env var will be empty string. - "") - "") - (let ((url (ngrok/slynk:start 4005))) - (when url - (log:info "Waiting for connection to ~A" url) - (log:info "do touch ~~/continue to let process continue" ) - (loop - until (probe-file "~/continue") - do (sleep 5))))) - - (push-gh-pages docs-dir) - (push-local-changes)))) diff --git a/.github/actions/run-tests/action.yml b/.github/actions/run-tests/action.yml deleted file mode 100644 index 31ecb96..0000000 --- a/.github/actions/run-tests/action.yml +++ /dev/null @@ -1,19 +0,0 @@ -name: 'Test Common Lisp System' - -inputs: - asdf-system: - description: 'ASDF system to install and test' - required: true - run-tests: - description: A command to run tests - required: false - -runs: - using: composite - steps: - - name: Run Tests - shell: bash - run: | - ${{ github.action_path }}/run-tests.ros ${{ inputs.asdf-system }} <= 3.1. - -0.1.0 (2018-06-03) +1.0.0 (2021-01-07) ================== Initial version. diff --git a/.github/actions/setup-lisp/action.yml b/action.yml similarity index 100% rename from .github/actions/setup-lisp/action.yml rename to action.yml diff --git a/cl-info-docs.asd b/cl-info-docs.asd deleted file mode 100644 index 57befb9..0000000 --- a/cl-info-docs.asd +++ /dev/null @@ -1,6 +0,0 @@ -(defsystem example-docs - :build-operation build-docs-op - :build-pathname "docs/build/" - :class :package-inferred-system - :pathname "docs/source/" - :depends-on ("example-docs/docs")) diff --git a/cl-info-test.asd b/cl-info-test.asd deleted file mode 100644 index 12037fe..0000000 --- a/cl-info-test.asd +++ /dev/null @@ -1,12 +0,0 @@ -(defsystem cl-info-test - :author "" - :license "" - :class :package-inferred-system - :pathname "t" - :depends-on ("hamcrest" - "cl-info-test/core") - :description "Test system for cl-info" - - :perform (test-op (op c) - (unless (symbol-call :rove :run c) - (error "Tests failed")))) diff --git a/cl-info.asd b/cl-info.asd deleted file mode 100644 index ebac693..0000000 --- a/cl-info.asd +++ /dev/null @@ -1,27 +0,0 @@ -#-asdf3.1 (error "cl-info requires ASDF 3.1") -(defsystem cl-info - :version (:read-file-form "version.lisp-expr") - :author "Alexander Artemenko" - :license "BSD" - :class :package-inferred-system - :pathname "src" - :depends-on ("cl-info/core") - :description "A helper to an answer a question about OS, Lisp and Everything." - :long-description - #.(with-open-file (stream (merge-pathnames - #p"README.rst" - (or *load-pathname* *compile-file-pathname*)) - :if-does-not-exist nil - :direction :input) - (when stream - (let ((seq (make-array (file-length stream) - :element-type 'character - :fill-pointer t))) - (setf (fill-pointer seq) - (read-sequence seq stream)) - seq))) - :perform (compile-op :before (o c) - #+ros.installing - (roswell:roswell '("install" "40ants/defmain"))) - :in-order-to ((test-op (test-op cl-info-test)))) - diff --git a/docs/scripts/build.ros b/docs/scripts/build.ros deleted file mode 100755 index fb1df80..0000000 --- a/docs/scripts/build.ros +++ /dev/null @@ -1,163 +0,0 @@ -#!/bin/sh -#|-*- mode:lisp -*-|# -#| -exec ros -Q -- $0 "$@" -|# -(progn ;;init forms - (ros:ensure-asdf) - #+quicklisp - (ql:quickload '(log4cl - example-docs) - :silent t)) - -(defpackage :script.build-docs - (:use :cl)) -(in-package :script.build-docs) - - -(define-condition unable-to-proceed (simple-error) - ((message :initarg :message - :reader get-message)) - (:report (lambda (condition stream) - (format stream (get-message condition))))) - - -(define-condition subprocess-error-with-output (uiop::subprocess-error) - ((stdout :initarg :stdout :reader subprocess-error-stdout) - (stderr :initarg :stderr :reader subprocess-error-stderr)) - (:report (lambda (condition stream) - (format stream "Subprocess ~@[~S~% ~]~@[with command ~S~% ~]exited with error~@[ code ~D ~]~@[ and this text at stderr:~% ~S~]" - (uiop:subprocess-error-process condition) - (uiop:subprocess-error-command condition) - (uiop:subprocess-error-code condition) - (subprocess-error-stderr condition)) - ))) - -(defun run (command &key (raise t)) - "Runs command and returns it's stdout stderr and code. - -If there was an error, raises subprocess-error-with-output, but this -behaviour could be overriden by keyword argument ``:raise t``." - - (multiple-value-bind (stdout stderr code) - (uiop:run-program command - :output '(:string :stripped t) - :error-output '(:string :stripped t) - :ignore-error-status t) - - (when (and raise - (not (eql code 0))) - (error 'subprocess-error-with-output - :stdout stdout - :stderr stderr - :code code - :command command)) - (values stdout stderr code))) - - -(defun build-docs () - (log:info "Building documentation in ./docs/") - - (example-docs:build-docs) - - (uiop:with-output-file (s "docs/build/.nojekyll" :if-exists :overwrite) - (declare (ignorable s)))) - - -(defun gh-pages-repository-initialized-p () - "Checks if repository for documentation already initialized" - (uiop:directory-exists-p "docs/build/.git")) - - -(defun git (&rest commands) - "Calls git command in gh-pages repository." - - (let ((directory "docs/build/")) - (uiop:with-current-directory (directory) - (let ((command (apply #'concatenate 'string - "git " - commands))) - - (log:info "Running" command "in" directory) - (run command))))) - - -(defun git-repository-was-changed-p () - ;; if git status returns something, then repository have uncommitted changes - (> (length (git "status --porcelain")) - 0)) - - -(defun get-git-upstream () - ;; taken from http://stackoverflow.com/a/9753364/70293 - (let ((upstream (run "git rev-parse --abbrev-ref --symbolic-full-name @{u}" :raise nil))) - (when (> (length upstream) - 0) - (subseq upstream - 0 - (search "/" upstream))))) - - -(defun get-origin-to-push () - (let ((upstream (get-git-upstream))) - - (cond - (upstream - ;; If there is already some remote upstream, then use it - (run (concatenate 'string "git remote get-url " upstream))) - ;; If we are running inside github actions - ((uiop:getenv "GITHUB_ACTIONS") - (unless (uiop:getenv "GITHUB_TOKEN") - (error 'unable-to-proceed - :message "Please, provide GITHUB_TOKEN environment variable.")) - (format nil "https://~A:~A@github.com/~A" - (uiop:getenv "GITHUB_ACTOR") - (uiop:getenv "GITHUB_TOKEN") - (uiop:getenv "GITHUB_REPOSITORY"))) - ;; otherwise make it from travis secret token and repo slug - (t - (let ((repo-slug (uiop:getenv "TRAVIS_REPO_SLUG")) - (repo-token (uiop:getenv "GH_REPO_TOKEN"))) - - (unless (and repo-slug repo-token) - (error 'unable-to-proceed - :message "Current branch does not track any upstream and there is no TRAVIS_REPO_SLUG and GH_REPO_TOKEN env variables. Where to push gh-pages branch?")) - - (format nil "https://~A@github.com/~A" - repo-token - repo-slug)))))) - - -(defun push-gh-pages () - (log:info "Pushing changes to gh-pages branch") - - (unless (gh-pages-repository-initialized-p) - (git "init") - - (git "remote add origin " - (get-origin-to-push))) - - (git "add .") - - (cond - ((git-repository-was-changed-p) - (when (uiop:getenv "GITHUB_ACTIONS") - (git "config --global user.name \"github-actions[bot]\"") - (git "config --global user.email \"actions@github.com\"")) - (git "commit -m 'Update docs'") - - (git "push --force origin master:gh-pages")) - ;; or - (t (log:info "Everything is up to date.")))) - - -(defun main (&rest argv) - (declare (ignorable argv)) - (log:config :debug) - (log:info "Building documentation") - - (handler-bind ((error (lambda (condition) - (uiop:print-condition-backtrace condition :stream *error-output*) - (uiop:quit 1)))) - (build-docs) - (push-gh-pages))) diff --git a/docs/source/docs.lisp b/docs/source/docs.lisp deleted file mode 100644 index 907f889..0000000 --- a/docs/source/docs.lisp +++ /dev/null @@ -1,168 +0,0 @@ -(defpackage #:example-docs/docs - (:nicknames #:example-docs) - (:use #:cl) - (:import-from #:mgl-pax - #:section - #:defsection) - (:import-from #:example/app - #:@app) - (:import-from #:example/utils - #:@utils) - (:export - #:build-docs)) -(in-package example-docs/docs) - - -(defsection @index (:title "Example of MGL-PAX Common Lisp Documentation Builder") - " -This is small library includes a few functions with docstrings and a documentation -for the system and all included packages. - -The purpose is to demonstrate core features of the -[MGL-PAX](http://melisgl.github.io/mgl-pax/) documentation builder. - -This repository is part of the organization, -created to compare different Common Lisp documentation systems. - -The goal is make it easier for CL software developers to choose proper -documentation system and to improve docs in their software! - -Resulting documentation can be viewed here: - - - -The repository can be used as a template for new libraries if you've choosen `MGL-PAX` -for documenting your library. - -Let's review features, provided by `MGL-PAX`. - -" - (@pros-n-cons section) - (@how-to-build section) - (@handwritten section) - (@autogenerated section) - (@packages section)) - - -(defsection @pros-n-cons (:title "Pros & Cons of PAX") - (@pros section) - (@cons section)) - - -(defsection @pros (:title "Pros") - " -* Markdown is widely used markup format and PAX uses it everywhere. -* Cross-referencing works like a charm and you can reference different - types of objects using [Locatives](http://melisgl.github.io/mgl-pax/#x-28MGL-PAX-3A-40MGL-PAX-LOCATIVES-AND-REFERENCES-20MGL-PAX-3ASECTION-29). -* New types of documentation objects can be defined in Common Lisp using CLOS. - Here is [an example](http://melisgl.github.io/mgl-pax/#x-28MGL-PAX-3AREFERENCE-LOCATIVE-20-28MGL-PAX-3AREADER-20MGL-PAX-3AREFERENCE-29-29). -* Emacs/SLIME integration and ability to jump to a xref objects using M-. -* Ability to generate Markdown README files as well as HTML. -* It is possible to link documentation and sources on the GitHub. -* Docstrings deindentation allows to format code nicely. -* You can generation docs for a multiple ASDF systems with cross-referencing. -* Autoexports all documented symbols. No need to enumerate them in `defpackage` form. -* There is a nice default HTML theme. -* No external tools like Sphinx. Everything is in Common Lisp. -") - - -(defsection @cons (:title "Cons") - " -* Markdown format may be somewhat limited and probably it can be non-trivial or not possible - to extend it in some rare cases. -* The recommended way to mix documentation section with code leads to - the runtime dependency from PAX and all it's dependencies. But you - might define documentation as a separate ASDF system. -* PAX does not notifies you if some references are missing or there are unused sections. - These mistakes can be catched automatically. -* It is inconvenient to write Markdown in docstrings. Is there any way - to teach Emacs to use markdown minor mode for documentation strings? -* There is no magically autogenerated reference API. See @AUTOGENERATED. - - But if you prefer another way, it should be easy to write a function which - will collect external symbols and generate a MGL-PAX:SECTION object for them. -") - - -(defsection @how-to-build (:title "How to build the documentation") - " -MGL-PAX has a number of ways for generation of the docs. But most probably, -you'll need only toplevel helpers described in it's section -[Generating Documentation](http://melisgl.github.io/mgl-pax/#toc-7-generating-documentation). - -These helpers is able to generate README and HTML docs for an ASDF system. - -This example defines it's own wrapper EXAMPLE-DOCS:BUILD-DOCS: -" - (build-docs function) - - " -It is as simple, as: - - -``` -(defun build-docs () - (mgl-pax:update-asdf-system-readmes @index :example) - - (mgl-pax:update-asdf-system-html-docs @index :example - :target-dir \"docs/build/\")) -``` - -This function is used by docs/scripts/build.ros file to generate documentation from GitHub Actions. -Or can be called from the REPL. -") - - -(defsection @handwritten (:title "Handwritten Documentation") - " -I think the ability to write a large pieces of documentation which aren't bound to -a function, class or module is an important feature. This way you can tell the user -about some toplevel abstractions and give a bird eye view on the library or system. - -For example, handwritten parts of the documentation can provide some code snippets -to demonstrate the ways, how to use the library: - -``` -(loop repeat 42 - collect (foo \"bar\" 100500)) -``` - -And when you are talking about some function or class, you can reference it. -For example, if I'm talking about the FOO function, I can reference it like this -`[example/app:foo][function]` and it will appear in the code as -the link [example/app:foo]. In most cases you can omit square brakets and just -capitalize symbol name. - -Comparing MGL-PAX to Coo (here is it's [example project](https://cl-doc-systems.github.io/coo/), -I'd prefer the PAX, because it's ability to mix handwriten sections with documentation extracted -from docstrings. - -") - - -(defsection @autogenerated (:title "Autogenerated API Reference") - " -There is no magically autogenerated reference API. Idea of PAX is that you -write docs manually and reference documented symbols. They are automatically -exported and this way you library's external API should be documented. - -But if you prefer another way, it should be easy to write a function which -will collect external symbols and generate a MGL-PAX:SECTION object for them. -") - -(defsection @packages (:title "Packages") - (@app section) - (@utils section)) - - -(defun build-docs () - (mgl-pax:update-asdf-system-readmes @index :example) - - (mgl-pax:update-asdf-system-html-docs - @index :example - :target-dir "docs/build/" - :pages `((:objects (,example-docs:@index) - :source-uri-fn ,(pax:make-github-source-uri-fn - :example - "https://github.com/cl-doc-systems/mgl-pax"))))) diff --git a/qlfile b/qlfile deleted file mode 100644 index 7b904c0..0000000 --- a/qlfile +++ /dev/null @@ -1,2 +0,0 @@ -dist ultralisp http://dist.ultralisp.org - diff --git a/qlfile.lock b/qlfile.lock deleted file mode 100644 index 9290dd3..0000000 --- a/qlfile.lock +++ /dev/null @@ -1,8 +0,0 @@ -("quicklisp" . - (:class qlot/source/dist:source-dist - :initargs (:distribution "http://beta.quicklisp.org/dist/quicklisp.txt" :%version :latest) - :version "2021-01-24")) -("ultralisp" . - (:class qlot/source/dist:source-dist - :initargs (:distribution "http://dist.ultralisp.org" :%version :latest) - :version "20210206084500")) diff --git a/roswell/cl-info.ros b/roswell/cl-info.ros deleted file mode 100755 index 48b31fe..0000000 --- a/roswell/cl-info.ros +++ /dev/null @@ -1,38 +0,0 @@ -#!/bin/sh -#|-*- mode:lisp -*-|# -#| -exec ros -Q -- $0 "$@" -|# -(progn ;;init forms - (ros:ensure-asdf) - #+quicklisp (ql:quickload '(cl-info - defmain) - :silent t)) - -(defpackage :ros.script.cl-info - (:use :cl) - (:import-from #:cl-info/core - #:get-cl-info - #:get-system-info) - (:import-from #:defmain - #:defmain)) -(in-package :ros.script.cl-info) - - -(defmain main ((version "Show program version and exit." - :flag t) - &rest system) - "Show information about Lisp implementation and given systems. Useful when collecting information for bugreports." - - (when version - (let* ((system (asdf:find-system :cl-info)) - (version (asdf:component-version system))) - (format t "Version: ~A~%" version) - (uiop:quit 0))) - - (princ (get-cl-info)) - - (loop for system-name in system - do (princ (get-system-info system-name)))) - -;;; vim: set ft=lisp lisp: diff --git a/src/core.lisp b/src/core.lisp deleted file mode 100644 index 6cf43e0..0000000 --- a/src/core.lisp +++ /dev/null @@ -1,195 +0,0 @@ -(defpackage #:cl-info - (:nicknames #:cl-info/core) - (:use #:cl) - (:import-from #:mgl-pax-minimal - #:defsection - #:reader) - (:export #:cl-info - #:get-cl-info - #:get-system-info)) -(in-package cl-info/core) - - -(defsection @index (:title "CL-INFO - Common Lisp Environment Reporter") - " -[![](https://github-actions.40ants.com/40ants/cl-info/matrix.svg)](https://github.com/40ants/cl-info/actions) - -This is a small utility, useful to display information about you Common -Lisp environment. You might want to call it in the CI pipeline or -to use it when rendering a crash report in some client applications. - -Usage from Common Lisp -====================== - -It's main entry point is CL-INFO:GET-CL-INFO function. It returns an object with -customized PRINT-OBJECT method. You can use it to output debug -information in your programs. - -CL-INFO collects inforrmation about OS, Lisp Implementation, ASDF, installed -Quicklisp distributions: - - CL-USER> (cl-info:get-cl-info) - OS: Darwin 15.6.0 - Lisp: SBCL 1.4.8 - ASDF: 3.3.1.1 - QL: ceramic github-e0d905187946f8f2358f7b05e1ce87b302e34312 - cl-prevalence github-c163c227ed85d430b82cb1e3502f72d4f88e3cfa - log4cl-json github-c4f786e252d89a45372186aaf32fb8e8736b444b - log4cl github-6a857b0b41c030a8a3b04096205e221baaa1755f - quicklisp 2018-04-30 - slynk github-3314cf8c3021cb758e0e30fe3ece54accf1dcf3d - weblocks-lass github-1b043afbf2f3e84e495dfeae5e63fe67a435019f - weblocks-parenscript github-8ef4ca2f837403a05c4e9b92dcf1c41771d16f17 - weblocks-ui github-5afdf238534d70edc2447d0bc8bc63da8e35999f - weblocks-websocket github-b098db7f179dce3bfb045afd4e35e7cc868893f0 - weblocks github-282483f97d6ca351265ebfebb017867c295d01ad - websocket-driver github-a3046b11dfb9803ac3bff7734dd017390c2b54bb - CL-USER> - -Also, you can gather information about separate systems using CL-INFO:GET-SYSTEM-INFO -function: - - CL-USER> (cl-info:get-system-info :hamcrest) - System: HAMCREST 0.4.2 - /Users/art/common-lisp/cl-hamcrest/src/ - - -Usage From Command-line -======================= - -Also, you can use CL-INFO as a command-line utility. It is useful to -output information about common lisp environment running on CI server. - -Here is how to do it: - -```shell -# Here we use a Roswell, to install utility -[art@art-osx:~]% ros install 40ants/cl-info - -# And now request information about lisp and some systems -[art@art-osx:~]% cl-info weblocks clack jonathan some-other-system -OS: Darwin 15.6.0 -Lisp: Clozure Common Lisp Version 1.11.5/v1.11.5 (DarwinX8664) -ASDF: 3.3.1.1 -QL: org.borodust.bodge 20180214223017 - quicklisp 2017-10-23 -System: weblocks 0.31.1 - /Users/art/common-lisp/weblocks/src/ -System: clack 2.0.0 - /Users/art/common-lisp/clack/ -System: jonathan 0.1 - /Users/art/.roswell/lisp/quicklisp/dists/quicklisp/software/jonathan-20170630-git/ -System: some-other-system is not available -``` - -API Reference -============= -" - (get-cl-info function) - (get-system-info function) - - (cl-info class) - (get-asdf-version (reader cl-info)) - - (system-info class)) - - -(defclass cl-info () - ((asdf-version :initform (asdf:asdf-version) - :reader get-asdf-version - :documentation "Returns ASDF version.") - (lisp-type :initform (lisp-implementation-type) - :reader get-lisp-type) - (lisp-version :initform (lisp-implementation-version) - :reader get-lisp-version) - (software-type :initform (software-type) - :reader get-software-type) - (software-version :initform (software-version) - :reader get-software-version) - #+quicklisp - (ql-dists :initform (ql-dist:all-dists) - :reader get-ql-dists))) - - -#-quicklisp -(defun get-ql-dists (obj) - nil) - - -(defclass system-info () - ((name :initarg :name - :reader get-name) - (version :initarg :version - :reader get-version) - (path :initarg :path - :reader get-path) - (absent :initarg :absent - :initform nil - :reader absent-p))) - - -(defmethod print-object ((info cl-info) stream) - (format stream - "OS: ~A ~A -Lisp: ~A ~A -ASDF: ~A -" - (get-software-type info) - (get-software-version info) - (get-lisp-type info) - (get-lisp-version info) - (get-asdf-version info)) - #-quicklisp - (format stream - "QL: is not available~%") - #+quicklisp - (format stream - "QL: ~{~A~^~%~}~%" - (loop for dist in (get-ql-dists info) - for idx upfrom 0 - collect (format nil "~:[~; ~]~A ~A" - (> idx 0) - (ql-dist:name dist) - (ql-dist:version dist))))) - - -(defmethod print-object ((info system-info) stream) - (if (absent-p info) - (format stream - "System: ~A is not available~%" - (get-name info)) - (format stream - "System: ~A ~A - ~A~%" - (get-name info) - (get-version info) - (get-path info)))) - - -(defun get-cl-info () - "Returns information about lisp implementation, asdf and quicklisp." - (make-instance 'cl-info)) - - -(defun get-system-info (system-name) - (let ((system (block search-for-system - (handler-bind ((asdf:missing-component - (lambda (c) - (declare (ignorable c)) - (return-from search-for-system nil))) - (asdf:system-out-of-date - (lambda (c) - (declare (ignorable c)) - (invoke-restart 'continue)))) - (asdf:find-system system-name))))) - - (if system - (make-instance 'system-info - :name system-name - :version (asdf:component-version system) - :path (asdf:component-pathname system)) - (make-instance 'system-info - :name system-name - :absent t - :version nil - :path nil)))) diff --git a/t/core.lisp b/t/core.lisp deleted file mode 100644 index 58e4450..0000000 --- a/t/core.lisp +++ /dev/null @@ -1,20 +0,0 @@ -(defpackage #:cl-info-test/core - (:use #:cl) - (:import-from #:cl-info) - (:import-from #:hamcrest/rove - #:contains - #:assert-that) - (:import-from #:rove - #:testing - #:deftest)) -(in-package cl-info-test/core) - - -(defun foo (a b) - (list a b)) - - -(deftest test-some-staff - (testing "Replace this test with real staff." - (assert-that (foo 1 2) - (contains 1 2)))) diff --git a/.github/actions/scripts/templater.ros b/templater.ros similarity index 100% rename from .github/actions/scripts/templater.ros rename to templater.ros diff --git a/version.lisp-expr b/version.lisp-expr deleted file mode 100644 index 797d18b..0000000 --- a/version.lisp-expr +++ /dev/null @@ -1 +0,0 @@ -"0.4.0" \ No newline at end of file