mirror of
https://codeberg.org/cage/tinmop/
synced 2025-02-01 04:26:47 +01:00
- [gemini] added slot 'status-stream'.
This will allow to enqueue multiple documents download.
This commit is contained in:
cage
parent
0816a6a78c
commit
4941c21d94
20
configure
vendored
20
configure
vendored
@ -1,6 +1,6 @@
|
||||
#! /bin/sh
|
||||
# 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/>.
|
||||
#
|
||||
@ -580,8 +580,8 @@ MAKEFLAGS=
|
||||
# Identity of this package.
|
||||
PACKAGE_NAME='tinmop'
|
||||
PACKAGE_TARNAME='tinmop'
|
||||
PACKAGE_VERSION='0.1.6'
|
||||
PACKAGE_STRING='tinmop 0.1.6'
|
||||
PACKAGE_VERSION='0.1.7'
|
||||
PACKAGE_STRING='tinmop 0.1.7'
|
||||
PACKAGE_BUGREPORT='https://notabug.org/cage/tinmop/'
|
||||
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.
|
||||
# This message is too long to be a string in the A/UX 3.1 sh.
|
||||
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]...
|
||||
|
||||
@ -1349,7 +1349,7 @@ fi
|
||||
|
||||
if test -n "$ac_init_help"; then
|
||||
case $ac_init_help in
|
||||
short | recursive ) echo "Configuration of tinmop 0.1.6:";;
|
||||
short | recursive ) echo "Configuration of tinmop 0.1.7:";;
|
||||
esac
|
||||
cat <<\_ACEOF
|
||||
|
||||
@ -1451,7 +1451,7 @@ fi
|
||||
test -n "$ac_init_help" && exit $ac_status
|
||||
if $ac_init_version; then
|
||||
cat <<\_ACEOF
|
||||
tinmop configure 0.1.6
|
||||
tinmop configure 0.1.7
|
||||
generated by GNU Autoconf 2.69
|
||||
|
||||
Copyright (C) 2012 Free Software Foundation, Inc.
|
||||
@ -1631,7 +1631,7 @@ cat >config.log <<_ACEOF
|
||||
This file contains any messages produced by compilers while
|
||||
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
|
||||
|
||||
$ $0 $@
|
||||
@ -2496,7 +2496,7 @@ fi
|
||||
|
||||
# Define the identity of the package.
|
||||
PACKAGE='tinmop'
|
||||
VERSION='0.1.6'
|
||||
VERSION='0.1.7'
|
||||
|
||||
|
||||
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
|
||||
# values after options handling.
|
||||
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
|
||||
|
||||
CONFIG_FILES = $CONFIG_FILES
|
||||
@ -7049,7 +7049,7 @@ _ACEOF
|
||||
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
|
||||
ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`"
|
||||
ac_cs_version="\\
|
||||
tinmop config.status 0.1.6
|
||||
tinmop config.status 0.1.7
|
||||
configured by $0, generated by GNU Autoconf 2.69,
|
||||
with options \\"\$ac_cs_config\\"
|
||||
|
||||
|
||||
37
src/gemini-viewer-metadata.lisp
Normal file
37
src/gemini-viewer-metadata.lisp
Normal 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)))
|
||||
@ -17,25 +17,6 @@
|
||||
|
||||
(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)
|
||||
(let* ((metadata (message-window:metadata window))
|
||||
(history (reverse (gemini-metadata-history metadata)))
|
||||
@ -65,6 +46,9 @@
|
||||
:initarg :download-thread-blocked
|
||||
:reader download-thread-blocked-p
|
||||
:writer (setf download-thread-blocked))
|
||||
(stream-status
|
||||
:initform nil
|
||||
:initarg :stream-status)
|
||||
(download-uri
|
||||
:initform nil
|
||||
:initarg :download-uri
|
||||
@ -117,12 +101,24 @@
|
||||
(with-lock (download-thread-lock)
|
||||
(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)
|
||||
function
|
||||
host port path query)
|
||||
(with-accessors ((start-time start-time)
|
||||
(thread thread)
|
||||
(download-uri download-uri)) object
|
||||
(with-accessors ((start-time start-time)
|
||||
(thread thread)
|
||||
(stream-status stream-status)
|
||||
(download-uri download-uri)) object
|
||||
(setf thread
|
||||
(bt:make-thread function))
|
||||
(setf start-time (db-utils:local-time-obj-now))
|
||||
@ -165,51 +161,54 @@
|
||||
(download-stream download-stream)
|
||||
(octect-count octect-count)
|
||||
(support-file support-file)) wrapper-object
|
||||
(lambda ()
|
||||
(with-open-support-file (file-stream support-file character)
|
||||
(let* ((url (gemini-parser:make-gemini-uri host path query port))
|
||||
(parsed-url (gemini-parser:parse-gemini-file (format nil "-> ~a~%" url)))
|
||||
(url-response (gemini-client:make-gemini-file-response nil
|
||||
nil
|
||||
nil
|
||||
parsed-url
|
||||
nil
|
||||
""
|
||||
nil))
|
||||
(url-event (make-instance 'program-events:gemini-got-line-event
|
||||
:wrapper-object wrapper-object
|
||||
:payload url-response
|
||||
:append-text nil)))
|
||||
(program-events:push-event url-event)
|
||||
(loop
|
||||
named download-loop
|
||||
for line-as-array = (read-line-into-array download-stream)
|
||||
while line-as-array do
|
||||
(if (downloading-allowed-p wrapper-object)
|
||||
(let* ((line (babel:octets-to-string line-as-array :errorp nil))
|
||||
(parsed (gemini-parser:parse-gemini-file line))
|
||||
(links (gemini-parser:sexp->links parsed host port path))
|
||||
(response (gemini-client:make-gemini-file-response status-code
|
||||
status-code-description
|
||||
meta
|
||||
parsed
|
||||
url
|
||||
line
|
||||
links))
|
||||
(event (make-instance 'program-events:gemini-got-line-event
|
||||
:wrapper-object wrapper-object
|
||||
:payload response)))
|
||||
(write-sequence line file-stream)
|
||||
(increment-bytes-count wrapper-object line :convert-to-octects t)
|
||||
(program-events:push-event event))
|
||||
(progn
|
||||
(return-from download-loop nil))))
|
||||
(if (not (downloading-allowed-p wrapper-object))
|
||||
(ui:notify (_ "Gemini document downloading aborted"))
|
||||
(ui:notify (_ "Gemini document downloading completed")))
|
||||
(allow-downloading wrapper-object)
|
||||
(gemini-client:close-ssl-socket download-socket)))
|
||||
(fs:delete-file-if-exists support-file))))
|
||||
(flet ((maybe-render-line (line-event)
|
||||
(when (eq (stream-status wrapper-object) :rendering)
|
||||
(program-events:push-event line-event))))
|
||||
(lambda ()
|
||||
(with-open-support-file (file-stream support-file character)
|
||||
(let* ((url (gemini-parser:make-gemini-uri host path query port))
|
||||
(parsed-url (gemini-parser:parse-gemini-file (format nil "-> ~a~%" url)))
|
||||
(url-response (gemini-client:make-gemini-file-response nil
|
||||
nil
|
||||
nil
|
||||
parsed-url
|
||||
nil
|
||||
""
|
||||
nil))
|
||||
(url-event (make-instance 'program-events:gemini-got-line-event
|
||||
:wrapper-object wrapper-object
|
||||
:payload url-response
|
||||
:append-text nil)))
|
||||
(maybe-render-line url-event)
|
||||
(loop
|
||||
named download-loop
|
||||
for line-as-array = (read-line-into-array download-stream)
|
||||
while line-as-array do
|
||||
(if (downloading-allowed-p wrapper-object)
|
||||
(let* ((line (babel:octets-to-string line-as-array :errorp nil))
|
||||
(parsed (gemini-parser:parse-gemini-file line))
|
||||
(links (gemini-parser:sexp->links parsed host port path))
|
||||
(response (gemini-client:make-gemini-file-response status-code
|
||||
status-code-description
|
||||
meta
|
||||
parsed
|
||||
url
|
||||
line
|
||||
links))
|
||||
(event (make-instance 'program-events:gemini-got-line-event
|
||||
:wrapper-object wrapper-object
|
||||
:payload response)))
|
||||
(write-sequence line file-stream)
|
||||
(increment-bytes-count wrapper-object line :convert-to-octects t)
|
||||
(maybe-render-line event))
|
||||
(progn
|
||||
(return-from download-loop nil))))
|
||||
(if (not (downloading-allowed-p wrapper-object))
|
||||
(ui:notify (_ "Gemini document downloading aborted"))
|
||||
(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
|
||||
socket
|
||||
|
||||
@ -123,7 +123,7 @@
|
||||
(let ((y-start (if uses-border-p
|
||||
1
|
||||
0)))
|
||||
(renderizable-rows-data object) ; set top and bottom slice
|
||||
(renderizable-rows-data object) ; set top and bottom slice
|
||||
(win-clear object)
|
||||
(with-croatoan-window (croatoan-window object)
|
||||
(loop
|
||||
|
||||
@ -969,7 +969,8 @@
|
||||
(defclass gemini-abort-downloading-event (program-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) ())
|
||||
|
||||
|
||||
@ -89,6 +89,7 @@
|
||||
(:file "specials")
|
||||
(:file "keybindings")
|
||||
(:file "complete")
|
||||
(:file "gemini-viewer-metadata")
|
||||
(:file "program-events")
|
||||
(:file "api-pleroma")
|
||||
(:file "api-client")
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user