From faa0223e55bbe7c218d1b729b579ecc2b184fdea Mon Sep 17 00:00:00 2001 From: Alexander Artemenko Date: Sat, 5 Sep 2026 12:06:02 +0300 Subject: [PATCH 1/2] Added image scaling support. --- full/assets.lisp | 141 +++++++++--------- full/builder.lisp | 11 +- full/commondoc/image.lisp | 135 +++++++++++++++-- full/doc.lisp | 29 ++-- .../inline-assets/usecase.spec.md | 42 ++++-- src/changelog.lisp | 4 + test/assets.lisp | 75 +++++++++- 7 files changed, 326 insertions(+), 111 deletions(-) diff --git a/full/assets.lisp b/full/assets.lisp index 4e851d5..23a73cd 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. If exactly one is supplied, +the other is calculated from the source image's aspect ratio. + 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..512553b 100644 --- a/full/commondoc/image.lisp +++ b/full/commondoc/image.lisp @@ -157,6 +157,113 @@ :height height))) +(defun unsigned-16-bit-big-endian (bytes offset) + (+ (ash (aref bytes offset) 8) + (aref bytes (1+ offset)))) + + +(defun unsigned-32-bit-big-endian (bytes offset) + (+ (ash (aref bytes offset) 24) + (ash (aref bytes (+ offset 1)) 16) + (ash (aref bytes (+ offset 2)) 8) + (aref bytes (+ offset 3)))) + + +(defun unsigned-16-bit-little-endian (bytes offset) + (+ (aref bytes offset) + (ash (aref bytes (1+ offset)) 8))) + + +(defun png-dimensions (header) + (when (and (>= (length header) 24) + (equalp (subseq header 0 8) + #(137 80 78 71 13 10 26 10))) + (values (unsigned-32-bit-big-endian header 16) + (unsigned-32-bit-big-endian header 20)))) + + +(defun gif-dimensions (header) + (when (and (>= (length header) 10) + (or (equalp (subseq header 0 6) #(71 73 70 56 55 97)) + (equalp (subseq header 0 6) #(71 73 70 56 57 97)))) + (values (unsigned-16-bit-little-endian header 6) + (unsigned-16-bit-little-endian header 8)))) + + +(defun read-octet (stream) + (or (read-byte stream nil) + (error "Unexpected end of image file."))) + + +(defun read-unsigned-16-bit-big-endian (stream) + (+ (ash (read-octet stream) 8) + (read-octet stream))) + + +(defun jpeg-dimensions (stream) + (when (and (= (read-octet stream) #xff) + (= (read-octet stream) #xd8)) + (loop for marker = (loop for octet = (read-octet stream) + until (/= octet #xff) + finally (return octet)) + until (= marker #xd9) + unless (or (= marker #x01) + (<= #xd0 marker #xd7)) + do (let ((length (read-unsigned-16-bit-big-endian stream))) + (when (< length 2) + (error "Invalid JPEG segment length.")) + (if (member marker '(#xc0 #xc1 #xc2 #xc3 + #xc5 #xc6 #xc7 + #xc9 #xca #xcb + #xcd #xce #xcf)) + (progn + (read-octet stream) + (let ((height (read-unsigned-16-bit-big-endian stream)) + (width (read-unsigned-16-bit-big-endian stream))) + (return (values width height)))) + (file-position stream (+ (file-position stream) + (- length 2)))))))) + + +(defun image-dimensions (path) + "Return the pixel width and height of PNG, GIF, or JPEG PATH." + (with-open-file (stream path :element-type '(unsigned-byte 8)) + (let ((header (make-array 24 :element-type '(unsigned-byte 8))) + (bytes-read 0)) + (setf bytes-read (read-sequence header stream)) + (multiple-value-bind (width height) + (png-dimensions (subseq header 0 bytes-read)) + (if width + (values width height) + (multiple-value-bind (width height) + (gif-dimensions (subseq header 0 bytes-read)) + (if width + (values width height) + (progn + (file-position stream 0) + (jpeg-dimensions stream))))))))) + + +(defun rendered-dimensions (image) + "Return IMAGE dimensions, inferring the missing pixel dimension when possible." + (let ((width (width image)) + (height (height image))) + (cond + ((and (or width height) + (or (null width) (null height)) + (or (integerp width) (integerp height))) + (multiple-value-bind (source-width source-height) + (image-dimensions (common-doc:source image)) + (unless (and source-width source-height) + (error "Unable to determine dimensions of image ~A." + (common-doc:source image))) + (if width + (values width (round (* width source-height) source-width)) + (values (round (* height source-width) source-height) height)))) + (t + (values width height))))) + + (defun replace-images (document) (flet ((replacer (node) (typecase node @@ -252,17 +359,27 @@ new-source) new-source)) (description (common-doc:description obj))) - (with-html - (:img :src src - :alt description - :title description - :width (width obj) - :height (height obj))))) + (multiple-value-bind (width height) + (rendered-dimensions obj) + (with-html + (:img :src src + :alt description + :title description + :width width + :height height))))) (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))) + (multiple-value-bind (width height) + (rendered-dimensions 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..f7ab2b7 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 other is calculated from the source 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..bc4e59b 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. If exactly one is supplied, the other is calculated from the source image's aspect ratio; if both are supplied, both are used. +- **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 the height calculated from the source aspect ratio + 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. ### 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. 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. +Only PNG, GIF, and JPEG sources can have a missing dimension inferred. Rich +metadata and non-image files are outside this use case. ## § 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 the inferred HTML height. | +| TC-012 | DR-9 | Declare only `:HEIGHT` and assert the inferred HTML width. | +| 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..e4b6564 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. When one dimension is given, the other is calculated from the source image 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..38c3324 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-preserves-aspect-ratio-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 infers the source image height" + (let ((output (read-file-into-string output-path))) + (ok (search "width=240" output)) + (ok (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-preserves-aspect-ratio-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 infers the source image width" + (let ((output (read-file-into-string output-path))) + (ok (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 From 5ce103456c341e90d31aa2b05e307785880cc66f Mon Sep 17 00:00:00 2001 From: Alexander Artemenko Date: Sat, 5 Sep 2026 12:20:34 +0300 Subject: [PATCH 2/2] Simplified image scaling. --- full/assets.lisp | 4 +- full/commondoc/image.lisp | 125 ++---------------- full/doc.lisp | 6 +- .../inline-assets/usecase.spec.md | 20 +-- src/changelog.lisp | 2 +- test/assets.lisp | 12 +- 6 files changed, 30 insertions(+), 139 deletions(-) diff --git a/full/assets.lisp b/full/assets.lisp index 23a73cd..b0a5b4d 100644 --- a/full/assets.lisp +++ b/full/assets.lisp @@ -101,8 +101,8 @@ 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. If exactly one is supplied, -the other is calculated from the source image's aspect ratio. +: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) diff --git a/full/commondoc/image.lisp b/full/commondoc/image.lisp index 512553b..5652567 100644 --- a/full/commondoc/image.lisp +++ b/full/commondoc/image.lisp @@ -157,113 +157,6 @@ :height height))) -(defun unsigned-16-bit-big-endian (bytes offset) - (+ (ash (aref bytes offset) 8) - (aref bytes (1+ offset)))) - - -(defun unsigned-32-bit-big-endian (bytes offset) - (+ (ash (aref bytes offset) 24) - (ash (aref bytes (+ offset 1)) 16) - (ash (aref bytes (+ offset 2)) 8) - (aref bytes (+ offset 3)))) - - -(defun unsigned-16-bit-little-endian (bytes offset) - (+ (aref bytes offset) - (ash (aref bytes (1+ offset)) 8))) - - -(defun png-dimensions (header) - (when (and (>= (length header) 24) - (equalp (subseq header 0 8) - #(137 80 78 71 13 10 26 10))) - (values (unsigned-32-bit-big-endian header 16) - (unsigned-32-bit-big-endian header 20)))) - - -(defun gif-dimensions (header) - (when (and (>= (length header) 10) - (or (equalp (subseq header 0 6) #(71 73 70 56 55 97)) - (equalp (subseq header 0 6) #(71 73 70 56 57 97)))) - (values (unsigned-16-bit-little-endian header 6) - (unsigned-16-bit-little-endian header 8)))) - - -(defun read-octet (stream) - (or (read-byte stream nil) - (error "Unexpected end of image file."))) - - -(defun read-unsigned-16-bit-big-endian (stream) - (+ (ash (read-octet stream) 8) - (read-octet stream))) - - -(defun jpeg-dimensions (stream) - (when (and (= (read-octet stream) #xff) - (= (read-octet stream) #xd8)) - (loop for marker = (loop for octet = (read-octet stream) - until (/= octet #xff) - finally (return octet)) - until (= marker #xd9) - unless (or (= marker #x01) - (<= #xd0 marker #xd7)) - do (let ((length (read-unsigned-16-bit-big-endian stream))) - (when (< length 2) - (error "Invalid JPEG segment length.")) - (if (member marker '(#xc0 #xc1 #xc2 #xc3 - #xc5 #xc6 #xc7 - #xc9 #xca #xcb - #xcd #xce #xcf)) - (progn - (read-octet stream) - (let ((height (read-unsigned-16-bit-big-endian stream)) - (width (read-unsigned-16-bit-big-endian stream))) - (return (values width height)))) - (file-position stream (+ (file-position stream) - (- length 2)))))))) - - -(defun image-dimensions (path) - "Return the pixel width and height of PNG, GIF, or JPEG PATH." - (with-open-file (stream path :element-type '(unsigned-byte 8)) - (let ((header (make-array 24 :element-type '(unsigned-byte 8))) - (bytes-read 0)) - (setf bytes-read (read-sequence header stream)) - (multiple-value-bind (width height) - (png-dimensions (subseq header 0 bytes-read)) - (if width - (values width height) - (multiple-value-bind (width height) - (gif-dimensions (subseq header 0 bytes-read)) - (if width - (values width height) - (progn - (file-position stream 0) - (jpeg-dimensions stream))))))))) - - -(defun rendered-dimensions (image) - "Return IMAGE dimensions, inferring the missing pixel dimension when possible." - (let ((width (width image)) - (height (height image))) - (cond - ((and (or width height) - (or (null width) (null height)) - (or (integerp width) (integerp height))) - (multiple-value-bind (source-width source-height) - (image-dimensions (common-doc:source image)) - (unless (and source-width source-height) - (error "Unable to determine dimensions of image ~A." - (common-doc:source image))) - (if width - (values width (round (* width source-height) source-width)) - (values (round (* height source-width) source-height) height)))) - (t - (values width height))))) - - (defun replace-images (document) (flet ((replacer (node) (typecase node @@ -359,21 +252,19 @@ new-source) new-source)) (description (common-doc:description obj))) - (multiple-value-bind (width height) - (rendered-dimensions obj) - (with-html - (:img :src src - :alt description - :title description - :width width - :height height))))) + (with-html + (:img :src src + :alt description + :title description + :width (width obj) + :height (height obj))))) (defmethod common-doc.format:emit-document ((format commondoc-markdown:markdown) (obj local-image) stream) - (multiple-value-bind (width height) - (rendered-dimensions obj) + (let ((width (width obj)) + (height (height obj))) (if (or width height) (format stream "\"~A\"~@[" (image-source obj) diff --git a/full/doc.lisp b/full/doc.lisp index f7ab2b7..3aed912 100644 --- a/full/doc.lisp +++ b/full/doc.lisp @@ -715,9 +715,9 @@ See full list of changes in the 40ANTS-DOC/CHANGELOG::@CHANGELOG section. name should differ. The target must stay below the output directory and must be unique among declared images. - :WIDTH and :HEIGHT are positive pixel values. When only one is given, - the other is calculated from the source image's proportions. Markdown - keeps ordinary image syntax when no size is requested; with a size it + :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)) diff --git a/specs/document-assets/inline-assets/usecase.spec.md b/specs/document-assets/inline-assets/usecase.spec.md index bc4e59b..5965132 100644 --- a/specs/document-assets/inline-assets/usecase.spec.md +++ b/specs/document-assets/inline-assets/usecase.spec.md @@ -31,7 +31,7 @@ A library author declares an image once and places its name in documentation so - **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. If exactly one is supplied, the other is calculated from the source image's aspect ratio; if both are supplied, both are used. +- **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 @@ -79,7 +79,7 @@ Scenario: Render an explicit asset entry (→ DR-2, DR-7) 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 the height calculated from the source aspect ratio + 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) @@ -118,7 +118,7 @@ None. `40ants-doc-full/assets:defimage` registers a symbol, a local pathname designator, and optional `:target-filename`, `:description`, `:width`, and `:height` metadata. Width and height are positive pixels. The default target is -the source's relative pathname. +the source's relative pathname. Only explicitly supplied dimensions are emitted. ### Rendering pipeline @@ -131,9 +131,9 @@ the source's relative pathname. 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. Markdown emits Markdown image syntax without - dimensions and an HTML `img` element with dimensions, all 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 @@ -161,8 +161,8 @@ scoped by package. ### Known Limitations -Only PNG, GIF, and JPEG sources can have a missing dimension inferred. 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 @@ -178,8 +178,8 @@ metadata and non-image files are 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 the inferred HTML height. | -| TC-012 | DR-9 | Declare only `:HEIGHT` and assert the inferred HTML width. | +| 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 diff --git a/src/changelog.lisp b/src/changelog.lisp index e4b6564..dc4ad0f 100644 --- a/src/changelog.lisp +++ b/src/changelog.lisp @@ -160,7 +160,7 @@ "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. When one dimension is given, the other is calculated from the source image proportions.") + * 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 38c3324..f3cbec3 100644 --- a/test/assets.lisp +++ b/test/assets.lisp @@ -133,16 +133,16 @@ (read-file-into-string output-path)))))) -(deftest test-image-width-preserves-aspect-ratio-in-html +(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 infers the source image height" + (testing "A width-only declaration does not emit height" (let ((output (read-file-into-string output-path))) (ok (search "width=240" output)) - (ok (search "height=240" output)))))) + (ok (not (search "height=240" output))))))) (deftest test-image-dimensions-use-html-in-markdown @@ -156,15 +156,15 @@ (read-file-into-string output-path)))))) -(deftest test-image-height-preserves-aspect-ratio-in-html +(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 infers the source image width" + (testing "A height-only declaration does not emit width" (let ((output (read-file-into-string output-path))) - (ok (search "width=180" output)) + (ok (not (search "width=180" output))) (ok (search "height=180" output))))))