diff --git a/full/assets.lisp b/full/assets.lisp index 4e851d5..b0a5b4d 100644 --- a/full/assets.lisp +++ b/full/assets.lisp @@ -8,31 +8,33 @@ #:xref #:xref-locative #:xref-symbol) - (:export #:defasset)) + (:export #:defimage)) (in-package #:40ants-doc-full/assets) -(defclass asset () +(defclass image () ((name :initarg :name - :reader asset-name) + :reader image-name) (source :initarg :source - :reader asset-source) + :reader image-source) (target-filename :initarg :target-filename - :reader asset-target-filename) + :reader image-target-filename) (description :initarg :description - :reader asset-description) + :reader image-description) (width :initarg :width :initform nil - :reader asset-width) + :type (or null (integer 1 *)) + :reader image-width) (height :initarg :height :initform nil - :reader asset-height))) + :type (or null (integer 1 *)) + :reader image-height))) -(defun make-asset (name source target-filename description &rest restargs +(defun make-image (name source target-filename description &rest restargs &key width height) (declare (ignore width height)) - (apply #'make-instance 'asset + (apply #'make-instance 'image :name name :source source :target-filename target-filename @@ -40,67 +42,72 @@ restargs)) -(defvar *assets* (make-hash-table :test #'eq)) +(defvar *images* (make-hash-table :test #'eq)) -(defun asset-symbol-p (symbol) - (not (null (gethash symbol *assets*)))) +(defun image-symbol-p (symbol) + (not (null (gethash symbol *images*)))) (defmethod 40ants-doc::transform-symbol-entry :around ((entry symbol)) - (or (gethash entry *assets*) + (or (gethash entry *images*) (call-next-method))) -(defmethod 40ants-doc/object-package::object-package ((asset asset)) - (symbol-package (asset-name asset))) +(defmethod 40ants-doc/object-package::object-package ((image image)) + (symbol-package (image-name image))) (defun pathname-designator-string (pathname-designator) (namestring (pathname pathname-designator))) -(defun register-asset (name source &key target-filename description width height) +(defun register-image (name source &key target-filename description width height) (check-type name symbol) (check-type source (or string pathname)) + (check-type width (or null (integer 1 *))) + (check-type height (or null (integer 1 *))) (let* ((source (pathname-designator-string source)) (target-filename (pathname-designator-string (or target-filename source))) (description (or description (symbol-name name))) - (new-asset (make-asset name source target-filename description + (new-image (make-image name source target-filename description :width width :height height)) - (old-asset (gethash name *assets*))) - (when (and old-asset - (not (and (string= (asset-source old-asset) - (asset-source new-asset)) - (string= (asset-target-filename old-asset) - (asset-target-filename new-asset)) - (string= (asset-description old-asset) - (asset-description new-asset)) - (equal (asset-width old-asset) - (asset-width new-asset)) - (equal (asset-height old-asset) - (asset-height new-asset))))) - (error "Asset ~S is already registered with different properties." + (old-image (gethash name *images*))) + (when (and old-image + (not (and (string= (image-source old-image) + (image-source new-image)) + (string= (image-target-filename old-image) + (image-target-filename new-image)) + (string= (image-description old-image) + (image-description new-image)) + (equal (image-width old-image) + (image-width new-image)) + (equal (image-height old-image) + (image-height new-image))))) + (error "Image ~S is already registered with different properties." name)) - (setf (gethash name *assets*) new-asset) - new-asset)) + (setf (gethash name *images*) new-image) + new-image)) -(defmacro defasset (name source &rest args) +(defmacro defimage (name source &rest args) "Register NAME as a local image used in documentation. SOURCE is a pathname designator. By default, the file is copied to the same relative pathname below the documentation output directory. Use :TARGET-FILENAME to choose another relative output pathname. +:WIDTH and :HEIGHT are positive pixel values. Only supplied dimensions are +emitted, so browsers preserve the image's aspect ratio when one is omitted. + Every unqualified occurrence of NAME in prose is rendered as an image." (check-type name symbol) `(eval-when (:compile-toplevel :load-toplevel :execute) - (register-asset ',name ,source ,@args))) + (register-image ',name ,source ,@args))) (defun safe-target-filename-p (target-filename) @@ -109,48 +116,48 @@ Every unqualified occurrence of NAME in prose is rendered as an image." (not (member :up (pathname-directory pathname)))))) -(defun validate-asset (asset) +(defun validate-image (image) (unless (probe-file (40ants-doc-full/commondoc/image::resolve-local-image-path - (asset-source asset))) - (error "Asset ~S source file does not exist: ~A" - (asset-name asset) - (asset-source asset))) - - (unless (safe-target-filename-p (asset-target-filename asset)) - (error "Asset ~S target filename is not below the output directory: ~A" - (asset-name asset) - (asset-target-filename asset))) - - (maphash (lambda (name other-asset) - (when (and (not (eq name (asset-name asset))) - (string= (asset-target-filename other-asset) - (asset-target-filename asset))) - (error "Assets ~S and ~S use the same target filename: ~A" - (asset-name asset) + (image-source image))) + (error "Image ~S source file does not exist: ~A" + (image-name image) + (image-source image))) + + (unless (safe-target-filename-p (image-target-filename image)) + (error "Image ~S target filename is not below the output directory: ~A" + (image-name image) + (image-target-filename image))) + + (maphash (lambda (name other-image) + (when (and (not (eq name (image-name image))) + (string= (image-target-filename other-image) + (image-target-filename image))) + (error "Images ~S and ~S use the same target filename: ~A" + (image-name image) name - (asset-target-filename asset)))) - *assets*) - asset) + (image-target-filename image)))) + *images*) + image) -(defun asset-to-local-image (asset) - (validate-asset asset) - (local-image (asset-source asset) - :target-filename (asset-target-filename asset) - :description (asset-description asset) - :width (asset-width asset) - :height (asset-height asset))) +(defun image-to-local-image (image) + (validate-image image) + (local-image (image-source image) + :target-filename (image-target-filename image) + :description (image-description image) + :width (image-width image) + :height (image-height image))) -(defun replace-assets (document) - "Replace XREF nodes naming registered assets with local image nodes." +(defun replace-images (document) + "Replace XREF nodes naming registered images with local image nodes." (map-nodes document (lambda (node) (if (and (typep node 'xref) (null (xref-locative node))) - (let ((asset (gethash (xref-symbol node) *assets*))) - (if asset - (asset-to-local-image asset) + (let ((image (gethash (xref-symbol node) *images*))) + (if image + (image-to-local-image image) node)) node)))) diff --git a/full/builder.lisp b/full/builder.lisp index de27649..f449d62 100644 --- a/full/builder.lisp +++ b/full/builder.lisp @@ -75,7 +75,8 @@ (40ants-doc-full/world::@world section)) -(defsection @rendering-multiple-formats (:title "Multiple Formats") +(defsection @rendering-multiple-formats (:title "Multiple Formats" + :ignore-words ("PAGE")) "With 40ANTS-DOC you can render HTML and Markdown documentation simultaneously. This way, you can cross-reference entities from the README.md or ChangeLog.md to HTML docs. @@ -211,8 +212,8 @@ (defmethod 40ants-doc-full/commondoc/builder:to-commondoc - ((asset 40ants-doc-full/assets::asset)) - (40ants-doc-full/assets::asset-to-local-image asset)) + ((image 40ants-doc-full/assets::image)) + (40ants-doc-full/assets::image-to-local-image image)) ;;; Generate with the default HTML look @@ -227,9 +228,9 @@ document :predicate (if 40ants-doc-full/builder/printer:*document-uppercase-is-code* (constantly t) - #'40ants-doc-full/assets::asset-symbol-p))) + #'40ants-doc-full/assets::image-symbol-p))) (document (40ants-doc-full/commondoc/xref:fill-locatives document)) - (document (40ants-doc-full/assets::replace-assets document)) + (document (40ants-doc-full/assets::replace-images document)) (document (40ants-doc-full/commondoc/section::fill-html-fragments document)) (document (40ants-doc-full/commondoc/page::warn-on-references-to-internals document)) (document (if 40ants-doc-full/link:*document-link-code* diff --git a/full/commondoc/image.lisp b/full/commondoc/image.lisp index a6ddc65..5652567 100644 --- a/full/commondoc/image.lisp +++ b/full/commondoc/image.lisp @@ -263,6 +263,14 @@ (defmethod common-doc.format:emit-document ((format commondoc-markdown:markdown) (obj local-image) stream) - (format stream "![~A](~A)" - (common-doc:description obj) - (image-source obj))) + (let ((width (width obj)) + (height (height obj))) + (if (or width height) + (format stream "\"~A\"~@[" + (image-source obj) + (common-doc:description obj) + width + height) + (format stream "![~A](~A)" + (common-doc:description obj) + (image-source obj))))) diff --git a/full/doc.lisp b/full/doc.lisp index 7385917..3aed912 100644 --- a/full/doc.lisp +++ b/full/doc.lisp @@ -67,7 +67,7 @@ #:width #:local-image) (:import-from #:40ants-doc-full/assets - #:defasset) + #:defimage) (:import-from #:40ants-doc/object-package #:object-package) (:export #:@index @@ -109,7 +109,9 @@ "3BMD" "PYTHONIC-STRING-READER" "DOCS-BUILDER" - "COMMON-DOC:DOCUMENT-NODE")) + "COMMON-DOC:DOCUMENT-NODE" + "DEFASSET" + "DEFIMAGE")) (defparameter *badges* @@ -129,8 +131,9 @@ ")) -(defasset @logo.png "static/logo.png" - :description "40ants-doc logo") +(defimage @logo.png "static/logo.png" + :description "40ants-doc logo" + :width 256) (defsection @index (:title "40Ants Doc Manual" :ignore-words *ignore-words*) @@ -691,14 +694,15 @@ See full list of changes in the 40ANTS-DOC/CHANGELOG::@CHANGELOG section. (height (reader local-image))) -(defsection @declaring-assets (:title "Declaring Assets") - "Use DEFASSET to declare a local image once and render it anywhere in - prose by writing its name. The asset is copied to the documentation +(defsection @declaring-assets (:title "Declaring Images") + "Use DEFIMAGE to declare a local image once and render it anywhere in + prose by writing its name. The image is copied to the documentation output directory, and its name becomes an HTML or Markdown image depending on the target format. ```lisp - (defasset @demo.gif #\"static/demo.gif\") + (defimage @demo.gif #\"static/demo.gif\" + :width 240) (defsection @example () \"Here is @DEMO.GIF.\" @@ -709,8 +713,13 @@ See full list of changes in the 40ANTS-DOC/CHANGELOG::@CHANGELOG section. By default, the source's relative pathname is retained below the output directory. Use the :TARGET-FILENAME option when the output name should differ. The target must stay below the output directory - and must be unique among declared assets." - (defasset macro)) + and must be unique among declared images. + + :WIDTH and :HEIGHT are positive pixel values. When only one is given, the + browser preserves the image's proportions. Markdown keeps ordinary image + syntax when no size is requested; with a size it + emits an HTML `` tag, because standard Markdown has no dimensions." + (defimage macro)) (defsection @reference-based-extensions diff --git a/specs/document-assets/inline-assets/usecase.spec.md b/specs/document-assets/inline-assets/usecase.spec.md index 2d26d03..5965132 100644 --- a/specs/document-assets/inline-assets/usecase.spec.md +++ b/specs/document-assets/inline-assets/usecase.spec.md @@ -2,9 +2,9 @@ id: DOC-ASSET-INLINE-001 type: use-case parent: DOC-ASSET -title: "Render declared asset inline" +title: "Render declared image inline" status: implemented -change_class: additive +change_class: breaking actors: [Library author, Documentation reader] emits: [AssetRegistered, AssetRendered] consumes: [AssetDeclaration, DocumentationSource] @@ -14,12 +14,12 @@ owners: tester: "@codex" tags: [assets, inline-image, html, markdown] created: 2026-09-03 -updated: 2026-09-04 +updated: 2026-09-05 --- ## § Intent -A library author declares an image once and places its name in documentation so a documentation reader sees that image in the rendered format. If the declaration cannot be resolved safely, rendering stops instead of emitting a broken image. +A library author declares an image once and places its name in documentation so a documentation reader sees that image in the rendered format and requested size. If the declaration cannot be resolved safely, rendering stops instead of emitting a broken image. ## § Domain Rules @@ -30,6 +30,9 @@ A library author declares an image once and places its name in documentation so - **DR-5**: Repeated occurrences of the same asset do not duplicate its output file. - **DR-6**: A declared asset name in prose is recognized even when implicit uppercase-code formatting is disabled. - **DR-7**: A declared asset symbol may be used directly as a DEFSECTION entry and becomes an image. +- **DR-8**: `DEFIMAGE` is the sole declaration API; `DEFASSET` is unavailable. +- **DR-9**: `:WIDTH` and `:HEIGHT` are positive pixel counts. Each supplied value is emitted as an image attribute; an omitted value is not emitted. +- **DR-10**: Markdown without dimensions uses Markdown image syntax. Markdown with dimensions uses an HTML `img` element so both dimensions are preserved. ## § Acceptance Criteria @@ -73,6 +76,12 @@ Scenario: Render an explicit asset entry (→ DR-2, DR-7) When the author renders documentation Then the page contains an image for @DEMO.GIF +Scenario: Scale a declared image (→ DR-8, DR-9, DR-10) + Given an author has declared @DEMO.GIF with only :WIDTH 240 + When the author renders HTML or Markdown documentation + Then the output contains width 240 and no height attribute + And Markdown contains an HTML img element + Scenario: Reject an unusable declaration (→ DR-1, DR-3) Given an author has declared an asset with an absent source or unsafe output path When the author renders documentation containing its name @@ -106,23 +115,25 @@ None. ### Public API -`40ants-doc-full/assets:defasset` registers a symbol, a local pathname +`40ants-doc-full/assets:defimage` registers a symbol, a local pathname designator, and optional `:target-filename`, `:description`, `:width`, and -`:height` metadata. The default target is the source's relative pathname. +`:height` metadata. Width and height are positive pixels. The default target is +the source's relative pathname. Only explicitly supplied dimensions are emitted. ### Rendering pipeline 1. The existing XREF pass recognizes dotted asset names such as `@DEMO.GIF`. 2. When implicit uppercase-code formatting is disabled, the XREF pass extracts only registered asset names. -3. `replace-assets` changes an XREF with a registered symbol into a +3. `replace-images` changes an XREF with a registered symbol into a `local-image` node before normal XREF replacement. 4. A registered symbol used directly as a DEFSECTION entry is transformed into its asset and then into a `local-image` by the builder. 5. The builder copies all `local-image` nodes once per target before emitting pages, independent of the selected document format. -6. HTML emits an `img` element and Markdown emits Markdown image syntax, both - calculated relative to the page being rendered. +6. HTML emits an `img` element with supplied dimensions. Markdown emits Markdown + image syntax without dimensions and an HTML `img` element with dimensions, + all calculated relative to the page being rendered. ### Validation @@ -133,7 +144,7 @@ target paths, and rejects targets registered by another asset name. ### File Map -- `full/assets.lisp` — registry, `defasset`, validation, and XREF replacement. +- `full/assets.lisp` — image registry, `defimage`, validation, and XREF replacement. - `full/commondoc/image.lisp` — shared pre-render copying and HTML/Markdown image emission. - `full/builder.lisp` — invokes asset replacement and the common copying step. @@ -145,13 +156,13 @@ target paths, and rejects targets registered by another asset name. ### Trade-offs The registry is process-local, matching existing load-time documentation -definitions. Asset names are symbol identities, so declarations are naturally +definitions. Image names are symbol identities, so declarations are naturally scoped by package. ### Known Limitations -Assets are local images in this version. Rich metadata and non-image files are -outside this use case. +Image dimensions are not read from source files; browsers preserve aspect ratio +when only one HTML dimension is supplied. ## § Test Plan @@ -167,10 +178,13 @@ outside this use case. | TC-008 | Static analysis | Run `40ants-linter` for core, full, and test systems with imports checking. | | TC-009 | DR-6 | Disable implicit uppercase-code formatting and assert a bare asset name is emitted as an image. | | TC-010 | DR-7 | Use an asset symbol directly in DEFSECTION and assert Markdown image output. | +| TC-011 | DR-9 | Declare only `:WIDTH` and assert HTML contains no height attribute. | +| TC-012 | DR-9 | Declare only `:HEIGHT` and assert HTML contains no width attribute. | +| TC-013 | DR-10 | Declare both dimensions and assert Markdown emits a sized HTML `img`. | ## § QA Review -- All acceptance criteria are covered by TC-001 through TC-010. +- All acceptance criteria are covered by TC-001 through TC-013. - The negative scenarios cover missing input, unsafe traversal, and a duplicate output target. - IDMP is implemented through a target-keyed copy set; TC-006 verifies the diff --git a/src/changelog.lisp b/src/changelog.lisp index d9d0f8e..dc4ad0f 100644 --- a/src/changelog.lisp +++ b/src/changelog.lisp @@ -154,9 +154,13 @@ "*DOCUMENT-DOWNCASE-UPPERCASE-CODE*" "*DOCUMENT-UPPERCASE-IS-CODE*" "DEFASSET" + "DEFIMAGE" "CLEAN-URLS" ;; These objects are not documented yet: "40ANTS-DOC/COMMONDOC/XREF:XREF")) + (0.28.0 2026-09-05 + "* Replaced DEFASSET with DEFIMAGE for declaring local documentation images. + * Added :WIDTH and :HEIGHT to DEFIMAGE. Only supplied image dimensions are emitted, allowing browsers to preserve proportions.") (0.27.0 2026-09-04 "* Added DEFASSET for declaring local image assets that render in HTML and Markdown. * Declared assets can be included in prose or as standalone DEFSECTION entries, including when *DOCUMENT-UPPERCASE-IS-CODE* is disabled.") diff --git a/test/assets.lisp b/test/assets.lisp index 2439a6a..f3cbec3 100644 --- a/test/assets.lisp +++ b/test/assets.lisp @@ -3,7 +3,7 @@ (:import-from #:40ants-doc #:defsection) (:import-from #:40ants-doc-full/assets - #:defasset) + #:defimage) (:import-from #:40ants-doc-full/builder #:render-to-files) (:import-from #:40ants-doc-full/builder/printer @@ -18,23 +18,39 @@ (in-package #:40ants-doc-test/assets) -(defasset @test-asset.png +(defimage @test-asset.png "static/rendering.png" :target-filename "assets/test-rendering.png") -(defasset @missing-asset.png +(defimage @scaled-asset.png + "static/rendering.png" + :target-filename "assets/scaled-rendering.png" + :width 240) + +(defimage @fixed-size-asset.png + "static/rendering.png" + :target-filename "assets/fixed-size-rendering.png" + :width 320 + :height 180) + +(defimage @height-asset.png + "static/rendering.png" + :target-filename "assets/height-rendering.png" + :height 180) + +(defimage @missing-asset.png "test/data/does-not-exist.png" :target-filename "assets/missing.png") -(defasset @unsafe-asset.png +(defimage @unsafe-asset.png #.(asdf:system-relative-pathname :40ants-doc "static/rendering.png") :target-filename "../outside.png") -(defasset @colliding-asset-a.png +(defimage @colliding-asset-a.png #.(asdf:system-relative-pathname :40ants-doc "static/rendering.png") :target-filename "assets/collision.png") -(defasset @colliding-asset-b.png +(defimage @colliding-asset-b.png #.(asdf:system-relative-pathname :40ants-doc "static/rendering.png") :target-filename "assets/collision.png") @@ -52,6 +68,18 @@ @test-asset.png) +(defsection @scaled-asset-page (:export nil) + "@SCALED-ASSET.PNG") + + +(defsection @fixed-size-asset-page (:export nil) + "@FIXED-SIZE-ASSET.PNG") + + +(defsection @height-asset-page (:export nil) + "@HEIGHT-ASSET.PNG") + + (defsection @missing-asset-page (:export nil) "@MISSING-ASSET.PNG") @@ -105,6 +133,41 @@ (read-file-into-string output-path)))))) +(deftest test-image-width-is-emitted-without-height-in-html + (multiple-value-bind (output-dir output-path) + (render-to-files @scaled-asset-page + :base-dir (make-test-output-directory) + :format :html) + (declare (ignore output-dir)) + (testing "A width-only declaration does not emit height" + (let ((output (read-file-into-string output-path))) + (ok (search "width=240" output)) + (ok (not (search "height=240" output))))))) + + +(deftest test-image-dimensions-use-html-in-markdown + (multiple-value-bind (output-dir output-path) + (render-to-files @fixed-size-asset-page + :base-dir (make-test-output-directory) + :format :markdown) + (declare (ignore output-dir)) + (testing "Markdown uses HTML to retain both dimensions" + (ok (search "\"@FIXED-SIZE-ASSET.PNG\"" + (read-file-into-string output-path)))))) + + +(deftest test-image-height-is-emitted-without-width-in-html + (multiple-value-bind (output-dir output-path) + (render-to-files @height-asset-page + :base-dir (make-test-output-directory) + :format :html) + (declare (ignore output-dir)) + (testing "A height-only declaration does not emit width" + (let ((output (read-file-into-string output-path))) + (ok (not (search "width=180" output))) + (ok (search "height=180" output)))))) + + (deftest test-repeated-asset-is-copied-to-one-target (multiple-value-bind (output-dir output-path) (render-to-files @repeated-asset-page