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

Compare commits

base: cage:b91c0786e8db9c4d226f15ced280accd41dd7d39
Branches Tags
cage:master
cage:tk9.0
cage:development
cage:v0.9.9.141421356237
cage:v0.9.9.14142135623
cage:v0.9.9.1414213562
cage:v0.9.9.141421356
cage:v0.9.9.14142135
cage:v0.9.9.1414213
cage:v0.9.9.141421
cage:v0.9.9.14142
cage:v0.9.9.1414
cage:v0.9.9.141
cage:v0.9.9.14
cage:v0.9.9.1
...
compare: cage:94fad8438759a5e37bf6ff8d5d9ae7f201f972fb
Branches Tags
cage:tk9.0
cage:development
cage:master
cage:v0.9.9.141421356237
cage:v0.9.9.14142135623
cage:v0.9.9.1414213562
cage:v0.9.9.141421356
cage:v0.9.9.14142135
cage:v0.9.9.1414213
cage:v0.9.9.141421
cage:v0.9.9.14142
cage:v0.9.9.1414
cage:v0.9.9.141
cage:v0.9.9.14
cage:v0.9.9.1

4 Commits
b91c0786e8 ... 94fad84387

Author SHA1 Message Date
cage 94fad84387 - removed '*use-tk-for-decoding-png*'. 2024-11-24 16:56:31 +01:00
cage e070f89b05 - fixed 'absolute-url-p'. 2024-11-24 16:55:11 +01:00
cage 93dd9b1c11 - [GUI] ensured to lock the gemtext line position when zooming. 2024-11-24 14:42:20 +01:00
cage 4dfa362c0f - [fediverse] fixed test to identify if a post is a poll. 2024-11-13 19:02:23 +01:00
5 changed files with 51 additions and 40 deletions
Show Stats Expand all files Collapse all files

53
src/gui/client/icons.lisp
View File

@ -123,30 +123,29 @@
(client-configuration:config-icons-scaling)))) (client-configuration:config-icons-scaling))))
(defun load-icons () (defun load-icons ()
(let ((nodgui:*use-tk-for-decoding-png* t)) (setf *search* (load-icon +search+))
(setf *search* (load-icon +search+)) (setf *back* (load-icon +back+))
(setf *back* (load-icon +back+)) (setf *open-iri* (load-icon +go+))
(setf *open-iri* (load-icon +go+)) (setf *open-tour* (load-icon +open-tour+))
(setf *open-tour* (load-icon +open-tour+)) (setf *refresh* (load-icon +refresh+))
(setf *refresh* (load-icon +refresh+)) (setf *up* (load-icon +up+))
(setf *up* (load-icon +up+)) (setf *document-delete* (load-icon +document-delete+))
(setf *document-delete* (load-icon +document-delete+)) (setf *document-add* (load-icon +document-add+))
(setf *document-add* (load-icon +document-add+)) (setf *document-accept* (load-icon +document-accept+))
(setf *document-accept* (load-icon +document-accept+)) (setf *document-edit* (load-icon +document-edit+))
(setf *document-edit* (load-icon +document-edit+)) (setf *folder* (load-icon +folder+))
(setf *folder* (load-icon +folder+)) (setf *star-yellow* (load-icon +star-yellow+))
(setf *star-yellow* (load-icon +star-yellow+)) (setf *star-blue* (load-icon +star-blue+))
(setf *star-blue* (load-icon +star-blue+)) (setf *arrow-up* (load-icon +arrow-up+))
(setf *arrow-up* (load-icon +arrow-up+)) (setf *arrow-down* (load-icon +arrow-down+))
(setf *arrow-down* (load-icon +arrow-down+)) (setf *cross* (load-icon +cross+))
(setf *cross* (load-icon +cross+)) (setf *bus-go* (load-icon +bus-go+))
(setf *bus-go* (load-icon +bus-go+)) (setf *dice* (load-icon +dice+))
(setf *dice* (load-icon +dice+)) (setf *gemlog-subscribe* (load-icon +gemlog-subscribe+))
(setf *gemlog-subscribe* (load-icon +gemlog-subscribe+)) (setf *gemlog-unsubscribe* (load-icon +gemlog-unsubscribe+))
(setf *gemlog-unsubscribe* (load-icon +gemlog-unsubscribe+)) (setf *inline-images* (load-icon +inline-images+))
(setf *inline-images* (load-icon +inline-images+)) (setf *text* (load-icon +text+))
(setf *text* (load-icon +text+)) (setf *profile* (load-icon +profile+))
(setf *profile* (load-icon +profile+)) (setf *profile-disabled* (disable-icon +profile+))
(setf *profile-disabled* (disable-icon +profile+)) (setf *toc* (load-icon +toc+))
(setf *toc* (load-icon +toc+)) (setf *toc-disabled* (disable-icon +toc+)))
(setf *toc-disabled* (disable-icon +toc+))))

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

@ -2045,7 +2045,17 @@ local file paths."
(defun scale-gemtext (main-window offset) (defun scale-gemtext (main-window offset)
(ev:with-enqueued-process-and-unblock () (ev:with-enqueued-process-and-unblock ()
(let ((saved-active-stream (find-streaming-stream-url))) (let* ((saved-active-stream (find-streaming-stream-url))
(gemtext-widget (gemtext-widget main-window))
(saved-visible-portion (gui:y-visible-portion gemtext-widget))
(saved-start-visible-portion (getf saved-visible-portion :start))
(gemtext-y (gui:root-y gemtext-widget))
(saved-pixel-y (truncate (- (* saved-start-visible-portion
(gui:window-height gemtext-widget))
gemtext-y)))
(saved-pixel-indices `(:x 0 :y ,saved-pixel-y))
(saved-line-index (gui:index->line-char-coordinates gemtext-widget
saved-pixel-indices)))
(interrupt-rendering main-window) (interrupt-rendering main-window)
(maybe-stop-streaming-stream-thread) (maybe-stop-streaming-stream-thread)
(when saved-active-stream (when saved-active-stream
@ -2061,7 +2071,8 @@ local file paths."
1.0)) 1.0))
(render-ir-lines (get-address-bar-text main-window) main-window) (render-ir-lines (get-address-bar-text main-window) main-window)
(when contains-inlined-images (when contains-inlined-images
(inline-all-images main-window)))))) (inline-all-images main-window))
(gui:scroll-to gemtext-widget `(:line ,saved-line-index :char 0))))))
(defun initialize-keybindings (main-window target) (defun initialize-keybindings (main-window target)
(gui:bind target (gui:bind target

3
src/iri-parser.lisp
View File

@ -405,7 +405,8 @@
(null (iri:host iri))))) (null (iri:host iri)))))
(defun absolute-url-p (url) (defun absolute-url-p (url)
(not (relative-url-p url))) (and (not (relative-url-p url))
(iri:iri-parse url :null-on-error t)))
(defun absolute-url-scheme-p (url expected-scheme) (defun absolute-url-scheme-p (url expected-scheme)
(when-let ((parsed-iri (iri:iri-parse url :null-on-error t))) (when-let ((parsed-iri (iri:iri-parse url :null-on-error t)))

10
src/text-utils.lisp
View File

@ -749,15 +749,15 @@ printed in the box column by column; in the example above the results are:
constants:+internal-scheme-local-posts+))) constants:+internal-scheme-local-posts+)))
"Collect all hyperlinks in a text marked from a list of valid `schemes'" "Collect all hyperlinks in a text marked from a list of valid `schemes'"
(flet ((build-re-scheme () (flet ((build-re-scheme ()
(let ((res "")) (let ((res "^"))
(loop for (scheme . rest) on schemes do (loop for (scheme . rest) on schemes do
(if rest (if rest
(setf res (strcat res "(" scheme ")|")) (setf res (strcat res "(" scheme ")|"))
(setf res (strcat res "(" scheme ")://")))) (setf res (strcat res "(" scheme ")://"))))
(strcat "(" res ")")))) (strcat "(" res ")"))))
(a:when-let* ((all-uris (lines->uri text)) (a:when-let* ((all-uris (lines->uri text))
(re (strcat (build-re-scheme) "\\P{White_Space}+")) (re (strcat (build-re-scheme) "\\P{White_Space}+"))
(scanner (cl-ppcre:create-scanner re))) (scanner (cl-ppcre:create-scanner re)))
(let ((results '())) (let ((results '()))
(loop for uri in all-uris when (cl-ppcre:scan scanner uri) do (loop for uri in all-uris when (cl-ppcre:scan scanner uri) do
(pushnew uri results :test #'string=)) (pushnew uri results :test #'string=))

10
src/ui-goodies.lisp
View File

@ -2304,11 +2304,11 @@ there."
choices))) choices)))
(find-poll-id () (find-poll-id ()
(when-let* ((fields (line-oriented-window:selected-row-fields *thread-window*)) (when-let* ((fields (line-oriented-window:selected-row-fields *thread-window*))
(status-id (db:row-message-status-id fields)) (status-id (db:row-message-status-id fields)))
(reblogged-status-id (db:row-message-reblog-id fields)) (let* ((reblogged-status-id (db:row-message-reblog-id fields))
(poll (or (db:find-poll-bound-to-status status-id) (poll (or (db:find-poll-bound-to-status status-id)
(db:find-poll-bound-to-status reblogged-status-id)))) (db:find-poll-bound-to-status reblogged-status-id))))
(db:row-id poll))) (db:row-id poll))))
(on-input-complete (choices) (on-input-complete (choices)
(let ((choices-list (split-words choices))) (let ((choices-list (split-words choices)))
(if (or (null choices-list) (if (or (null choices-list)