nix-archive-1(type directoryentry(namesharenode(type directoryentry(name common-lispnode(type directoryentry(namesourcenode(type directoryentry(namecl-hu.dwim.asdfnode(type directoryentry(nameLICENCEnode(typeregularcontentsžHU.DWIM.ASDF is public domain software: Authors dedicate this work to public domain, for the benefit of the public at large and to the detriment of the authors' heirs and successors. Authors intends this dedication to be an overt act of relinquishment in perpetuity of all present and future rights under copyright law, whether vested or contingent, in the work. Authors understands that such relinquishment of all rights includes the relinquishment of all rights to enforce (by lawsuit or otherwise) those copyrights in the work. Authors recognize that, once placed in the public domain, the work may be freely reproduced, distributed, transmitted, used, modified, built upon, or otherwise exploited by anyone for any purpose, commercial or non-commercial, and in any way, including by methods that have not yet been invented or conceived. In those legislations where public domain dedications are not recognized or possible, HU.DWIM.ASDF is distributed under the following terms and conditions: 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 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. ))entry(nameREADMEnode(typeregularcontents$http://dwim.hu/project/hu.dwim.asdf ))entry(name documentationnode(type directoryentry(name asdf.lispnode(typeregularcontents";;; -*- mode: Lisp; Syntax: Common-Lisp; -*- ;;; ;;; Copyright (c) 2009 by the authors. ;;; ;;; See LICENCE for details. (in-package :hu.dwim.asdf.documentation) (def project :hu.dwim.asdf) (def book user-guide (:title "User guide") (chapter (:title "Introduction") (paragraph () "TODO")) (chapter (:title "Supported Common Lisp Implementations") (paragraph () "SBCL")) (chapter (:title "Supported Operating Systems") (paragraph () "Linux")) (chapter (:title "Tutorial") (paragraph () "TODO"))) ))entry(name package.lispnode(typeregularcontentst;;; -*- mode: Lisp; Syntax: Common-Lisp; -*- ;;; ;;; Copyright (c) 2009 by the authors. ;;; ;;; See LICENCE for details. (in-package :hu.dwim.def) (def package :hu.dwim.asdf.documentation (:use :hu.dwim.asdf :hu.dwim.common :hu.dwim.def :hu.dwim.defclass-star :hu.dwim.presentation :hu.dwim.syntax-sugar :hu.dwim.util)) ))))entry(namehu.dwim.asdf.asdnode(typeregularcontents;;; -*- mode: Lisp; Syntax: Common-Lisp; -*- ;;; ;;; Copyright (c) 2009-2011 by the authors. ;;; ;;; See LICENCE for details. (defsystem :hu.dwim.asdf :description "Various ASDF extensions such as attached test and documentation system, explicit development support, etc." :author ("Tamás BorbĂ©ly " "Attila Lendvai " "Levente MĂ©száros ") :license "BSD or Bugroff" ;; this dependency on asdf may be a source of headaches if a newer asdf is part of the registry ;; and due to this dependency it gets updated in the middle of a half loaded image... nevertheless, we depend on asdf. :depends-on (:asdf :uiop) :components ((:module "source" :components ((:file "duplicates" :depends-on ("package")) (:file "package") (:file "production" :depends-on ("duplicates")) (:file "system" :depends-on ("production")))))) ))entry(namehu.dwim.asdf.documentation.asdnode(typeregularcontentsŕ;;; -*- mode: Lisp; Syntax: Common-Lisp; -*- ;;; ;;; Copyright (c) 2009 by the authors. ;;; ;;; See LICENCE for details. (defsystem :hu.dwim.asdf.documentation :defsystem-depends-on (:hu.dwim.asdf) :class "hu.dwim.asdf:hu.dwim.documentation-system" :depends-on (:hu.dwim.asdf :hu.dwim.presentation) :components ((:module "documentation" :components ((:file "asdf" :depends-on ("package")) (:file "package"))))) ))entry(namesourcenode(type directoryentry(nameduplicates.lispnode(typeregularcontentsş;;; -*- mode: Lisp; Syntax: Common-Lisp; -*- ;;; ;;; Copyright (c) 2009 by the authors. ;;; ;;; See LICENCE for details. (in-package :hu.dwim.asdf) (defun if-symbol-exists (package name) (if (and (find-package (string package)) (find-symbol (string name) (string package))) '(:and) '(:or))) ;; this exists in :hu.dwim.util (in a slightly different form) (defun call-with-muffled-boring-compiler-warnings (thunk) (handler-bind (#+sbcl(sb-ext:compiler-note #'muffle-warning) ;; NOTE: muffle these warnings to reduce compilation noise, tests already cover interesting cases #+sbcl(sb-kernel:undefined-alien-style-warning #'muffle-warning)) (funcall thunk))) (defmacro with-muffled-boring-compiler-warnings (&body body) `(locally (declare #+sbcl(sb-ext:muffle-conditions style-warning sb-ext:compiler-note)) (call-with-muffled-boring-compiler-warnings (lambda () ,@body)))) ))entry(name package.lispnode(typeregularcontentsW;;; -*- mode: Lisp; Syntax: Common-Lisp; -*- ;;; ;;; Copyright (c) 2009 by the authors. ;;; ;;; See LICENCE for details. (in-package :common-lisp-user) (defpackage :hu.dwim.asdf (:use :common-lisp) (:import-from :asdf #:find-system #:initialize-source-registry #:compile-op #:load-op #:load-system #:non-propagating-operation #:perform #:system-relative-pathname #:test-op #:test-system) (:export #:find-and-load-swank-integration-systems #:hu.dwim.system #:hu.dwim.test-system #:hu.dwim.documentation-system #:system-pathname #:system-directory #:system-relative-pathname #:system-package-name #:system-test-name #:system-test-system-name #:system-documentation-system-name #:system-compile-output #:system-load-output #:system-test-result #:system-test-output #:develop-op #:develop-system #:*load-as-production?* #:debug-only #:debug-only* #:production-only #:production-only* #:optimize-declaration #:iterate-system-dependencies #:map-asdf-source-registry-directories #:do-system-dependencies #:map-system-dependencies #:collect-system-dependencies #:find-system #:load-system #:test-system #:run-test-suite)) ))entry(nameproduction.lispnode(typeregularcontentsż;;; -*- mode: Lisp; Syntax: Common-Lisp; -*- ;;; ;;; Copyright (c) 2009 by the authors. ;;; ;;; See LICENCE for details. (in-package :hu.dwim.asdf) ;; TODO changing global state is not nice from a library, it should move somewhere else #+sbcl (progn ;; (sb-ext:restrict-compiler-policy 'safety 2) ;; ALIEN-FUNCALL-SAVES-FP-AND-PC helps to get uncut backtraces even in alien calls #+#.(hu.dwim.asdf::if-symbol-exists "SB-C" "ALIEN-FUNCALL-SAVES-FP-AND-PC") (sb-ext:restrict-compiler-policy 'sb-c::alien-funcall-saves-fp-and-pc 3)) ;;;;;; ;;; Production support (defvar *load-as-production?* nil "When T, load the lisp files so that it will be used in a production system. This means that debug-only blocks are dropped, some hot functions are optimized, compile time and runtime log levels and various other variables are initialized accordingly.") (defmacro debug-only (&body body) (if *load-as-production?* (values) `(progn ,@body))) (defmacro debug-only* (&body body) `(if *load-as-production?* (values) (progn ,@body))) (defmacro production-only (&body body) (if *load-as-production?* `(progn ,@body) (values))) (defmacro production-only* (&body body) `(if *load-as-production?* (progn ,@body) (values))) (defun optimize-declaration () (if *load-as-production?* '(optimize (speed 3) (debug 0) (safety 0)) '(optimize (debug 3) (safety 3)))) ))entry(name system.lispnode(typeregularcontents8;;; -*- mode: Lisp; Syntax: Common-Lisp; -*- ;;; ;;; Copyright (c) 2009 by the authors. ;;; ;;; See LICENCE for details. (in-package :hu.dwim.asdf) ;;;;;; ;;; Package support (defclass system-with-package (asdf:system) ((package-name :initarg :package-name :accessor system-package-name))) (defmethod reinitialize-instance :after ((system system-with-package) &rest args &key &allow-other-keys) (declare (ignore args)) (unless (slot-boundp system 'package-name) (setf (system-package-name system) (string-upcase (asdf:component-name system))))) (defclass system-with-target () ((target-system-name :initarg :target-system-name :accessor system-target-system-name))) (defmethod reinitialize-instance :after ((system system-with-target) &rest args &key &allow-other-keys) (declare (ignore args)) (flet ((maybe-copy-slot (slot-name source target) (when (and (slot-boundp source slot-name) (not (slot-boundp target slot-name))) (setf (slot-value target slot-name) (slot-value source slot-name))))) (let* ((system-name (string-downcase (asdf:component-name system))) (last-dot-position (position #\. system-name :from-end t))) (unless (slot-boundp system 'target-system-name) (setf (system-target-system-name system) (subseq system-name 0 last-dot-position))) (let ((target-system (find-system (system-target-system-name system) nil))) (when target-system (maybe-copy-slot 'asdf::author target-system system) (maybe-copy-slot 'asdf::licence target-system system) (unless (slot-boundp system 'asdf::description) (setf (slot-value system 'asdf::description) (concatenate 'string (string-capitalize (subseq system-name (1+ last-dot-position))) " for " (system-target-system-name system))))))))) ;;;;;; ;;; DWIM system (defvar *muffle-optimization-warnings* t) (defclass hu.dwim.cl-source-file (asdf:cl-source-file) ()) (defclass system-with-output () ((compile-output :initform nil :initarg :compile-output :accessor system-compile-output) (load-output :initform nil :initarg :load-output :accessor system-load-output))) (defclass hu.dwim.base-system (system-with-output system-with-package) ()) (defmethod shared-initialize :around ((system hu.dwim.base-system) slot-names &rest initargs) (unless (getf initargs :license) (setf (getf initargs :license) "BSD or Bugroff")) (unless (getf initargs :author) (setf (getf initargs :author) '("Tamás BorbĂ©ly " "Attila Lendvai " "Levente MĂ©száros "))) (apply #'call-next-method system slot-names initargs)) (defclass hu.dwim.system (hu.dwim.base-system) ((test-system-name :initarg :test-system-name :accessor system-test-system-name) (documentation-system-name :initarg :documentation-system-name :accessor system-documentation-system-name))) (defclass hu.dwim.test-system (system-with-target hu.dwim.base-system) ((test-name :initform "TEST" :initarg :test-name :accessor system-test-name) (test-result :initform nil :initarg :test-result :accessor system-test-result) (test-output :initform nil :initarg :test-output :accessor system-test-output))) (defmethod shared-initialize :around ((system hu.dwim.test-system) slot-names &rest initargs) (unless (getf initargs :description) (setf (getf initargs :description) "Test system for the similarly named system.")) (apply #'call-next-method system slot-names initargs)) (defclass hu.dwim.documentation-system (system-with-target hu.dwim.base-system) ()) (defmethod shared-initialize :around ((system hu.dwim.documentation-system) slot-names &rest initargs) (unless (getf initargs :description) (setf (getf initargs :description) "Documentation for the similarly named system. It should contain formally processable data and its contents should be available at http://dwim.hu")) (apply #'call-next-method system slot-names initargs)) (defmacro with-capturing-output (place &body forms) (let ((stream (gensym "STREAM"))) `(let* ((,stream (make-string-output-stream)) (*standard-output* (make-broadcast-stream *standard-output* ,stream)) (*error-output* (make-broadcast-stream *error-output* ,stream))) ,@forms (setf ,place (concatenate 'string ,place (get-output-stream-string ,stream)))))) (defmethod reinitialize-instance :after ((system hu.dwim.system) &rest args &key &allow-other-keys) (declare (ignore args)) (unless (slot-boundp system 'test-system-name) (setf (system-test-system-name system) (concatenate 'string (string-downcase (asdf:component-name system)) "/test"))) (unless (slot-boundp system 'documentation-system-name) (setf (system-documentation-system-name system) (concatenate 'string (string-downcase (asdf:component-name system)) "/documentation")))) (defmethod asdf::module-default-component-class ((class hu.dwim.test-system)) 'hu.dwim.cl-source-file) (defmethod asdf::module-default-component-class ((class hu.dwim.system)) 'hu.dwim.cl-source-file) (defmethod perform :around ((op asdf:operation) (component hu.dwim.cl-source-file)) (let ((*features* *features*) (*readtable* (copy-readtable *readtable*)) (*package* *package*) (hu.dwim.common-package (find-package :hu.dwim.common))) (when hu.dwim.common-package ;; when the hu.dwim.common package is available, then we read lisp files into that, so that hu.dwim.common:in-package can shadow cl:in-package. ;; see hu.dwim.def/source/extended-package.lisp for more info. (setf *package* hu.dwim.common-package)) (debug-only (pushnew :debug *features*)) (call-in-system-environment op (asdf:component-system component) #'call-next-method))) (defmethod perform :around ((op compile-op) (component hu.dwim.cl-source-file)) (with-capturing-output (system-compile-output (asdf:component-system component)) (call-next-method))) (defmethod perform :around ((op load-op) (component hu.dwim.cl-source-file)) (with-capturing-output (system-load-output (asdf:component-system component)) (call-next-method))) (defgeneric call-in-system-environment (operation system function) (:method ((op asdf:operation) (system asdf:system) function) (if *muffle-optimization-warnings* (call-with-muffled-boring-compiler-warnings function) (funcall function)))) (defmethod perform ((op test-op) (system hu.dwim.system)) (let ((test-system (find-system (system-test-system-name system) nil))) (if (typep test-system 'hu.dwim.test-system) (progn (load-system test-system) (run-test-suite test-system)) (warn "There is no test system for ~A, no tests were run." system)))) (defgeneric run-test-suite (system) (:method ((system asdf:system)) (warn "Don't know how to run tests suite for ~A" system)) (:method :around ((system hu.dwim.test-system)) (with-capturing-output (system-test-output system) (setf (system-test-result system) (call-next-method)))) (:method ((system hu.dwim.test-system)) (if (find-package :hu.dwim.stefil) (let ((package-name (system-package-name system))) (if package-name (let ((test-name (find-symbol (system-test-name system) package-name))) (funcall (find-symbol "FUNCALL-TEST-WITH-FEEDBACK-MESSAGE" :hu.dwim.stefil) test-name)) (warn "There is no test package for ~A, no tests were run." system))) (call-next-method)))) ;;;;;; ;;; Develop ;; this is only needed to workaround asdf's rigidity (ASDF protects *package* by rebinding it, but we want to set it) (defvar *development-package*) (defclass develop-op (non-propagating-operation) ()) (defmethod asdf:operation-done-p ((operation develop-op) (component asdf:component)) nil) (defmethod perform ((operation develop-op) (component asdf:component)) nil) (defmethod perform :before ((operation develop-op) (system asdf:system)) (with-simple-restart (continue "Give up loading Swank and continue...") (load-system :swank) (set (read-from-string "swank:*globally-redirect-io*") t))) (defmethod perform :after ((operation develop-op) (system asdf:system)) (load-system :hu.dwim.debug) (use-package :hu.dwim.debug :hu.dwim.common) (do-external-symbols (symbol :hu.dwim.debug) (export symbol :hu.dwim.common)) (find-and-load-swank-integration-systems) (declaim (optimize (debug 3))) (pushnew :debug *features*) (warn "Pushed :debug in *features* and issued (declaim (optimize (debug 3))) to help later C-c C-c'ing")) (defmethod perform ((operation develop-op) (system asdf:system)) (let ((system-to-load (or (find-system (if (typep system 'hu.dwim.system) (system-test-system-name system) (concatenate 'string (asdf:component-name system) "/test")) nil) system)) (quickload-fn (when (find-package '#:quicklisp) (find-symbol (string '#:quickload) (find-package '#:quicklisp))))) (if quickload-fn (funcall quickload-fn (asdf:component-name system-to-load) :verbose t) (load-system system-to-load)) (when (typep system-to-load 'system-with-package) (let ((package (find-package (system-package-name system-to-load)))) (when package (setf *development-package* package)))))) (defun develop-system (system &rest args &key force (verbose t) version) "Shorthand for `(operate 'asdf:develop-op system)`. See [operate][] for details." (declare (ignore force version)) (let ((*development-package* nil)) (multiple-value-prog1 (apply 'asdf:operate 'develop-op system :verbose verbose args) (when *development-package* (setf *package* *development-package*) (warn "Changed *package* to ~A" *package*))))) ;;;;;; ;;; Util (defun system-pathname (name) (asdf:component-pathname (find-system name))) (defun system-directory (name) (make-pathname :directory (pathname-directory (system-pathname name)))) (defun system-loaded-p (system-name) (let ((system (find-system system-name))) (when system (asdf:component-loaded-p system)))) (defun map-asdf-source-registry-directories (visitor) (loop :for asd-file :being :the :hash-value :of asdf::*source-registry* :do (funcall visitor (make-pathname :directory (pathname-directory asd-file))))) (defun find-all-swank-integration-systems () (map-asdf-source-registry-directories (lambda (directory) (dolist (file (directory (merge-pathnames directory (make-pathname :name :wild :type "asd")))) (let ((name (pathname-name file))) (when (and (search "hu.dwim" name) (search "+swank" name)) (find-system name))))))) (defun load-swank-integration-systems () "Loads the +swank systems for the already loaded systems." (map nil (lambda (name) (let ((system (asdf:find-system name))) (when (and (search "+swank" name) (not (system-loaded-p name)) (every 'system-loaded-p (collect-system-dependencies system))) (with-simple-restart (skip-system "Skip loading swank integration ~A" system) (load-system system))))) (asdf:registered-systems))) (defun find-and-load-swank-integration-systems () (find-all-swank-integration-systems) (load-swank-integration-systems)) (defun %iterate-system-dependencies-1 (function system) (check-type system asdf:system) ;; NOTE: it's not clear how to iterate dependencies, see this old discussion: ;; http://article.gmane.org/gmane.lisp.asdf.devel/3105 ;; although ASDF:COMPONENT-SIDEWAY-DEPENDENCIES might be newer than that discussion. (dolist (dependency (asdf:component-sideway-dependencies system)) ;; NOTE: there may be dependencies here like this: (:VERSION :METATILITIES-BASE "0.6.6") (when (consp dependency) (case (first dependency) (:version (setf dependency (second dependency))) (t (error "Don't know how to interpret the following ASDF dependency specification: ~S" dependency)))) (funcall function (asdf:find-system dependency)))) (defun iterate-system-dependencies (function system &key (transitive nil)) (setf system (find-system system)) (if transitive (let ((dependencies '())) (labels ((recurse (system) (%iterate-system-dependencies-1 (lambda (dependency) (unless (member dependency dependencies) (push dependency dependencies) (recurse dependency))) system))) (recurse system) (map nil function dependencies))) (%iterate-system-dependencies-1 function system)) (values)) (defun map-system-dependencies (function system &key (transitive nil)) (let ((result '())) (iterate-system-dependencies (lambda (dependency) (push (funcall function dependency) result)) system :transitive transitive) result)) (defun collect-system-dependencies (system &key (transitive nil)) (map-system-dependencies 'identity system :transitive transitive)) (defmacro do-system-dependencies ((variable-name system-name &key (transitive nil)) &body body) (let ((body-fn (gensym "DSD-BODY"))) `(block nil (flet ((,body-fn (,variable-name) ,@body)) (iterate-system-dependencies #',body-fn ,system-name :transitive ,transitive))))) (reinitialize-instance (change-class (find-system :hu.dwim.asdf) 'hu.dwim.system)) ))))))))entry(namesystemsnode(type directoryentry(namehu.dwim.asdf.asdnode(typesymlinktarget~/gnu/store/fha6q9yc1sbbq3fbgbfjc8ch5gxw17az-cl-hu.dwim.asdf-20200724/share/common-lisp/source/cl-hu.dwim.asdf/hu.dwim.asdf.asd))entry(namehu.dwim.asdf.documentation.asdnode(typesymlinktargetŚ/gnu/store/fha6q9yc1sbbq3fbgbfjc8ch5gxw17az-cl-hu.dwim.asdf-20200724/share/common-lisp/source/cl-hu.dwim.asdf/hu.dwim.asdf.documentation.asd))))))entry(namedocnode(type directoryentry(namecl-hu.dwim.asdf-20200724node(type directoryentry(nameLICENCEnode(typeregularcontentsžHU.DWIM.ASDF is public domain software: Authors dedicate this work to public domain, for the benefit of the public at large and to the detriment of the authors' heirs and successors. Authors intends this dedication to be an overt act of relinquishment in perpetuity of all present and future rights under copyright law, whether vested or contingent, in the work. Authors understands that such relinquishment of all rights includes the relinquishment of all rights to enforce (by lawsuit or otherwise) those copyrights in the work. Authors recognize that, once placed in the public domain, the work may be freely reproduced, distributed, transmitted, used, modified, built upon, or otherwise exploited by anyone for any purpose, commercial or non-commercial, and in any way, including by methods that have not yet been invented or conceived. In those legislations where public domain dedications are not recognized or possible, HU.DWIM.ASDF is distributed under the following terms and conditions: 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 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. )))))))))