cage/tinmop
1
0
Fork 0
mirror of https://codeberg.org/cage/tinmop/ synced 2025-03-12 11:20:05 +01:00
Code Issues

- [GUI] made inlining images idempotent;

Browse Source 
- improved default theme's visuals;

- refactored 'split-words'.
This commit is contained in:
cage 2024-11-01 10:52:12 +01:00
parent 0a484ea39c
commit 96cc3b62c4
4 changed files with 74 additions and 60 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
etc/default-theme.conf
View File

@ -19,7 +19,7 @@
# - underline
# - blink
announcements.icon = "📣"
announcements.icon = "📢"
announcements.separator = "∴ ∴ ∴"
@ -723,7 +723,7 @@ gopher-window.line.prefix.attribute = bold
# Some examples follows, order matters!
# footnotes
# footnotes reference number
color-regexp = "[⁰¹²³⁴⁵⁶⁷⁸⁹]" #f7a805 italic
@ -818,6 +818,11 @@ color-regexp = "\*[^*]+\*" #ffff00 bold
#color-regexp = "/[^/]+/" #ffff00 italic
# footnotes
color-regexp = "[0-9][0-9]*·" #f7a805 italic
#########################
# ⚠ EXPERIMENTAL ZONE ⚠ #
#########################

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

@ -569,60 +569,70 @@
(scale-pixmap main-window file 'nodgui.pixmap:png))
(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))
(a:when-let* ((local-file (fs:file-exists-p file-path))
(image (handler-case
(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)))
(error (e)
(let ((error-message (format nil
(_ "unable to inline ~a: ~a")
link-value
e)))
(gui-goodies:notify-request-error error-message)
nil))))
(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
(let* ((parent-line (elt ir-lines (- line-index 1)))
(new-line (copy-list parent-line)))
(gui:move-cursor-to gemtext-widget coordinates)
(gui:insert-text gemtext-widget (format nil "~%"))
(gui:insert-image gemtext-widget image coordinates)
(setf (getf new-line :type) (link-contains-inline-type-p link-value))
(setf ir-lines
(fresh-vector-insert@ ir-lines
new-line
line-index))
(setf ir-rendered-lines
(fresh-vector-insert@ ir-rendered-lines
""
line-index)))))))
(with-accessors ((ir-lines ir-lines)
(ir-rendered-lines ir-rendered-lines)
(gemtext-widget gemtext-widget)) main-window
(when (not (image-inlined-p ir-lines line-index))
(multiple-value-bind (file-path mime-type)
(slurp-iri main-window (remove-standard-port link-value))
(a:when-let* ((local-file (fs:file-exists-p file-path))
(image (handler-case
(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)))
(error (e)
(let ((error-message (format nil
(_ "unable to inline ~a: ~a")
link-value
e)))
(gui-goodies:notify-request-error error-message)
nil))))
(coordinates `(+ (:line ,line-index :char 0) 1 :lines)))
(let* ((parent-line (elt ir-lines (- line-index 1)))
(new-line (copy-list parent-line)))
(gui:move-cursor-to gemtext-widget coordinates)
(gui:insert-text gemtext-widget (format nil "~%"))
(gui:insert-image gemtext-widget image coordinates)
(setf (getf new-line :type) (link-contains-inline-type-p link-value))
(setf ir-lines
(fresh-vector-insert@ ir-lines
new-line
line-index))
(setf ir-rendered-lines
(fresh-vector-insert@ ir-rendered-lines
""
line-index))))))))
(defun image-inlined-p (lines line-number)
(if (< (1- line-number)
(1- (length lines)))
(eq (getf (elt lines line-number) ; getting the line *next* to the link
:type)
+inline-ir-type+)))
(defun inline-all-images (main-window)
"Note that this functions assumes that all remote IRI resources are
absolute (i.e. with scheme component), non absolute IRI are considered
local file paths."
(labels ((inline-single-image (lines line-number)
(when (< (1- line-number) (length lines))
(when (and (< (1- line-number)
(length lines))
(not (image-inlined-p lines line-number)))
(let ((line (elt lines (1- line-number))))
(if (and (string= (getf line :type) "a")
(inline-image-p (getf line :href)))

9
src/html-utils.lisp
View File

@ -152,13 +152,12 @@ Some convenience functions are provided to works with these structures.
(incf link-count)
(if link
(format footnotes-stream
"~a ~a~%"
(number->superscripts link-count)
"~a· ~a~%"
link-count
(attribute-value link))
(format footnotes-stream
"~a ~a~%"
(number->superscripts link-count)
(_ "No address found")))
(_ "~a· No address found~%")
link-count))
(descend-children node)
(when add-link-footnotes
(format body-stream

10
src/text-utils.lisp
View File

@ -181,11 +181,11 @@
(declare (ignore blanks))
s)
(let ((scanner-including-zero-width (cl-ppcre:create-scanner (strcat "(\\p{White_Space})|("
;; \\x200B → #\ZERO_WIDTH_SPACE
(string (code-char #x200B))
")")))
(scanner (cl-ppcre:create-scanner "\\p{White_Space}")))
(let* ((re-including-zero-width (format nil
"(\\p{White_Space})|(~a)"
#\ZERO_WIDTH_SPACE))
(scanner-including-zero-width (cl-ppcre:create-scanner re-including-zero-width))
(scanner (cl-ppcre:create-scanner "\\p{White_Space}")))
(defun split-words (text &key (include-zero-width-space nil))
(if include-zero-width-space
(cl-ppcre:split scanner-including-zero-width text)