changelog shortlog graph tags branches changeset files revisions annotate raw help

Mercurial > core / lisp/lib/doc/system.lisp

changeset 698: 96958d3eb5b0
parent: c0fc6b87557f
author: Richard Westhaver <ellis@rwest.io>
date: Fri, 04 Oct 2024 22:04:59 -0400
permissions: -rw-r--r--
description: fixes 
     1 ;;; lib/doc/system.lisp --- System Documentation
     2 
     3 ;; Documentation support for a Lisp System
     4 
     5 ;;; Code:
     6 (in-package :doc)
     7 
     8 (defclass system-documentation ()
     9   ((system :initarg :system :type system :accessor doc-system)))
    10 
    11 (defun system-documentation (system)
    12   "Return the SYSTEM-DOCUMENTATION for a specified SYSTEM."
    13   (let ((s (find-system system)))
    14     (make-instance 'system-documentation
    15       :system s)))
    16 
    17 (defmethod print-object ((self system-documentation) stream)
    18   (with-slots (system) self
    19     (print-unreadable-object (self stream :type t)
    20       (format stream "~A" (component-name system)))))
    21 
    22 (defmethod doc-files ((self system-documentation))
    23   "Return a list of source file components from SELF."
    24   (flet ((%rec (s) (if (typep s 'asdf:module)
    25                        (doc-files s)
    26                        (component-pathname s))))
    27     (flatten (mapcar #'%rec (component-children (doc-system self))))))
    28 
    29 (defmethod doc-files ((self asdf:module))
    30   (flet ((%rec (s) (if (typep s 'asdf:module)
    31                        (doc-files s)
    32                        (component-pathname s))))
    33     (mapcar #'%rec (component-children self))))
    34   
    35 ;; TODO: to do this correctly we need to also check if SELF is a
    36 ;; prefix of a different system name. e.g. "DOC" and "DOC-UTILS"
    37 
    38 ;; TODO: system separator handling and optimizations
    39 (defmethod doc-packages ((self system-documentation))
    40   "Return a list of packages which can be traced back to SELF. This
    41 method will only return packages that are prefixed with the name of
    42 SELF."
    43   ;; (asdf:component-loaded-p
    44   (let ((s (component-name (doc-system self))))
    45     (mapcar
    46      #'package-documentation
    47      (remove-if #'null
    48                 (mapcar
    49                  (lambda (p)
    50                    (when (and (packagep p) (string-prefix-p (string-upcase s) (package-name p)))
    51                      p))
    52                  (list-all-packages))))))
    53 
    54 (defmethod doc-dependencies ((self system-documentation))
    55   (mapcar #'system-documentation (system-depends-on (doc-system self))))
    56 
    57 (defun find-system-dependents (system)
    58   "Return a list of systems which depend on SYSTEM by iterating over ASDF:REGISTER-SYSTEMS."
    59   (let ((r))
    60   (dolist (s (asdf:registered-systems))
    61     (setf s (find-system s))
    62     (when (and s (member (component-name system)
    63                          (mapcar
    64                           (lambda (dep)
    65                             (when (atom dep)
    66                               (string-downcase (format nil "~A" dep))))
    67                           (asdf:system-depends-on s))
    68                          :test #'equalp))
    69       (push s r)))
    70   r))
    71 
    72 (defmethod doc-dependents ((self system-documentation))
    73   (mapcar #'system-documentation (find-system-dependents (doc-system self))))