Restore qlmapper's copyright, prettify.

qrmapper.lisp

-;; Shamelessly copied and adapted from:
-;; https://github.com/xach/qlmapper
+;;; qrmapper.lisp --- Lisp code mapper over every Quicklisp system/release
+
+;; Copyright (C) 2012 Zachary Beane
+;; Copyright (C) 2018 EPITA Research and Development Laboratory
+
+;; Author: Zachary Beane
+;; Maintainer: Antoine Martin <antoine4.martin@epita.fr>
+
+;; This file is part of Quickref.
+
+;; Permission is hereby granted, free of charge, to any person obtaining a
+;; copy of this software and associated documentation files (the "Software"),
+;; to deal in the Software without restriction, including without limitation
+;; the rights to use, copy, modify, merge, publish, distribute, sublicense,
+;; and/or sell copies of the Software, and to permit persons to whom the
+;; Software is furnished to do so, subject to the following conditions:
+
+;; The above copyright notice and this permission notice shall be included in
+;; all copies or substantial portions of the Software.
+
+;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+;; DEALINGS IN THE SOFTWARE.
+
+
+;;; Comment:
+
+;; Adapted from https://github.com/xach/qlmapper.
+
+
+;;; Code:
 
 (in-package quickref)
 
+
 (defvar *sbcl-program* sb-ext:*runtime-pathname*)
 
 (defvar *init-file* (merge-pathnames "qrmapper-init.lisp"
@@ -13,15 +47,15 @@
 
 (defun eval-defvar-forms (environment-pairs)
   (loop for (name value) on environment-pairs by #'cddr
-     for sym = (format nil "cl-user::~A" name)
-     collect "--eval"
-     collect (format nil "(defvar ~A (sb-posix:getenv ~S))" sym name)
-     collect "--eval"
-     collect (format nil "(export '~A '#:cl-user)" sym)))
+	for sym = (format nil "cl-user::~A" name)
+	collect "--eval"
+	collect (format nil "(defvar ~A (sb-posix:getenv ~S))" sym name)
+	collect "--eval"
+	collect (format nil "(export '~A '#:cl-user)" sym)))
 
 (defun environment-list (environment-pairs)
   (loop for (name value) on environment-pairs by #'cddr
-     collect (format nil "~A=~A" name value)))
+	collect (format nil "~A=~A" name value)))
 
 (defun flatlist (&rest args)
   (alexandria:flatten args))
@@ -38,18 +72,18 @@
 		     (eval-defvar-forms environment-pairs)
 		     "--eval"
 		     (format nil  "(setf cl:*default-pathname-defaults* ~
-                                   #p~S)"
-			     (native-truename *default-pathname-defaults*))
+				   #p~S)"
+		       (native-truename *default-pathname-defaults*))
 		     "--load"
 		     (native-truename *init-file*)
 		     (when pre-file
 		       (list "--load" (native-truename pre-file)))
 		     (mapcar (lambda (eval)
 			       (list "--eval" eval))
-			     evals)
+		       evals)
 		     "--eval"
 		     (format nil "(defparameter *remove-cache* ~S)"
-			     *remove-cache*)
+		       *remove-cache*)
 		     "--load" (native-truename file))
 		    :environment (append (environment-list environment-pairs)
 					 (sb-ext:posix-environ))
@@ -80,7 +114,7 @@
     (base-directory (ql-dist:release system))))
 
 (defun map-objects (file
-                    &key dist-name function (filter 'identity) evals pre-file)
+		    &key dist-name function (filter 'identity) evals pre-file)
   (unless (probe-file file)
     (error "~S does not exist" file))
   (let ((dist (ql-dist:find-dist dist-name)))
@@ -88,11 +122,11 @@
       (error "~S does not name any known dist" dist-name))
     (let ((objects (funcall function dist)))
       (dolist (object objects)
-        (let ((name (ql-dist:name object)))
-          (when (funcall filter name)
-            (ql-dist:ensure-installed object)
-            (let ((*default-pathname-defaults*
-                   (base-directory object)))
+	(let ((name (ql-dist:name object)))
+	  (when (funcall filter name)
+	    (ql-dist:ensure-installed object)
+	    (let ((*default-pathname-defaults*
+		    (base-directory object)))
 	      (log-sbcl name
 			:file file
 			:pre-file pre-file
@@ -102,15 +136,15 @@
 			:evals evals))))))))
 
 (defun map-releases (file &key (dist-name "quicklisp") (filter 'identity)
-			    pre-file)
+			       pre-file)
   "For each release in a dist (defaults to the \"quicklisp\" dist),
   start an independent SBCL process and load FILE with the variable
   CL-USER:*QRMAPPER-OBJECT-NAME* bound to the release's name."
   (map-objects file
-               :pre-file pre-file
-               :dist-name dist-name
-               :function #'ql-dist:provided-releases
-               :filter filter))
+	       :pre-file pre-file
+	       :dist-name dist-name
+	       :function #'ql-dist:provided-releases
+	       :filter filter))
 
 (defun map-objects-thread (file mutex waitqueue
 			   &key dist-name function (filter 'identity) evals pre-file)
@@ -121,11 +155,11 @@
       (error "~S does not name any known dist" dist-name))
     (let ((objects (funcall function dist)))
       (dolist (object objects)
-        (let ((name (ql-dist:name object)))
-          (when (funcall filter name)
-            (ql-dist:ensure-installed object)
-            (let ((*default-pathname-defaults*
-                   (base-directory object)))
+	(let ((name (ql-dist:name object)))
+	  (when (funcall filter name)
+	    (ql-dist:ensure-installed object)
+	    (let ((*default-pathname-defaults*
+		    (base-directory object)))
 	      (log-sbcl name
 			:file file
 			:pre-file pre-file
@@ -139,7 +173,7 @@
 
 (defun map-releases-thread (file mutex waitqueue
 			    &key (dist-name "quicklisp") (filter 'identity)
-			      pre-file)
+				 pre-file)
   "For each release in a dist (defaults to the \"quicklisp\" dist),
   start an independent SBCL process and load FILE with the variable
   CL-USER:*QRMAPPER-OBJECT-NAME* bound to the release's name.
@@ -153,3 +187,5 @@
 		      :dist-name dist-name
 		      :function #'ql-dist:provided-releases
 		      :filter filter))
+
+;;; qrmapper.lisp ends here