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

- [gemini] added slot 'status-stream'. 

This will allow to enqueue multiple documents download.
This commit is contained in:
cage 2020-08-29 10:53:52 +02:00
parent 0816a6a78c
commit 4941c21d94
6 changed files with 117 additions and 79 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
configure vendored
View File

@ -1,6 +1,6 @@
#! /bin/sh #! /bin/sh
# Guess values for system-dependent variables and create Makefiles. # Guess values for system-dependent variables and create Makefiles.
# Generated by GNU Autoconf 2.69 for tinmop 0.1.6. # Generated by GNU Autoconf 2.69 for tinmop 0.1.7.
# #
# Report bugs to <https://notabug.org/cage/tinmop/>. # Report bugs to <https://notabug.org/cage/tinmop/>.
# #
@ -580,8 +580,8 @@ MAKEFLAGS=
# Identity of this package. # Identity of this package.
PACKAGE_NAME='tinmop' PACKAGE_NAME='tinmop'
PACKAGE_TARNAME='tinmop' PACKAGE_TARNAME='tinmop'
PACKAGE_VERSION='0.1.6' PACKAGE_VERSION='0.1.7'
PACKAGE_STRING='tinmop 0.1.6' PACKAGE_STRING='tinmop 0.1.7'
PACKAGE_BUGREPORT='https://notabug.org/cage/tinmop/' PACKAGE_BUGREPORT='https://notabug.org/cage/tinmop/'
PACKAGE_URL='' PACKAGE_URL=''
@ -1278,7 +1278,7 @@ if test "$ac_init_help" = "long"; then
# Omit some internal or obsolete options to make the list less imposing. # Omit some internal or obsolete options to make the list less imposing.
# This message is too long to be a string in the A/UX 3.1 sh. # This message is too long to be a string in the A/UX 3.1 sh.
cat <<_ACEOF cat <<_ACEOF
\`configure' configures tinmop 0.1.6 to adapt to many kinds of systems. \`configure' configures tinmop 0.1.7 to adapt to many kinds of systems.
Usage: $0 [OPTION]... [VAR=VALUE]... Usage: $0 [OPTION]... [VAR=VALUE]...
@ -1349,7 +1349,7 @@ fi
if test -n "$ac_init_help"; then if test -n "$ac_init_help"; then
case $ac_init_help in case $ac_init_help in
short | recursive ) echo "Configuration of tinmop 0.1.6:";; short | recursive ) echo "Configuration of tinmop 0.1.7:";;
esac esac
cat <<\_ACEOF cat <<\_ACEOF
@ -1451,7 +1451,7 @@ fi
test -n "$ac_init_help" && exit $ac_status test -n "$ac_init_help" && exit $ac_status
if $ac_init_version; then if $ac_init_version; then
cat <<\_ACEOF cat <<\_ACEOF
tinmop configure 0.1.6 tinmop configure 0.1.7
generated by GNU Autoconf 2.69 generated by GNU Autoconf 2.69
Copyright (C) 2012 Free Software Foundation, Inc. Copyright (C) 2012 Free Software Foundation, Inc.
@ -1631,7 +1631,7 @@ cat >config.log <<_ACEOF
This file contains any messages produced by compilers while This file contains any messages produced by compilers while
running configure, to aid debugging if configure makes a mistake. running configure, to aid debugging if configure makes a mistake.
It was created by tinmop $as_me 0.1.6, which was It was created by tinmop $as_me 0.1.7, which was
generated by GNU Autoconf 2.69. Invocation command line was generated by GNU Autoconf 2.69. Invocation command line was
$ $0 $@ $ $0 $@
@ -2496,7 +2496,7 @@ fi
# Define the identity of the package. # Define the identity of the package.
PACKAGE='tinmop' PACKAGE='tinmop'
VERSION='0.1.6' VERSION='0.1.7'
cat >>confdefs.h <<_ACEOF cat >>confdefs.h <<_ACEOF
@ -6992,7 +6992,7 @@ cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
# report actual input values of CONFIG_FILES etc. instead of their # report actual input values of CONFIG_FILES etc. instead of their
# values after options handling. # values after options handling.
ac_log=" ac_log="
This file was extended by tinmop $as_me 0.1.6, which was This file was extended by tinmop $as_me 0.1.7, which was
generated by GNU Autoconf 2.69. Invocation command line was generated by GNU Autoconf 2.69. Invocation command line was
CONFIG_FILES = $CONFIG_FILES CONFIG_FILES = $CONFIG_FILES
@ -7049,7 +7049,7 @@ _ACEOF
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`" ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`"
ac_cs_version="\\ ac_cs_version="\\
tinmop config.status 0.1.6 tinmop config.status 0.1.7
configured by $0, generated by GNU Autoconf 2.69, configured by $0, generated by GNU Autoconf 2.69,
with options \\"\$ac_cs_config\\" with options \\"\$ac_cs_config\\"

37
src/gemini-viewer-metadata.lisp Normal file
View File

@ -0,0 +1,37 @@
;; tinmop: an humble mastodon client
;; Copyright (C) 2020 cage
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program.
;; If not, see [[http://www.gnu.org/licenses/][http://www.gnu.org/licenses/]].
(in-package :gemini-viewer)
(defstruct gemini-metadata
(links)
(history)
(source-file))
(defgeneric append-metadata-link (object link))
(defgeneric append-metadata-source (object source-text))
(defmethod append-metadata-link ((object gemini-metadata) link)
(setf (gemini-metadata-links object)
(append (gemini-metadata-links object)
link)))
(defmethod append-metadata-source ((object gemini-metadata) source-file)
(setf (gemini-metadata-source-file object)
(strcat (gemini-metadata-source-file object)
source-file)))

133
src/gemini-viewer.lisp
View File

@ -17,25 +17,6 @@
(in-package :gemini-viewer) (in-package :gemini-viewer)
(defstruct gemini-metadata
(links)
(history)
(source-file))
(defgeneric append-metadata-link (object link))
(defgeneric append-metadata-source (object source-text))
(defmethod append-metadata-link ((object gemini-metadata) link)
(setf (gemini-metadata-links object)
(append (gemini-metadata-links object)
link)))
(defmethod append-metadata-source ((object gemini-metadata) source-file)
(setf (gemini-metadata-source-file object)
(strcat (gemini-metadata-source-file object)
source-file)))
(defun add-url-to-history (window url) (defun add-url-to-history (window url)
(let* ((metadata (message-window:metadata window)) (let* ((metadata (message-window:metadata window))
(history (reverse (gemini-metadata-history metadata))) (history (reverse (gemini-metadata-history metadata)))
@ -65,6 +46,9 @@
:initarg :download-thread-blocked :initarg :download-thread-blocked
:reader download-thread-blocked-p :reader download-thread-blocked-p
:writer (setf download-thread-blocked)) :writer (setf download-thread-blocked))
(stream-status
:initform nil
:initarg :stream-status)
(download-uri (download-uri
:initform nil :initform nil
:initarg :download-uri :initarg :download-uri
@ -117,12 +101,24 @@
(with-lock (download-thread-lock) (with-lock (download-thread-lock)
(not (download-thread-blocked-p object))))) (not (download-thread-blocked-p object)))))
(defmethod (setf stream-status) (val (object gemini-stream))
(with-accessors ((download-thread-lock download-thread-lock)
(stream-status stream-status)) object
(with-lock (download-thread-lock)
(setf stream-status val))))
(defmethod stream-status ((object gemini-stream))
(with-accessors ((download-thread-lock download-thread-lock)) object
(with-lock (download-thread-lock)
(slot-value object 'stream-status))))
(defmethod downloading-start-thread ((object gemini-stream) (defmethod downloading-start-thread ((object gemini-stream)
function function
host port path query) host port path query)
(with-accessors ((start-time start-time) (with-accessors ((start-time start-time)
(thread thread) (thread thread)
(download-uri download-uri)) object (stream-status stream-status)
(download-uri download-uri)) object
(setf thread (setf thread
(bt:make-thread function)) (bt:make-thread function))
(setf start-time (db-utils:local-time-obj-now)) (setf start-time (db-utils:local-time-obj-now))
@ -165,51 +161,54 @@
(download-stream download-stream) (download-stream download-stream)
(octect-count octect-count) (octect-count octect-count)
(support-file support-file)) wrapper-object (support-file support-file)) wrapper-object
(lambda () (flet ((maybe-render-line (line-event)
(with-open-support-file (file-stream support-file character) (when (eq (stream-status wrapper-object) :rendering)
(let* ((url (gemini-parser:make-gemini-uri host path query port)) (program-events:push-event line-event))))
(parsed-url (gemini-parser:parse-gemini-file (format nil "-> ~a~%" url))) (lambda ()
(url-response (gemini-client:make-gemini-file-response nil (with-open-support-file (file-stream support-file character)
nil (let* ((url (gemini-parser:make-gemini-uri host path query port))
nil (parsed-url (gemini-parser:parse-gemini-file (format nil "-> ~a~%" url)))
parsed-url (url-response (gemini-client:make-gemini-file-response nil
nil nil
"" nil
nil)) parsed-url
(url-event (make-instance 'program-events:gemini-got-line-event nil
:wrapper-object wrapper-object ""
:payload url-response nil))
:append-text nil))) (url-event (make-instance 'program-events:gemini-got-line-event
(program-events:push-event url-event) :wrapper-object wrapper-object
(loop :payload url-response
named download-loop :append-text nil)))
for line-as-array = (read-line-into-array download-stream) (maybe-render-line url-event)
while line-as-array do (loop
(if (downloading-allowed-p wrapper-object) named download-loop
(let* ((line (babel:octets-to-string line-as-array :errorp nil)) for line-as-array = (read-line-into-array download-stream)
(parsed (gemini-parser:parse-gemini-file line)) while line-as-array do
(links (gemini-parser:sexp->links parsed host port path)) (if (downloading-allowed-p wrapper-object)
(response (gemini-client:make-gemini-file-response status-code (let* ((line (babel:octets-to-string line-as-array :errorp nil))
status-code-description (parsed (gemini-parser:parse-gemini-file line))
meta (links (gemini-parser:sexp->links parsed host port path))
parsed (response (gemini-client:make-gemini-file-response status-code
url status-code-description
line meta
links)) parsed
(event (make-instance 'program-events:gemini-got-line-event url
:wrapper-object wrapper-object line
:payload response))) links))
(write-sequence line file-stream) (event (make-instance 'program-events:gemini-got-line-event
(increment-bytes-count wrapper-object line :convert-to-octects t) :wrapper-object wrapper-object
(program-events:push-event event)) :payload response)))
(progn (write-sequence line file-stream)
(return-from download-loop nil)))) (increment-bytes-count wrapper-object line :convert-to-octects t)
(if (not (downloading-allowed-p wrapper-object)) (maybe-render-line event))
(ui:notify (_ "Gemini document downloading aborted")) (progn
(ui:notify (_ "Gemini document downloading completed"))) (return-from download-loop nil))))
(allow-downloading wrapper-object) (if (not (downloading-allowed-p wrapper-object))
(gemini-client:close-ssl-socket download-socket))) (ui:notify (_ "Gemini document downloading aborted"))
(fs:delete-file-if-exists support-file)))) (ui:notify (_ "Gemini document downloading completed")))
(allow-downloading wrapper-object)
(gemini-client:close-ssl-socket download-socket)))
(fs:delete-file-if-exists support-file)))))
(defun request-stream-other-document-thread (wrapper-object (defun request-stream-other-document-thread (wrapper-object
socket socket

2
src/open-message-link-window.lisp
View File

@ -123,7 +123,7 @@
(let ((y-start (if uses-border-p (let ((y-start (if uses-border-p
1 1
0))) 0)))
(renderizable-rows-data object) ; set top and bottom slice (renderizable-rows-data object) ; set top and bottom slice
(win-clear object) (win-clear object)
(with-croatoan-window (croatoan-window object) (with-croatoan-window (croatoan-window object)
(loop (loop

3
src/program-events.lisp
View File

@ -969,7 +969,8 @@
(defclass gemini-abort-downloading-event (program-event) ()) (defclass gemini-abort-downloading-event (program-event) ())
(defmethod process-event ((object gemini-abort-downloading-event)) (defmethod process-event ((object gemini-abort-downloading-event))
(gemini-viewer:abort-downloading)) (with-accessors ((download-stream payload)) object
(gemini-viewer:abort-downloading download-stream)))
(defclass function-event (program-event) ()) (defclass function-event (program-event) ())

1
tinmop.asd
View File

@ -89,6 +89,7 @@
(:file "specials") (:file "specials")
(:file "keybindings") (:file "keybindings")
(:file "complete") (:file "complete")
(:file "gemini-viewer-metadata")
(:file "program-events") (:file "program-events")
(:file "api-pleroma") (:file "api-pleroma")
(:file "api-client") (:file "api-client")