mirror of https://codeberg.org/cage/tinmop/
Compare commits
4 Commits
342f34874d
...
ad190478dc
| Author | SHA1 | Date |
|---|---|---|
cage
|
ad190478dc | |
|
cage
|
366dc63d0c | |
|
cage
|
14aa2af9aa | |
|
cage
|
46ba8f2d07 |
7
NEWS.org
7
NEWS.org
|
|
@ -1,13 +1,14 @@
|
|||
* 2024-xx-xx version 0.9.9.1414213562
|
||||
- New features
|
||||
- [fediverse] Multiple accounts supported. Users can specify the account to use on the command line or switching at runtime.
|
||||
- [fediverse] Multiple accounts supported. Users can specify the account to use on the command line or switching at runtime;
|
||||
- [TUI] added new commands:
|
||||
* thread-go-to-parent-post;
|
||||
* thread-delete-subtree.
|
||||
- added a bash completion script;
|
||||
- prevented the poll's results to be printed before expiration;
|
||||
- [script] added the option to submit the feed to an antenna instance, when generating a gemlog.
|
||||
- [module] added 'fetch-expired-poll' that will fetch and display an expired poll for which the user submitted at least a vote.
|
||||
- [script] added the option to submit the feed to an antenna instance, when generating a gemlog;
|
||||
- [module] added 'fetch-expired-poll' that will fetch and display an expired poll for which the user submitted at least a vote;
|
||||
- [GUI] added command to show page's source.
|
||||
- Bugfix
|
||||
- [fediverse] fixed updating of polls (was not actually never updated before this version);
|
||||
- [TUI] fixed checks of configuration file;
|
||||
|
|
|
|||
|
|
@ -223,6 +223,8 @@ keybinding.about = "Alt-a"
|
|||
|
||||
keybinding.type-address = "Alt-d"
|
||||
|
||||
keybinding.view-source = "Alt-u"
|
||||
|
||||
keybinding.back = "Control-BackSpace"
|
||||
|
||||
keybinding.up = "U"
|
||||
|
|
|
|||
596
po/tinmop.pot
596
po/tinmop.pot
File diff suppressed because it is too large
Load Diff
|
|
@ -169,15 +169,17 @@ General Public License for more details."
|
|||
|
||||
(define-constant +octect-type+ '(unsigned-byte 8) :test #'equalp)
|
||||
|
||||
(define-constant +gemini-file-extension+ "gmi" :test #'string=)
|
||||
(define-constant +gemini-file-extension+ "gmi" :test #'string=)
|
||||
|
||||
(define-constant +file-scheme+ "file" :test #'string=)
|
||||
(define-constant +file-scheme+ "file" :test #'string=)
|
||||
|
||||
(define-constant +internal-scheme+ "about" :test #'string=)
|
||||
(define-constant +internal-scheme+ "about" :test #'string=)
|
||||
|
||||
(define-constant +internal-path-bookmark+ "bookmark" :test #'string=)
|
||||
(define-constant +internal-path-bookmark+ "bookmark" :test #'string=)
|
||||
|
||||
(define-constant +internal-path-gemlogs+ "gemlog" :test #'string=)
|
||||
(define-constant +internal-path-gemlogs+ "gemlog" :test #'string=)
|
||||
|
||||
(define-constant +internal-scheme-view-source+ "view-source" :test #'string=)
|
||||
|
||||
(define-constant +fediverse-account-name-server-separator+ "@" :test #'string=)
|
||||
|
||||
|
|
|
|||
|
|
@ -9,6 +9,9 @@
|
|||
(defun internal-iri-gemlogs ()
|
||||
(make-internal-iri +internal-path-gemlogs+))
|
||||
|
||||
(defun internal-iri-view-source (path &optional (query nil) (fragment nil))
|
||||
(iri:make-iri +internal-scheme-view-source+ nil nil nil path query fragment))
|
||||
|
||||
(defun show-bookmarks-page (main-window)
|
||||
(ev:with-enqueued-process-and-unblock ()
|
||||
(let ((parsed-page (comm:make-request :gemini-generate-bookmark-page 1))
|
||||
|
|
|
|||
|
|
@ -75,6 +75,13 @@
|
|||
(defun find-streaming-stream-url ()
|
||||
(find-db-stream-if (lambda (a) (eq (status a) +stream-status-streaming+))))
|
||||
|
||||
(defun url-streaming-p (url)
|
||||
(find-db-stream-if (lambda (a)
|
||||
(and (string= (server-stream-handle a)
|
||||
url)
|
||||
(eq (status a)
|
||||
+stream-status-streaming+)))))
|
||||
|
||||
(defgeneric stop-stream-thread (object))
|
||||
|
||||
(defmethod stop-stream-thread ((object gemini-stream))
|
||||
|
|
@ -213,14 +220,14 @@
|
|||
(eq (status stream-wrapper) +stream-status-canceled+)))
|
||||
(print-info-message (_ "Stream started"))
|
||||
(let ((stream-thread (make-thread (lambda ()
|
||||
(slurp-gemini-stream main-window
|
||||
iri
|
||||
stream-wrapper
|
||||
:use-cache use-cache
|
||||
:process-function
|
||||
process-function
|
||||
:aborting-function
|
||||
#'aborting-function)))))
|
||||
(slurp-gemini-stream main-window
|
||||
iri
|
||||
stream-wrapper
|
||||
:use-cache use-cache
|
||||
:process-function
|
||||
process-function
|
||||
:aborting-function
|
||||
#'aborting-function)))))
|
||||
(setf (fetching-thread stream-wrapper) stream-thread)
|
||||
stream-wrapper)))))
|
||||
|
||||
|
|
@ -244,6 +251,10 @@
|
|||
(_ "Streams")
|
||||
#'menu:show-streams
|
||||
:accelerator (client-configuration:get-keybinding :stream))
|
||||
(gui:make-menubutton tools
|
||||
(_ "View source")
|
||||
(menu:show-page-source-clsr main-window)
|
||||
:accelerator (client-configuration:get-keybinding :view-source))
|
||||
(gui:make-menubutton file
|
||||
(_ "Quit")
|
||||
#'menu:quit
|
||||
|
|
@ -357,7 +368,8 @@
|
|||
(gui:focus (toc-frame main-window))
|
||||
(open-iri link-value
|
||||
main-window
|
||||
use-cache :status status)))))
|
||||
use-cache
|
||||
:status status)))))
|
||||
|
||||
(defun remove-standard-port (iri)
|
||||
(let ((copy (iri:copy-iri (iri:iri-parse iri))))
|
||||
|
|
@ -963,11 +975,67 @@ local file paths."
|
|||
(strcat iri "/")
|
||||
iri)))
|
||||
|
||||
(defun collect-source-lines-clsr (main-window)
|
||||
(lambda (stream-wrapper lines)
|
||||
;; this test ensures that the
|
||||
;; collecting events left on
|
||||
;; the queue won't be actually
|
||||
;; processed, just discarded
|
||||
(when (eq (status stream-wrapper)
|
||||
+stream-status-streaming+)
|
||||
(with-accessors ((ir-lines ir-lines)
|
||||
(ir-rendered-lines ir-rendered-lines)
|
||||
(gemtext-font-scaling gemtext-font-scaling)
|
||||
(gemtext-widget gemtext-widget)) main-window
|
||||
(let ((starting-index (if (vector-empty-p ir-lines)
|
||||
0
|
||||
(length ir-lines)))
|
||||
(font (gui-conf:gemini-preformatted-text-font-configuration)))
|
||||
(multiple-value-bind (background foreground)
|
||||
(gui-conf:gemini-preformatted-text-colors)
|
||||
(loop for line in lines do
|
||||
(vector-push-extend line ir-lines)
|
||||
(let* ((type (ir-type line))
|
||||
(type-as-keyword (format-keyword type)))
|
||||
(case type-as-keyword
|
||||
(:vertical-space
|
||||
(vector-push-extend (format nil "")
|
||||
ir-rendered-lines))
|
||||
(otherwise
|
||||
(vector-push-extend (ir-source-line line)
|
||||
ir-rendered-lines)))))
|
||||
(gui:configure gemtext-widget
|
||||
:wrap :none
|
||||
:font font
|
||||
:foreground foreground
|
||||
:background background)
|
||||
(flet ((render-line (text)
|
||||
(gui:append-text gemtext-widget text)))
|
||||
(loop with render-line-count = starting-index
|
||||
for rendered-line across (subseq ir-rendered-lines starting-index)
|
||||
for ir-line across (subseq ir-lines starting-index)
|
||||
until (interrupt-rendering-p main-window)
|
||||
do
|
||||
(incf render-line-count)
|
||||
(let ((type (ir-type ir-line)))
|
||||
(case (format-keyword type)
|
||||
(:vertical-space
|
||||
(gui:append-line gemtext-widget ""))
|
||||
(otherwise
|
||||
(render-line rendered-line))))))))))))
|
||||
|
||||
(defun open-iri (iri main-window use-cache &key (status +stream-status-streaming+))
|
||||
(let ((actual-iri (remove-standard-port iri)))
|
||||
(handler-case
|
||||
(let ((parsed-iri (iri:iri-parse actual-iri)))
|
||||
(cond
|
||||
((string= (uri:scheme parsed-iri) +internal-scheme-view-source+)
|
||||
(setf (uri:scheme parsed-iri) gemini-constants:+gemini-scheme+)
|
||||
(start-stream-iri (iri-ensure-path (to-s parsed-iri))
|
||||
main-window
|
||||
use-cache
|
||||
:status status
|
||||
:process-iri-lines-function (collect-source-lines-clsr main-window)))
|
||||
((iri:iri= actual-iri (internal-iri-bookmark))
|
||||
(initialize-ir-lines main-window)
|
||||
(funcall (menu:show-bookmarks-clsr main-window)))
|
||||
|
|
@ -980,7 +1048,7 @@ local file paths."
|
|||
(start-stream-iri (iri-ensure-path actual-iri)
|
||||
main-window
|
||||
use-cache
|
||||
status)
|
||||
:status status)
|
||||
(client-stream-frame::refresh-all-streams
|
||||
(client-stream-frame::table stream-frame))))
|
||||
((or (null (uri:scheme parsed-iri))
|
||||
|
|
@ -1071,110 +1139,123 @@ local file paths."
|
|||
(wait-until-download-complete stream-info support-file))))))
|
||||
(wait-enough-data)))
|
||||
|
||||
(defun start-stream-iri (iri main-window use-cache &optional (status +stream-status-streaming+))
|
||||
(let ((connecting-response (cev:enqueue-request-and-wait-results :gemini-request
|
||||
1
|
||||
ev:+maximum-event-priority+
|
||||
iri
|
||||
use-cache
|
||||
nil)))
|
||||
(multiple-value-bind (status-code
|
||||
status-description
|
||||
meta
|
||||
cached
|
||||
original-iri)
|
||||
(displace-gemini-response connecting-response)
|
||||
(declare (ignore original-iri cached))
|
||||
(cond
|
||||
((gemini-client:header-input-p status-code)
|
||||
(a:when-let ((actual-iri (get-user-request-query iri meta main-window)))
|
||||
(start-stream-iri actual-iri main-window nil)))
|
||||
((gemini-client:header-sensitive-input-p status-code)
|
||||
(a:when-let ((actual-iri (get-user-request-query iri meta main-window :sensitive t)))
|
||||
(start-stream-iri actual-iri main-window nil)))
|
||||
((= status-code comm:+tofu-error-status-code+)
|
||||
(when (gui:ask-yesno (_ "The certificate for this address has changed, replace the old with the one I just received?")
|
||||
:title (_ "Server certificate error")
|
||||
:parent main-window)
|
||||
(cev:enqueue-request-and-wait-results :gemini-delete-tofu-certificate
|
||||
1
|
||||
ev:+maximum-event-priority+
|
||||
iri)
|
||||
(start-stream-iri iri main-window use-cache status)))
|
||||
((or (gemini-client:header-temporary-failure-p status-code)
|
||||
(gemini-client:header-permanent-failure-p status-code)
|
||||
(gemini-client:header-certificate-failure-p status-code))
|
||||
(let ((error-gemtext (cev:enqueue-request-and-wait-results :make-error-page
|
||||
1
|
||||
ev:+standard-event-priority+
|
||||
iri
|
||||
status-code
|
||||
status-description
|
||||
meta)))
|
||||
(render-gemtext-string main-window error-gemtext)
|
||||
(ev:with-enqueued-process-and-unblock ()
|
||||
(inline-all-images main-window))))
|
||||
((= status-code
|
||||
comm:+certificate-password-not-found-error-status-code+)
|
||||
(let* ((certificate-path meta)
|
||||
(message (format nil
|
||||
(_ "Provide the password to unlock certificate for ~a")
|
||||
iri))
|
||||
(password (gui-goodies::password-dialog (gui:root-toplevel)
|
||||
(_ "Unlock certificate")
|
||||
message))
|
||||
(actual-password (if (string-empty-p password)
|
||||
""
|
||||
password)))
|
||||
(cev:enqueue-request-and-wait-results :gemini-save-certificate-key-password
|
||||
1
|
||||
ev:+maximum-event-priority+
|
||||
certificate-path
|
||||
actual-password)
|
||||
(start-stream-iri iri main-window use-cache status)))
|
||||
((gemini-client:header-redirect-p status-code)
|
||||
(when (gui:ask-yesno (format nil (_ "Follow redirection to ~a?") meta)
|
||||
:title (_ "Redirection")
|
||||
:parent main-window)
|
||||
(let ((redirect-iri (if (iri:absolute-url-p meta)
|
||||
meta
|
||||
(absolutize-link iri meta))))
|
||||
(start-stream-iri redirect-iri main-window use-cache status))))
|
||||
((gemini-client:header-success-p status-code)
|
||||
(cond
|
||||
((eq status +stream-status-streaming+)
|
||||
(cond
|
||||
((gemini-client:gemini-file-stream-p meta)
|
||||
(ev:with-enqueued-process-and-unblock ()
|
||||
(comm:make-request :gemini-save-url-db-history 1 iri))
|
||||
(maybe-stop-streaming-stream-thread)
|
||||
(clear-gemtext main-window)
|
||||
(initialize-ir-lines main-window)
|
||||
(start-streaming-thread main-window
|
||||
iri
|
||||
:use-cache t
|
||||
:status status
|
||||
:process-function
|
||||
(lambda (stream-wrapper lines)
|
||||
;; this test ensures that the
|
||||
;; collecting events left on
|
||||
;; the queue won't be actually
|
||||
;; processed, just discarded
|
||||
(when (eq (status stream-wrapper)
|
||||
+stream-status-streaming+)
|
||||
(collect-ir-lines iri main-window lines)))))
|
||||
((gemini-client:text-file-stream-p meta)
|
||||
(slurp-text-data main-window iri))
|
||||
(t
|
||||
(slurp-non-text-data main-window iri))))
|
||||
((eq status +stream-status-downloading+)
|
||||
(when (not (find-db-stream-url iri))
|
||||
(let ((background-stream (make-instance 'gemini-stream
|
||||
:server-stream-handle iri
|
||||
:status status)))
|
||||
(push-db-stream background-stream))))
|
||||
(t
|
||||
(error "Unrecognized stream status for address ~s: ~s" iri status))))))))
|
||||
(defun collect-iri-lines-clsr (main-window iri)
|
||||
(lambda (stream-wrapper lines)
|
||||
;; this test ensures that the
|
||||
;; collecting events left on
|
||||
;; the queue won't be actually
|
||||
;; processed, just discarded
|
||||
(when (eq (status stream-wrapper)
|
||||
+stream-status-streaming+)
|
||||
(collect-ir-lines iri main-window lines))))
|
||||
|
||||
(defun start-stream-iri (iri main-window use-cache
|
||||
&key
|
||||
(status +stream-status-streaming+)
|
||||
(process-iri-lines-function (collect-iri-lines-clsr main-window
|
||||
iri)))
|
||||
(flet ((actually-use-cache-p ()
|
||||
;; we need to use 't' or 'nil' as results from this
|
||||
;; function because the json-rpc does not know how to
|
||||
;; encode generalized booleans to JSON
|
||||
(if (url-streaming-p iri)
|
||||
t
|
||||
use-cache)))
|
||||
(let ((connecting-response (cev:enqueue-request-and-wait-results :gemini-request
|
||||
1
|
||||
ev:+maximum-event-priority+
|
||||
iri
|
||||
(actually-use-cache-p)
|
||||
nil)))
|
||||
(multiple-value-bind (status-code
|
||||
status-description
|
||||
meta
|
||||
cached
|
||||
original-iri)
|
||||
(displace-gemini-response connecting-response)
|
||||
(declare (ignore original-iri cached))
|
||||
(cond
|
||||
((gemini-client:header-input-p status-code)
|
||||
(a:when-let ((actual-iri (get-user-request-query iri meta main-window)))
|
||||
(start-stream-iri actual-iri main-window nil)))
|
||||
((gemini-client:header-sensitive-input-p status-code)
|
||||
(a:when-let ((actual-iri (get-user-request-query iri meta main-window :sensitive t)))
|
||||
(start-stream-iri actual-iri main-window nil)))
|
||||
((= status-code comm:+tofu-error-status-code+)
|
||||
(when (gui:ask-yesno (_ "The certificate for this address has changed, replace the old with the one I just received?")
|
||||
:title (_ "Server certificate error")
|
||||
:parent main-window)
|
||||
(cev:enqueue-request-and-wait-results :gemini-delete-tofu-certificate
|
||||
1
|
||||
ev:+maximum-event-priority+
|
||||
iri)
|
||||
(start-stream-iri iri main-window use-cache :status status)))
|
||||
((or (gemini-client:header-temporary-failure-p status-code)
|
||||
(gemini-client:header-permanent-failure-p status-code)
|
||||
(gemini-client:header-certificate-failure-p status-code))
|
||||
(let ((error-gemtext (cev:enqueue-request-and-wait-results :make-error-page
|
||||
1
|
||||
ev:+standard-event-priority+
|
||||
iri
|
||||
status-code
|
||||
status-description
|
||||
meta)))
|
||||
(render-gemtext-string main-window error-gemtext)
|
||||
(ev:with-enqueued-process-and-unblock ()
|
||||
(inline-all-images main-window))))
|
||||
((= status-code
|
||||
comm:+certificate-password-not-found-error-status-code+)
|
||||
(let* ((certificate-path meta)
|
||||
(message (format nil
|
||||
(_ "Provide the password to unlock certificate for ~a")
|
||||
iri))
|
||||
(password (gui-goodies::password-dialog (gui:root-toplevel)
|
||||
(_ "Unlock certificate")
|
||||
message))
|
||||
(actual-password (if (string-empty-p password)
|
||||
""
|
||||
password)))
|
||||
(cev:enqueue-request-and-wait-results :gemini-save-certificate-key-password
|
||||
1
|
||||
ev:+maximum-event-priority+
|
||||
certificate-path
|
||||
actual-password)
|
||||
(start-stream-iri iri main-window use-cache :status status)))
|
||||
((gemini-client:header-redirect-p status-code)
|
||||
(when (gui:ask-yesno (format nil (_ "Follow redirection to ~a?") meta)
|
||||
:title (_ "Redirection")
|
||||
:parent main-window)
|
||||
(let ((redirect-iri (if (iri:absolute-url-p meta)
|
||||
meta
|
||||
(absolutize-link iri meta))))
|
||||
(start-stream-iri redirect-iri main-window use-cache :status status))))
|
||||
((gemini-client:header-success-p status-code)
|
||||
(cond
|
||||
((eq status +stream-status-streaming+)
|
||||
(cond
|
||||
((gemini-client:gemini-file-stream-p meta)
|
||||
(ev:with-enqueued-process-and-unblock ()
|
||||
(comm:make-request :gemini-save-url-db-history 1 iri))
|
||||
(maybe-stop-streaming-stream-thread)
|
||||
(clear-gemtext main-window)
|
||||
(initialize-ir-lines main-window)
|
||||
(start-streaming-thread main-window
|
||||
iri
|
||||
:use-cache t
|
||||
:status status
|
||||
:process-function process-iri-lines-function))
|
||||
((gemini-client:text-file-stream-p meta)
|
||||
(slurp-text-data main-window iri))
|
||||
(t
|
||||
(slurp-non-text-data main-window iri))))
|
||||
((eq status +stream-status-downloading+)
|
||||
(when (not (find-db-stream-url iri))
|
||||
(let ((background-stream (make-instance 'gemini-stream
|
||||
:server-stream-handle iri
|
||||
:status status)))
|
||||
(push-db-stream background-stream))))
|
||||
(t
|
||||
(error "Unrecognized stream status for address ~s: ~s" iri status)))))))))
|
||||
|
||||
(defun open-iri-clsr (main-window use-cache)
|
||||
(lambda ()
|
||||
|
|
@ -1705,6 +1786,12 @@ local file paths."
|
|||
(render-ir-lines (get-address-bar-text main-window) main-window))))
|
||||
|
||||
(defun initialize-keybindings (main-window target)
|
||||
(gui:bind target
|
||||
(client-configuration:get-keybinding :view-source)
|
||||
(lambda (e)
|
||||
(declare (ignore e))
|
||||
(funcall (menu:show-page-source-clsr main-window)))
|
||||
:exclusive t)
|
||||
(gui:bind target
|
||||
(client-configuration:get-keybinding :quit)
|
||||
(lambda (e)
|
||||
|
|
|
|||
|
|
@ -82,3 +82,11 @@
|
|||
(let ((master gui-goodies:*toplevel*)
|
||||
(main-window gui-goodies:*main-frame*))
|
||||
(client-gemlog-window:init-window master main-window)))
|
||||
|
||||
(defun show-page-source-clsr (main-window)
|
||||
(lambda ()
|
||||
(a:when-let ((iri (iri:iri-parse (client-main-window::get-address-bar-text main-window)
|
||||
:null-on-error t)))
|
||||
(setf (uri:scheme iri) +internal-scheme-view-source+)
|
||||
(client-main-window::set-address-bar-text main-window (to-s iri))
|
||||
(client-main-window::open-iri (to-s iri) main-window nil))))
|
||||
|
|
|
|||
|
|
@ -437,7 +437,8 @@
|
|||
(make-response nil
|
||||
id
|
||||
:error-object (make-failed-function-call-error-message (format nil
|
||||
"~a"
|
||||
"[~a] ~a"
|
||||
request
|
||||
e)
|
||||
data))))
|
||||
(handler-case
|
||||
|
|
|
|||
|
|
@ -137,7 +137,8 @@ etc.) happened"
|
|||
(res:home-confdir)
|
||||
+program-name+
|
||||
+program-name+)
|
||||
(res:create-empty-file-in-home swconf:+conf-filename+)
|
||||
(res:create-empty-file-in-home (fs:cat-parent-dir (res:home-confdir)
|
||||
swconf:+conf-filename+))
|
||||
(os-utils:exit-program 1))))
|
||||
|
||||
(defun shared-init (&key (verbose t) (initialize-database t))
|
||||
|
|
|
|||
|
|
@ -77,6 +77,7 @@
|
|||
:+internal-scheme+
|
||||
:+internal-path-bookmark+
|
||||
:+internal-path-gemlogs+
|
||||
:+internal-scheme-view-source+
|
||||
:+fediverse-account-name-server-separator+
|
||||
:+language-codes+
|
||||
;; GUI
|
||||
|
|
@ -3532,7 +3533,8 @@
|
|||
:manage-bookmarks-clsr
|
||||
:show-search-frame-clsr
|
||||
:show-tour
|
||||
:manage-gemlogs))
|
||||
:manage-gemlogs
|
||||
:show-page-source-clsr))
|
||||
|
||||
(defpackage :client-certificates-window
|
||||
(:use
|
||||
|
|
|
|||
Loading…
Reference in New Issue