Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Added ability to create documentation pieces with images. #57

Merged
merged 1 commit into from
Jan 5, 2025
Merged

Added ability to create documentation pieces with images. #57

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
199 changes: 159 additions & 40 deletions full/commondoc/image.lisp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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)))

Expand Down Expand Up @@ -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)))))

15 changes: 15 additions & 0 deletions full/doc.lisp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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))
Expand Down Expand Up @@ -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))


Expand Down Expand Up @@ -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"
Expand Down
7 changes: 7 additions & 0 deletions src/changelog.lisp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -143,6 +143,7 @@
"SLY"
"API"
"SBCL"
"PlantUML"
"COMMONDOC:SECTION"
"COLLECT-REACHABLE-OBJECTS"
"LOCATE-AND-COLLECT-REACHABLE-OBJECTS"
Expand All @@ -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
Expand Down
Loading