cage/tinmop
1
0
Fork 0
mirror of https://codeberg.org/cage/tinmop/ synced 2025-01-31 04:24:48 +01:00
Code Issues

- [gemini] added a command to refresh a page;

Browse Source 
- refactoring some code to add the above command.
This commit is contained in:
cage 2020-12-29 12:36:10 +01:00
parent f0b6a00d6b
commit 94a8e29f84
8 changed files with 54 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
etc/init.lisp
View File

@ -319,6 +319,8 @@
(define-key "c" #'gemini-open-certificates-window *gemini-message-keymap*)
(define-key "r" #'gemini-refresh-page *gemini-message-keymap*)
;; gemini stream window keymap
(define-key "a" #'gemini-abort-download *gemini-downloads-keymap*)
@ -333,8 +335,6 @@
;; gemini certificates window keymap
(define-key "a" #'gemini-abort-download *gemini-certificates-keymap*)
(define-key "up" #'gemini-certificate-window-go-up *gemini-certificates-keymap*)
(define-key "down" #'gemini-certificate-window-go-down *gemini-certificates-keymap*)

7
modules/share-gemini-link.lisp
View File

@ -17,14 +17,11 @@
(in-package :modules)
(defun gemini-window-p ()
(gemini-viewer:gemini-metadata-p (message-window:metadata specials:*message-window*)))
(defun share-gemini-link ()
"Share the link pointing to the current gemini page on pleroma."
(if (gemini-window-p)
(if (message-window:gemini-window-p)
(let* ((metadata (message-window:metadata specials:*message-window*))
(link (last-elt (gemini-viewer:gemini-metadata-history metadata)))
(link (gemini-viewer:current-gemini-url))
(source (gemini-viewer:gemini-metadata-source-file metadata))
(source-head (with-input-from-string (stream source)
(read-line stream nil "...")))

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

@ -50,3 +50,9 @@
(setf (message-window:metadata window)
(make-gemini-metadata)))
(message-window:metadata window))
(defun current-gemini-url ()
(when (message-window:gemini-window-p)
(let* ((metadata (message-window:metadata specials:*message-window*))
(link (last-elt (gemini-viewer:gemini-metadata-history metadata))))
link)))

43
src/gemini-viewer.lisp
View File

@ -57,6 +57,22 @@
:rendering)))))
(setf (stream-status current-rendering) :streaming))))
(defun abort-download-stream (url &key
(remove-wainting-stream-event t)
(redraw-stream-window t))
(when-let ((stream-object (find-db-stream-url url)))
(abort-downloading stream-object)
(remove-db-stream stream-object)
(when remove-wainting-stream-event
(program-events:remove-event-if (lambda (a)
(and (typep a
'program-events:gemini-got-line-event)
(string= url
(download-iri stream-object))))))
(when (and redraw-stream-window
specials:*gemini-streams-window*)
(line-oriented-window:resync-rows-db specials:*gemini-streams-window*))))
(defun force-rendering-of-cached-file (stream-object)
;; this is more than a mere setter
;; and is 'eql' specialized on rendering
@ -426,7 +442,7 @@
(multiple-value-bind (actual-iri host path query port fragment)
(displace-iri parsed-iri)
(if (find-db-stream-url actual-iri)
(gemini-viewer:db-entry-to-foreground actual-iri)
(db-entry-to-foreground actual-iri)
(request (gemini-parser:make-gemini-iri host
path
:query query
@ -622,7 +638,7 @@
(ui:info-message (format nil (_ "Going back to: ~a") last))
(let ((found (find-db-stream-url last)))
(if found
(gemini-viewer:db-entry-to-foreground last)
(db-entry-to-foreground last)
(request last))))) ; this should never happens
(defun view-source (window)
@ -681,29 +697,6 @@
(win-clear object)
(draw object))))))
;; (defmethod draw :before ((object gemini-streams-window))
;; (with-accessors ((rows rows)
;; (uses-border-p uses-border-p)
;; (single-row-height single-row-height)
;; (top-row-padding top-row-padding)
;; (new-messages-mark new-messages-mark)
;; (top-rows-slice top-rows-slice)
;; (bottom-rows-slice bottom-rows-slice)) object
;; (let ((y-start (if uses-border-p
;; 1
;; 0)))
;; (renderizable-rows-data object) ; set top and bottom slice
;; (win-clear object)
;; (with-croatoan-window (croatoan-window object)
;; (loop
;; for gemini-stream in (safe-subseq rows top-rows-slice bottom-rows-slice)
;; for y from (+ y-start top-row-padding) by single-row-height do
;; (print-text object
;; gemini-stream
;; 1 y
;; :bgcolor (bgcolor croatoan-window)
;; :fgcolor (fgcolor croatoan-window)))))))
(defun open-gemini-stream-window ()
(let* ((low-level-window (make-croatoan-window :enable-function-keys t)))
(setf *gemini-streams-window*

3
src/message-window.lisp
View File

@ -33,6 +33,9 @@
:initarg :metadata
:accessor metadata)))
(defun gemini-window-p ()
(gemini-viewer:gemini-metadata-p (message-window:metadata specials:*message-window*)))
(defun display-gemini-text-p (window)
(eq (keybindings window)
keybindings:*gemini-message-keymap*))

6
src/package.lisp
View File

@ -1847,6 +1847,7 @@
:message-window
:source-text
:metadata
:gemini-window-p
:display-gemini-text-p
:display-chat-p
:prepare-for-display-status-mode
@ -2105,6 +2106,7 @@
:find-db-stream-if
:find-db-stream-url
:ensure-just-one-stream-rendering
:abort-download-stream
:db-entry-to-foreground
:gemini-metadata-p
:make-gemini-metadata
@ -2116,6 +2118,7 @@
:append-metadata-link
:append-metadata-source
:add-url-to-history
:current-gemini-url
:history-back
:view-source
:gemini-stream
@ -2320,7 +2323,8 @@
:gemini-streams-window-up
:gemini-streams-window-down
:gemini-streams-window-close
:gemini-streams-window-open-stream))
:gemini-streams-window-open-stream
:gemini-refresh-page))
(defpackage :scheduled-events
(:use

10
src/program-events.lisp
View File

@ -1076,13 +1076,9 @@
(defmethod process-event ((object gemini-abort-downloading-event))
(with-accessors ((iri payload)) object
(when-let ((stream-object (gemini-viewer:find-db-stream-url iri)))
(gemini-viewer:abort-downloading stream-object)
(gemini-viewer:remove-db-stream stream-object)
(remove-event-if (lambda (a)
(and (typep a 'gemini-got-line-event)
(string= iri (gemini-viewer:download-iri stream-object)))))
(line-oriented-window:resync-rows-db specials:*gemini-streams-window*))))
(gemini-viewer:abort-download-stream iri
:remove-wainting-stream-event t
:redraw-stream-window t)))
(defclass gemini-abort-all-downloading-event (program-event) ())

16
src/ui-goodies.lisp
View File

@ -1728,7 +1728,7 @@ mot recent updated to least recent"
(defun gemini-abort-download ()
"Stop a transferring data from a gemini server"
(when-let* ((fields (line-oriented-window:selected-row-fields *gemini-streams-window*))
(when-let* ((fields (line-oriented-window:selected-row-fields *gemini-streams-window*))
(iri-to-abort (gemini-viewer:download-iri fields))
(event (make-instance 'gemini-abort-downloading-event
:payload iri-to-abort
@ -1763,3 +1763,17 @@ mot recent updated to least recent"
(when-let* ((fields (line-oriented-window:selected-row-fields *gemini-streams-window*))
(iri-to-open (gemini-viewer:download-iri fields)))
(gemini-viewer:db-entry-to-foreground iri-to-open)))
(defun gemini-refresh-page ()
"Refresh current gemini page"
(when-let* ((url (gemini-viewer:current-gemini-url))
(event-abort (make-instance 'gemini-abort-downloading-event
:payload url
:priority program-events:+maximum-event-priority+))
(event-open (make-instance 'gemini-request-event
;; :priority
;; program-events:+maximum-event-priority+
:use-cached-file-if-exists nil
:url url)))
(push-event event-abort)
(push-event event-open)))