cage/tinmop
1
0
Fork 0
mirror of https://codeberg.org/cage/tinmop/ synced 2025-02-02 04:36:43 +01:00
Code Issues

-[gemini] removed loop when going back in history.

Browse Source 
when follownig  a redirect  both the original  (the redirect)  and the
actual URI was saved in the history.   So if an user, after followed a
redirect, tried to go back would reach the same redirect, this generated
a loop.
This commit is contained in:
cage 2021-04-28 20:56:37 +02:00
parent 5a8f8edf87
commit 29c09553d1
4 changed files with 16 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
src/gemini-viewer-metadata.lisp
View File

@ -37,7 +37,7 @@
source-file))
object)
(defun add-url-to-history (window url)
(defun push-url-to-history (window url)
(let* ((metadata (message-window:metadata window))
(history (reverse (gemini-metadata-history metadata)))
(last-entry (safe-last-elt (gemini-metadata-history metadata))))
@ -47,6 +47,14 @@
(reverse (push url history))))
window))
(defun pop-url-from-history (window)
(with-accessors ((metadata message-window:metadata)) window
(let* ((history (gemini-metadata-history metadata))
(new-history (misc:safe-all-but-last-elt history)))
(setf (gemini-metadata-history metadata)
new-history)
history)))
(defun maybe-initialize-metadata (window)
(when (not (gemini-metadata-p (message-window:metadata window)))
(setf (message-window:metadata window)

5
src/gemini-viewer.lisp
View File

@ -566,6 +566,7 @@
(gemini-client:debug-gemini "response redirect to: ~s" meta)
(flet ((on-input-complete (maybe-accepted)
(when (ui::boolean-input-accepted-p maybe-accepted)
(pop-url-from-history specials:*message-window*)
(let ((new-url (gemini-client:build-redirect-iri meta
parsed-iri)))
(db-utils:with-ready-database (:connect nil)
@ -624,7 +625,7 @@
(if (find-db-stream-url actual-iri)
(progn
(gemini-client:debug-gemini "caching found for ~a" actual-iri)
(add-url-to-history specials:*message-window* actual-iri)
(push-url-to-history specials:*message-window* actual-iri)
(db-entry-to-foreground actual-iri))
(progn
(gemini-client:debug-gemini "caching *not* found for ~a" actual-iri)
@ -639,7 +640,7 @@
(find-db-stream-url actual-iri)))
(when (null enqueue)
(ensure-just-one-stream-rendering))
(add-url-to-history specials:*message-window* actual-iri)
(push-url-to-history specials:*message-window* actual-iri)
(gemini-client:request-dispatch url gemini-client::dispatch-table)))))
(gemini-client:gemini-tofu-error (e)
(let ((host (gemini-client:host e)))

3
src/package.lisp
View File

@ -2248,7 +2248,8 @@
:copy-gemini-metadata
:append-metadata-link
:append-metadata-source
:add-url-to-history
:push-url-to-history
:pop-url-from-history
:current-gemini-url
:history-back
:view-source

4
src/program-events.lisp
View File

@ -1052,7 +1052,7 @@
(ir (gemini-parser:sexp->text-rows parsed
gemini-client:*gemini-page-theme*)))
(gemini-viewer:maybe-initialize-metadata window)
(gemini-viewer:add-url-to-history window index-path)
(gemini-viewer:push-url-to-history window index-path)
(refresh-gemini-message-window links raw-text ir nil)
(windows:draw window)))
(t
@ -1067,7 +1067,7 @@
(ir-text (gemini-parser:sexp->text-rows parsed
gemini-client:*gemini-page-theme*)))
(gemini-viewer:maybe-initialize-metadata window)
(gemini-viewer:add-url-to-history window local-path)
(gemini-viewer:push-url-to-history window local-path)
(refresh-gemini-message-window links file-string ir-text nil)
(windows:draw window))))))))