cage
/
tinmop
mirror of https://codeberg.org/cage/tinmop/
1
0
Fork 0
Code Issues

- [GUI] changed test for checking a local file; 

- [GUI] checked, when a image is inlined, if it comes from a local path, then try to figure out the format from the file's extension;
- [GUI] [gempub] fixed inlining of cover file.
This commit is contained in:
cage 2024-09-15 18:15:29 +02:00
parent 3ebe35da57
commit 65a368eddb
2 changed files with 40 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
src/gui/client/gempub-window.lisp
View File

@ -115,17 +115,19 @@
(defun make-gempub-index (gempub-metadata)
(let ((gempub-content-directory (extract-gempub (row-path gempub-metadata))))
(cond
((and (row-cover gempub-metadata)
(row-index gempub-metadata))
(construct-cover-page gempub-content-directory
+cover-filename+
(row-index gempub-metadata)
(row-cover gempub-metadata)))
((row-index gempub-metadata)
(row-index gempub-metadata))
(t
gempub-content-directory))))
(values
(cond
((and (row-cover gempub-metadata)
(row-index gempub-metadata))
(construct-cover-page gempub-content-directory
+cover-filename+
(row-index gempub-metadata)
(row-cover gempub-metadata)))
((row-index gempub-metadata)
(row-index gempub-metadata))
(t
gempub-content-directory))
(fs:cat-parent-dir gempub-content-directory "/"))))
(defun open-gempub-clsr (main-window gempub-frame)
(lambda (e)
@ -137,9 +139,11 @@
(row (cev:enqueue-request-and-wait-results :gempub-file-id->row
1
ev:+standard-event-priority+
id))
(path (make-gempub-index row)))
(client-main-window::open-iri path main-window nil)))))
id)))
(multiple-value-bind (path book-directory)
(make-gempub-index row)
(client-main-window::set-address-bar-text main-window book-directory)
(client-main-window::open-iri path main-window nil))))))
(defun init-window (master main-window query-results)
(client-main-window:hide-autocomplete-candidates main-window)

37
src/gui/client/main-window.lisp
View File

@ -536,18 +536,26 @@
(defun inline-image (main-window link-value line-index)
(multiple-value-bind (file-path mime-type)
(slurp-iri main-window (remove-standard-port link-value))
(let ((image (cond
((string= mime-type +mime-type-jpg+)
(scale-jpeg main-window file-path))
((member mime-type
'("image/x-tga" "image/x-targa")
:test #'string=)
(scale-targa main-window file-path))
((string= mime-type +mime-type-png+)
(scale-png main-window file-path))
(t
(gui:make-image file-path))))
(coordinates `(+ (:line ,line-index :char 0) 1 :lines)))
(let* ((local-file (fs:file-exists-p file-path))
(image (cond
((or (string= mime-type +mime-type-jpg+)
(and local-file
(fs:has-extension file-path "jpg")
(fs:has-extension file-path "jpeg")))
(scale-jpeg main-window file-path))
((or (member mime-type
'("image/x-tga" "image/x-targa")
:test #'string=)
(and local-file
(fs:has-extension file-path "tga")))
(scale-targa main-window file-path))
((or (string= mime-type +mime-type-png+)
(and local-file
(fs:has-extension file-path "png")))
(scale-png main-window file-path))
(t
(gui:make-image file-path))))
(coordinates `(+ (:line ,line-index :char 0) 1 :lines)))
(with-accessors ((ir-lines ir-lines)
(ir-rendered-lines ir-rendered-lines)
(gemtext-widget gemtext-widget)) main-window
@ -1147,9 +1155,8 @@ local file paths."
:status status)
(client-stream-frame::refresh-all-streams
(client-stream-frame::table stream-frame))))
((or (null (iri:scheme parsed-iri))
(string= (iri:scheme parsed-iri)
constants:+file-scheme+))
((or (fs:file-exists-p actual-iri)
(fs:directory-exists-p actual-iri))
(initialize-ir-lines main-window)
(open-local-path (iri:path parsed-iri) main-window))
(t