changelog shortlog graph tags branches changeset files revisions annotate raw help

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

changeset 698: 96958d3eb5b0
parent: 0f0e5f9b5c55
author: Richard Westhaver <ellis@rwest.io>
date: Fri, 04 Oct 2024 22:04:59 -0400
permissions: -rw-r--r--
description: fixes 
     1 ;;; doc/dist.lisp --- Lisp Distribution Documentation
     2 
     3 ;; Documentation utilities for Lisp 'Distributions'. Typically this
     4 ;; refers specifically to objects of type QL-DIST:DIST.
     5 
     6 ;;; Commentary:
     7 
     8 ;; public distros: Quicklisp, Ultralisp
     9 
    10 ;;; Code:
    11 (in-package :doc)
    12 
    13 (defclass dist-documentation ()
    14   ((dist :initarg :dist :type dist :accessor doc-dist)
    15    (systems :initarg :systems :type list :accessor doc-systems)))
    16 
    17 (defun dist-documentation (dist &optional all)
    18   "Return the DIST-DOCUMENTATION for a specified DIST."
    19   (unless (typep dist 'dist)
    20     (setf dist (find-dist (format nil "~(~A~)" dist))))
    21   (make-instance 'dist-documentation
    22     :dist dist
    23     :systems
    24     (remove-if #'null 
    25                (mapcar
    26                 (lambda (s)
    27                   ;; may need (ignore-errors-if (error-p) body)
    28                   (ignore-errors
    29                    ;; can do better here anyway
    30                    (when-let ((found (find-system (doc-system s) nil)))
    31                      (system-documentation found))))
    32                 (if all 
    33                     (provided-systems dist)
    34                     (installed-systems dist))))))
    35 
    36 (defmethod print-object ((self dist-documentation) stream)
    37   (with-slots (dist systems) self
    38     (print-unreadable-object (self stream :type t)
    39       (format stream "~S :systems ~A" (ql-dist:name dist) (length systems)))))
    40 
    41 ;; maybe except an additional key for specific file types and maybe
    42 ;; include system def files..
    43 (defmethod doc-pathnames ((self dist-documentation)) 
    44   "Return a list of source pathnames from SELF. Includes files and directories."
    45   (remove-duplicates
    46    (apply #'append 
    47           (mapcar #'doc-files
    48                   (doc-systems self)))))
    49 
    50 (defmethod doc-directories ((self dist-documentation))
    51   "Return a list of source directories from SELF."
    52   (remove-if #'uiop:file-pathname-p (doc-pathnames self)))
    53 
    54 (defmethod doc-files ((self dist-documentation))
    55   "Return a list of source files from SELF."
    56   (remove-if #'uiop:directory-pathname-p (doc-pathnames self)))