diff --git a/full/commondoc/image.lisp b/full/commondoc/image.lisp index 4dcb020..7a66ba5 100644 --- a/full/commondoc/image.lisp +++ b/full/commondoc/image.lisp @@ -16,58 +16,165 @@ (:import-from #:40ants-doc-full/builder/vars #:*current-asdf-system*) (:import-from #:40ants-doc-full/commondoc/mapper - #:map-nodes)) + #:map-nodes) + (:import-from #:serapeum + #:->) + (:export #:local-image + #:width + #:height)) (in-package #:40ants-doc-full/commondoc/image) + (defclass local-image (common-doc:image) - ((width :initform nil + ((target-filename :initarg :target-filename + :type string + :reader target-filename) + (width :initform nil :initarg :width :reader width) (height :initform nil - :initarg :height - :reader height))) + :initarg :height + :reader height))) -(defun full-path (relative-path) +(defun full-path (path) (cond - ((str:starts-with-p "asdf:" relative-path) + ((str:starts-with-p "asdf:" path) (destructuring-bind (prefix asdf-system-name path) - (str:split ":" relative-path + (str:split ":" path :limit 3) (declare (ignore prefix)) (asdf:system-relative-pathname asdf-system-name path))) + ((uiop:absolute-pathname-p path) + path) (*current-asdf-system* (asdf:system-relative-pathname *current-asdf-system* - relative-path)) + path)) (t - relative-path))) + (merge-pathnames path)))) + + +(-> relative-path (string) + (values string &optional)) + +(defun relative-path (path) + (cond + ((str:starts-with-p "asdf:" path) + (destructuring-bind (prefix asdf-system-name relative-path) + (str:split ":" path + :limit 3) + (declare (ignore prefix asdf-system-name)) + (values relative-path))) + ((uiop:absolute-pathname-p path) + (cond + (*current-asdf-system* + (let ((probably-relative + (enough-namestring path + (asdf:system-relative-pathname *current-asdf-system* + "./")))) + (cond + ((uiop:absolute-pathname-p probably-relative) + ;; If filename is not inside the ASDF system, then probably it is + ;; inside the current directory + (let ((probably-relative + (enough-namestring path))) + (cond + ((uiop:absolute-pathname-p probably-relative) + ;; If filename is not inside the current directory, then there is no + ;; way to learn what is the relative path would be: + (error "Unable to figure out relative path out from ~A path." + path)) + (t + probably-relative)))) + (t + probably-relative)))) + (t + (let ((probably-relative + (enough-namestring path))) + + (cond + ((uiop:absolute-pathname-p probably-relative) + ;; If filename is not inside the current directory, then there is no + ;; way to learn what is the relative path would be: + (error "Unable to figure out relative path out from ~A path." + path)) + (t + probably-relative)))))) + (t + ;; Path already was relative: + path))) + +(defun local-image (path &key target-filename description width height) + "Creates a note for rendering an image in the documentation. + Could be useful if you are constructing document from CommonDoc nodes. + + The SOURCE argument should point to a file on local filesystem. + + For example, here is how this function is used in the + new [`PlantUML` plugin](https://40ants.com/doc-plantuml/): + + ``` + (defmethod to-commondoc ((diagram diagram)) + (uiop:with-temporary-file (:pathname pathname + :type \"png\" + :keep t) + (ensure-directories-exist pathname) + + (40ants-plantuml:render (diagram-code diagram) + pathname) + (let ((image + (local-image + (namestring pathname) + :target-filename (diagram-filename diagram)))) + (common-doc:make-paragraph image)))) + ``` + + This code creates a temporary file, renders a png image into it + and then makes a paragraph with image, pointing to this temp file. +" + + (let ((full-path (full-path path))) + (unless (probe-file full-path) + (error "Image file \"~A\" not found" + full-path)) + + (make-instance + 'local-image + ;; This is the path from where we will copy image file + :source (namestring full-path) + ;; And this is a relative path how we will refer the file + ;; in the documentation: + :target-filename (cond + (target-filename + (namestring target-filename)) + (t + (namestring (relative-path path)))) + :description description + :width width + :height height))) -(defun make-local-image (relative-path &key width height) - (unless (probe-file (full-path relative-path)) - (error "Image file \"~A\" not found" - (full-path relative-path))) - ;; Here we are saving a relative path - ;; because we'll need it later for makeing - ;; the target path: - (make-instance 'local-image :source relative-path - :width width - :height height)) (defun replace-images (document) (flet ((replacer (node) (typecase node + ;; If node is already has needed class, + ;; then leave it as is: + (local-image + node) (common-doc:image - (let ((source (common-doc:source node))) - (if (or (str:starts-with-p "http:" source) - (str:starts-with-p "https:" source)) + (let ((source (common-doc:source node))) + (if (or (str:starts-with-p "http:" source) + (str:starts-with-p "https:" source)) node + ;; We rewrite only nodes pointing to + ;; files on local filesystem: (multiple-value-bind (source width height) (extract-width-and-height source) - (make-local-image source - :width width - :height height))))) + (local-image source + :width width + :height height))))) (t node)))) (map-nodes document #'replacer))) @@ -100,31 +207,43 @@ width height))) + (define-emitter (obj local-image) "Emit a local-image and move referenced image into the HTML documentation folder." - (let* ((original-path (common-doc:source obj)) - (source-path (full-path original-path)) - (target-path (uiop:merge-pathnames* original-path - (uiop:merge-pathnames* #P"images/" - (uiop:ensure-directory-pathname - 40ants-doc-full/builder/vars::*base-dir*)))) + (let* ((source-path + ;; This is the path from where we will copy file: + (common-doc:source obj)) + ;; Directory where we render all documentation files: + (base-dir + (uiop:ensure-directory-pathname + 40ants-doc-full/builder/vars::*base-dir*)) + (target-path (uiop:merge-pathnames* (target-filename obj) + base-dir)) + ;; Path of the current page: (page-uri (make-page-uri 40ants-doc-full/builder/vars::*current-page*)) + ;; This path will be used on the web page to refer the image: + (relative-path (namestring + (uiop:enough-pathname target-path + base-dir))) (new-source (make-relative-path page-uri - (format nil "images/~A" - original-path))) + relative-path)) (src (if common-html.emitter:*image-format-control* - (format nil common-html.emitter:*image-format-control* - new-source) - new-source)) + (format nil common-html.emitter:*image-format-control* + new-source) + new-source)) (description (common-doc:description obj))) - (ensure-directories-exist target-path) - (log:info "Copying image from ~A to ~A" source-path target-path) - (uiop:copy-file source-path - target-path) + (unless (equal source-path + target-path) + (log:info "Copying image from ~A to ~A" source-path target-path) + (ensure-directories-exist target-path) + (uiop:copy-file source-path + target-path)) + (with-html (:img :src src :alt description :title description :width (width obj) :height (height obj))))) + diff --git a/full/doc.lisp b/full/doc.lisp index f76ccf3..a89e4c4 100644 --- a/full/doc.lisp +++ b/full/doc.lisp @@ -62,6 +62,10 @@ #:mathjax) (:import-from #:40ants-doc-full/plugins/highlightjs #:highlightjs) + (:import-from #:40ants-doc-full/commondoc/image + #:height + #:width + #:local-image) (:export #:@index #:@readme #:@changelog)) @@ -626,6 +630,7 @@ See full list of changes in the 40ANTS-DOC/CHANGELOG::@CHANGELOG section. (@locatives-and-references section) (@new-object-types section) (@reference-based-extensions section) + (@including-images section) (@sections section)) @@ -662,6 +667,16 @@ See full list of changes in the 40ANTS-DOC/CHANGELOG::@CHANGELOG section. (with-node-package macro)) +(defsection @including-images (:title "Including Images" + :ignore-words ("PlantUML")) + "Besides refering images in the Markdown syntax like was shown in the 40ANTS-DOC-FULL/MARKDOWN::@MARKDOWN-IMAGES section, + you can construct CommonDoc documents including images as objects." + (local-image function) + (local-image class) + (width (reader local-image)) + (height (reader local-image))) + + (defsection @reference-based-extensions (:title "Reference Based Extensions" :ignore-words ("DEFINE-DIRECTION" diff --git a/src/changelog.lisp b/src/changelog.lisp index d2d49c6..975950c 100644 --- a/src/changelog.lisp +++ b/src/changelog.lisp @@ -143,6 +143,7 @@ "SLY" "API" "SBCL" + "PlantUML" "COMMONDOC:SECTION" "COLLECT-REACHABLE-OBJECTS" "LOCATE-AND-COLLECT-REACHABLE-OBJECTS" @@ -154,6 +155,12 @@ "CLEAN-URLS" ;; These objects are not documented yet: "40ANTS-DOC/COMMONDOC/XREF:XREF")) + (0.21.0 2025-01-05 + "* Changed a way how images are processed. New behaviour should be backward compatible, + but now it is possible. But now 40ANTS-DOC-FULL/COMMONDOC/IMAGE:LOCAL-IMAGE function + is exported. You can use this function to build a piece of documentation and include + an image into this doc. See function's docstring for usage example. + ") (0.20.1 2024-12-14 "* Fixed dependency from swank-backend package for autodoc package.") (0.20.0 2024-12-14