Commit 2c7c60aa authored by Pascal J. Bourguignon's avatar Pascal J. Bourguignon

Reorganized tools/source and asdf-file utilities.

parent 165f7694
......@@ -31,8 +31,6 @@
;;;; You should have received a copy of the GNU Affero General Public License
;;;; along with this program. If not, see <http://www.gnu.org/licenses/>
;;;;**************************************************************************
(in-package "COMMON-LISP-USER")
(defpackage "COM.INFORMATIMAGO.CLMISC.RESOURCE-UTILIZATION"
(:use "COMMON-LISP")
......
;;;; -*- mode:lisp;coding:utf-8 -*-
;;;;**************************************************************************
;;;;FILE: com.informatimago.common-lisp.cesarum-test.asd
;;;;LANGUAGE: Common-Lisp
;;;;SYSTEM: Common-Lisp
;;;;USER-INTERFACE: NONE
;;;;DESCRIPTION
;;;;
;;;; ASD file to test the com.informatimago.common-lisp.cesarum library.
;;;;
;;;;AUTHORS
;;;; <PJB> Pascal J. Bourguignon <pjb@informatimago.com>
;;;;MODIFICATIONS
;;;; 2015-01-08 <PJB> Created this .asd file.
;;;;BUGS
;;;;LEGAL
;;;; AGPL3
;;;;
;;;; Copyright Pascal J. Bourguignon 2015 - 2015
;;;;
;;;; This program is free software: you can redistribute it and/or modify
;;;; it under the terms of the GNU Affero General Public License as published by
;;;; the Free Software Foundation, either version 3 of the License, or
;;;; (at your option) any later version.
;;;;
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;;; GNU Affero General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU Affero General Public License
;;;; along with this program. If not, see http://www.gnu.org/licenses/
;;;;**************************************************************************
#+clisp
(unless custom:*ansi*
(warn "System ~A: clisp should be used with -ansi or (setf custom:*ansi* t) in ~/.clisprc"
:com.informatimago.common-lisp.cesarum-test))
(asdf:defsystem "com.informatimago.common-lisp.cesarum-test"
;; system attributes:
:description "Tests the cesarum library."
:author "Pascal J. Bourguignon <pjb@informatimago.com>"
:maintainer "Pascal J. Bourguignon <pjb@informatimago.com>"
:licence "AGPL3"
;; component attributes:
:name "com.informatimago.common-lisp.cesarum-test"
:version "1.3.3"
:properties ((#:author-email . "pjb@informatimago.com")
(#:date . "Winter 2015")
((#:albert #:output-dir) . "/tmp/documentation/com.informatimago.common-lisp.cesarum-test/")
((#:albert #:formats) . ("docbook"))
((#:albert #:docbook #:template) . "book")
((#:albert #:docbook #:bgcolor) . "white")
((#:albert #:docbook #:textcolor) . "black"))
#+asdf-unicode :encoding #+asdf-unicode :utf-8
:depends-on ("com.informatimago.common-lisp.cesarum")
:perform (asdf:test-op
(o s)
(let ((*package* (find-package "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.SET")))
(uiop:symbol-call "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.SET" "TEST/ALL"))
(let ((*package* (find-package "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.INDEX-SET")))
(uiop:symbol-call "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.INDEX-SET" "TEST/ALL")))
:components ((:file "set-test" :depends-on ())
(:file "index-set-test" :depends-on ("set-test"))))
;;;; THE END ;;;;
;;;; -*- mode:lisp;coding:utf-8 -*-
;;;;**************************************************************************
;;;;FILE: com.informatimago.common-lisp.lisp-reader-test.asd
;;;;LANGUAGE: Common-Lisp
;;;;SYSTEM: Common-Lisp
;;;;USER-INTERFACE: NONE
;;;;DESCRIPTION
;;;;
;;;; ASD file to test the com.informatimago.common-lisp.lisp-reader library.
;;;;
;;;;AUTHORS
;;;; <PJB> Pascal J. Bourguignon <pjb@informatimago.com>
;;;;MODIFICATIONS
;;;; 2015-01-25 <PJB> Created this .asd file.
;;;;BUGS
;;;;LEGAL
;;;; AGPL3
;;;;
;;;; Copyright Pascal J. Bourguignon 2015 - 2015
;;;;
;;;; This program is free software: you can redistribute it and/or modify
;;;; it under the terms of the GNU Affero General Public License as published by
;;;; the Free Software Foundation, either version 3 of the License, or
;;;; (at your option) any later version.
;;;;
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;;; GNU Affero General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU Affero General Public License
;;;; along with this program. If not, see http://www.gnu.org/licenses/
;;;;**************************************************************************
(asdf:defsystem "com.informatimago.common-lisp.lisp-reader-test"
;; system attributes:
:description "Tests the lisp-reader library."
:author "Pascal J. Bourguignon <pjb@informatimago.com>"
:maintainer "Pascal J. Bourguignon <pjb@informatimago.com>"
:licence "AGPL3"
;; component attributes:
:name "com.informatimago.common-lisp.lisp-reader-test"
:version "1.0.0"
:properties ((#:author-email . "pjb@informatimago.com")
(#:date . "Winter 2015")
((#:albert #:output-dir) . "/tmp/documentation/com.informatimago.common-lisp.lisp-reader-test/")
((#:albert #:formats) . ("docbook"))
((#:albert #:docbook #:template) . "book")
((#:albert #:docbook #:bgcolor) . "white")
((#:albert #:docbook #:textcolor) . "black"))
#+asdf-unicode :encoding #+asdf-unicode :utf-8
:depends-on ("com.informatimago.common-lisp.lisp-reader")
:perform (asdf:test-op
(o s)
(let ((*package* (find-package "COM.INFORMATIMAGO.COMMON-LISP.LISP-READER.READER.TEST")))
(uiop:symbol-call "COM.INFORMATIMAGO.COMMON-LISP.LISP-READER.READER.TEST" "TEST/ALL")))
:components ((:file "reader-test" :depends-on ())))
;;;; THE END ;;;;
;;;; -*- mode:lisp;coding:utf-8 -*-
;;;;**************************************************************************
;;;;FILE: read-sources.lisp
;;;;FILE: analyse-patchwork.lisp
;;;;LANGUAGE: Common-Lisp
;;;;SYSTEM: Common-Lisp
;;;;USER-INTERFACE: NONE
;;;;DESCRIPTION
;;;;
;;;; Read the patchwork sources.
;;;; Read and analyse the patchwork sources.
;;;;
;;;;AUTHORS
;;;; <PJB> Pascal J. Bourguignon <pjb@informatimago.com>
......@@ -36,7 +36,7 @@
(declaim (declaration also-use-packages))
(declaim (also-use-packages "COM.INFORMATIMAGO.COMMON-LISP.PICTURE.TREE-TO-ASCII"))
(defpackage "COM.INFORMATIMAGO.READ-SOURCES"
(defpackage "COM.INFORMATIMAGO.TOOLS.ANALYSE-PATCHWORK"
(:use "COMMON-LISP"
"COM.INFORMATIMAGO.COMMON-LISP.CESARUM.UTILITY"
"COM.INFORMATIMAGO.COMMON-LISP.CESARUM.GRAPH"
......@@ -44,7 +44,7 @@
"COM.INFORMATIMAGO.TOOLS.ASDF-FILE")
(:export "READ-SOURCES" "*CONTENTS*")
(:shadow "CLASS" "CLASS-NAME" "FIND-CLASS"))
(in-package "COM.INFORMATIMAGO.READ-SOURCES")
(in-package "COM.INFORMATIMAGO.TOOLS.ANALYSE-PATCHWORK")
(defun safe-find-package (designator)
(or (cl:find-package designator)
......@@ -378,3 +378,5 @@ common-lisp:package and common-lisp:symbol.
;; (find-all-forms 'import)
;; (("pw-lib/epw-1.0b/import" (import '(patch-work:new-menu patch-work:pw-addmenu))))
;; nil
;;;; THE END ;;;;
This diff is collapsed.
......@@ -33,11 +33,27 @@
;;;;**************************************************************************
(defpackage "COM.INFORMATIMAGO.TOOLS.CHECK-ASDF"
(:use "CL")
(:use "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.UTILITY")
(:use "COM.INFORMATIMAGO.TOOLS.ASDF-FILE")
(:use "COM.INFORMATIMAGO.TOOLS.DEPENDENCY-CYCLES")
(:export "CHECK-ASDF-SYSTEM-FILE")
(:use "COMMON-LISP"
"COM.INFORMATIMAGO.COMMON-LISP.CESARUM.UTILITY"
"COM.INFORMATIMAGO.COMMON-LISP.CESARUM.LIST"
"COM.INFORMATIMAGO.COMMON-LISP.CESARUM.GRAPH"
"COM.INFORMATIMAGO.TOOLS.DEPENDENCY-CYCLES")
(:import-from "COM.INFORMATIMAGO.COMMON-LISP.SCRIPT"
"SHELL")
(:export
;; Loading simple ASD files:
"LOAD-SIMPLE-ASD-FILE"
"ASDF-FILE" "ASDF-FILE-P" "MAKE-ASDF-FILE" "COPY-ASDF-FILE"
"ASDF-FILE-PATH" "ASDF-FILE-DEPENDS-ON" "ASDF-FILE-REACHABLE"
;; Generate dot file from a asdf-file graphs
"GENERATE-DOT" "DOT"
"ADJACENCY-LIST" "REACHABLE-LIST"
"DEPENDENCIES"
;; Check asdf files
"CHECK-ASDF-SYSTEM-FILE")
(:documentation "
Check an asdf file for circular dependencies.
......@@ -68,6 +84,146 @@ License:
"))
(in-package "COM.INFORMATIMAGO.TOOLS.CHECK-ASDF")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Read Simple ASD Files
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defstruct asdf-file
path
depends-on
reachable)
(defmethod print-object ((self asdf-file) stream)
(if *print-readably*
(format stream "#.(~S ~S ~S)" 'intern-file (asdf-file-path self) '*asdf-files*)
(print-unreadable-object (self stream :identity t :type t)
(format stream "~S" (asdf-file-path self))))
self)
(defun intern-file (path asdf-files)
(let ((file (gethash path asdf-files)))
(or file
(setf (gethash path asdf-files) (make-asdf-file :path path)))))
(defvar *asdf-files* (make-hash-table :test (function equal))
"For interactive exploring, we keep a reference to the last loaded
asdf files hash-table in this variable.")
(defun load-simple-asd-file (path)
"
RETURN: A hash-table mapping file paths to ASDF-FILE structures.
"
(setf *asdf-files*
(let ((asdf-files (make-hash-table :test (function equal))))
(let ((system (with-open-file (stream path) (read stream))))
(dolist (compo (getf (cddr system) :components))
(when (and (listp compo)
(eq :file (first compo)))
(let ((file (intern-file (second compo) asdf-files)))
(dolist (depend (getf (cddr compo) :depends-on))
(when (stringp depend)
(push (intern-file depend asdf-files) (asdf-file-depends-on file))))))))
(maphash (lambda (path file)
(declare (ignore path))
(setf (asdf-file-reachable file)
(transitive-closure (function asdf-file-depends-on) (asdf-file-depends-on file))))
asdf-files)
asdf-files)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Generate dot file from a asdf-file graphs
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defmethod adjacency-list ((file asdf-file))
(asdf-file-depends-on file))
(defmethod reachable-list ((file asdf-file))
(asdf-file-reachable file))
(defun dependencies (p q) (member q (asdf-file-reachable p)))
(defmethod generate-dot ((file asdf-file))
(let ((style "filled")
(color "black")
(fillcolor "LightYellow")
(label (pathname-name (asdf-file-path file))))
(format nil "~S [ style=~A color=~A fillcolor=~A label=\"~A\" ];~%"
(pathname-name (asdf-file-path file)) style color fillcolor label)))
(defmethod generate-dot ((edge cons))
(format nil "~S -> ~S [ weight=~D, style=~A, color=~A ];~%"
(pathname-name (asdf-file-path (car edge)))
(pathname-name (asdf-file-path (cdr edge)))
1
"solid" ; "dotted" "dashed" "bold"
"black"))
(defmethod generate-dot ((path pathname))
"
RETURN: A string containing the dot file data for this graph.
"
(let ((files (load-simple-asd-file path)))
(with-output-to-string (*standard-output*)
(format t "digraph ~S~%" (pathname-name path))
(format t "{~%")
(format t "rankdir=~A;~%" "TB")
(format t "concentrate=~:[false~;true~];~%" t)
(mapc 'write-string '(
"// attributes of graph:~%"
"// page=8,11.4; // page size (NeXTprinter:A4).~%"
"// size=30,8; // graph size (please edit to fit).~%"
"// rotate=90; // graph orientation (please edit to fit).~%"
"// ratio=fill; // fill the size (or compress, auto, aspect/ratio).~%"
"nodesep=0.3;~%"
"ranksep=0.3;~%"
"center=1;~%"
"// common attributes of NODES:~%"
"node [height=0.2 width=0.5 shape=box fontsize=8 fontname=Times] ;~%"))
(maphash (lambda (key file)
(declare (ignore key))
(write-string (generate-dot file))) files)
(format t "// common attributes of edges:~%edge [style=solid];~%")
(maphash (lambda (key file)
(declare (ignore key))
(dolist (dependency (asdf-file-depends-on file))
(write-string (generate-dot (cons file dependency)))))
files)
(format t "}~%"))))
;; (COM.INFORMATIMAGO.TOOLS.ASDF-FILE:generate-dot #P"/Users/pjb/src/public/lisp/tools/com.informatimago.tools.check-asdf.asd")
(defun dot (path)
(let ((path.dot (make-pathname :defaults path :type "dot"))
(path.pdf (make-pathname :defaults path :type "pdf")))
(with-open-file (dot path.dot
:direction :output
:if-does-not-exist :create
:if-exists :supersede)
(write-string (generate-dot path) dot))
(shell "/opt/local/bin/dot -Tpdf -o ~S ~S"
(#+ccl ccl:native-translated-namestring #-ccl namestring path.pdf)
(#+ccl ccl:native-translated-namestring #-ccl namestring path.dot))
(shell "open ~S"
(#+ccl ccl:native-translated-namestring #-ccl namestring path.pdf))))
;; (dot #P"/Users/pjb/src/public/lisp/tools/com.informatimago.tools.check-asdf.asd")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Check asdf files
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar *sorted-files* nil)
(defun check-asdf-system-file (asd-file &key (report *standard-output*))
......
This diff is collapsed.
This diff is collapsed.
;;;; -*- coding:utf-8 -*-
;;;;****************************************************************************
;;;;FILE: summary.lisp
;;;;LANGUAGE: Common-Lisp
;;;;SYSTEM: UNIX
;;;;USER-INTERFACE: UNIX
;;;;DESCRIPTION
;;;;
;;;; This script generates HTML summaries of lisp packages.
;;;;
;;;;USAGE
;;;;
;;;;AUTHORS
;;;; <PJB> Pascal J. Bourguignon <pjb@informatimago.com>
;;;;MODIFICATIONS
;;;; 2015-02-23 <PJB> Extracted from make-depends.lisp
;;;; 2003-05-04 <PJB> Converted to Common-Lisp from emacs.
;;;; 2002-11-16 <PJB> Created.
;;;;BUGS
;;;;LEGAL
;;;; AGPL3
;;;;
;;;; Copyright Pascal J. Bourguignon 2002 - 2015
;;;;
;;;; This program is free software: you can redistribute it and/or modify
;;;; it under the terms of the GNU Affero General Public License as published by
;;;; the Free Software Foundation, either version 3 of the License, or
;;;; (at your option) any later version.
;;;;
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;;; GNU Affero General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU Affero General Public License
;;;; along with this program. If not, see <http://www.gnu.org/licenses/>
;;;;****************************************************************************
(in-package "COMMON-LISP-USER")
(declaim (declaration also-use-packages))
(declaim (also-use-packages "COM.INFORMATIMAGO.COMMON-LISP.HTML-GENERATOR.HTML"))
(eval-when (:compile-toplevel :load-toplevel :execute)
(com.informatimago.common-lisp.cesarum.package:add-nickname
"COM.INFORMATIMAGO.COMMON-LISP.HTML-GENERATOR.HTML" "HTML"))
(defpackage "COM.INFORMATIMAGO.COMMON-LISP.TOOLS.SUMMARY"
(:use "COMMON-LISP"
"COM.INFORMATIMAGO.COMMON-LISP.CESARUM.UTILITY"
"COM.INFORMATIMAGO.COMMON-LISP.CESARUM.LIST"
"COM.INFORMATIMAGO.COMMON-LISP.CESARUM.STRING"
"COM.INFORMATIMAGO.COMMON-LISP.CESARUM.CHARACTER-SETS"
"COM.INFORMATIMAGO.COMMON-LISP.CESARUM.FILE"
"COM.INFORMATIMAGO.CLEXT.CHARACTER-SETS"
"COM.INFORMATIMAGO.COMMON-LISP.TOOLS.READ-SOURCE")
(:export "GENERATE-SUMMARY")
(:documentation "
This script generates HTML summaries of lisp packages.
USAGE
(generate-summary '(\"read-source\")
:repository-url (lambda (path)
(format nil \"http://localhost/doc/~A.html\"
(translate-logical-pathname path))))
LICENSE
AGPL3
Copyright Pascal J. Bourguignon 2002 - 2015
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Affero General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU Affero General Public License for more details.
You should have received a copy of the GNU Affero General Public License
along with this program. If not, see <http://www.gnu.org/licenses/>
"))
(in-package "COM.INFORMATIMAGO.COMMON-LISP.TOOLS.SUMMARY")
(defun generate-summary (sources &key (summary-path #p"SUMMARY.HTML")
(character-set "US-ASCII")
(source-type "LISP")
(verbose nil) (repository-url nil))
"Generates a HTML summary of the sources"
(assert (functionp repository-url) (repository-url)
"REPOSITORY-URL must be a (function (pathname) string)")
(let ((cs (etypecase character-set
(character-set character-set)
(string (find-character-set character-set))
(symbol (find-character-set (string character-set))))))
(unless cs (error "Cannot find the character set ~A" character-set))
(with-open-file (html summary-path
:direction :output
:if-does-not-exist :create
:if-exists :supersede
:external-format (character-set-to-lisp-encoding cs))
(html:with-html-output (html :encoding cs)
(html:doctype :transitional
(html:comment "-*- coding:~A -*-"
(character-set-to-emacs-encoding cs))
(html:html -
(html:head -
(html:title - (html:pcdata "Summary"))
(html:meta
(list :http-equiv "Content-Type"
:content (format nil "text/html;charset=~A"
(character-set-to-mime-encoding cs)))))
(html:body -
(dolist (source sources)
(let* ((path (make-pathname
:name (string-downcase source)
:type source-type
:case :local))
(source-file (get-source-file path))
(header (source-file-header source-file))
(package (or (header-slot header :package)
(first (source-file-packages-defined source-file))
;; for files without a package (eg emacs files)
;; we make a pseudo-package named as the file.
(make-instance 'source-package
:name (pathname-name path)
:nicknames '()
:documentation nil
:use '()
:shadow '()
:shadowing-import-from '()
:import-from '()
:export '()
:intern '()))))
(when verbose
(format *trace-output* ";; Processing ~S~%" source)
(format *trace-output* ";; PATH = ~S~%" path)
;;(format *trace-output* ";; HEADER = ~S~%" header)
(format *trace-output* ";; PACKAGE = ~S~%"
(source-package-name package))
(finish-output *trace-output*))
(unless (header-slot header :noweb)
(html:li -
(html:tt -
(html:b -
(html:a
(:href (funcall repository-url
(com.informatimago.common-lisp.cesarum.package:package-pathname
(source-package-name package))))
(html:pcdata "~A" (source-package-name package)))))
(html:pre -
(dolist (line (header-description header))
(html:cdata "~A~%" line))))))))))))))
;;;; THE END ;;;;
Markdown is supported
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