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

- [GUI] started a news thread where getting gemini stream's data. 

- [GUI] added theming to gemtext.
This commit is contained in:
cage 2023-02-25 11:41:01 +01:00
parent 8278ea485e
commit 9e7feacf8e
3 changed files with 219 additions and 49 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

116
src/gemini/client.lisp
View File

@ -108,41 +108,103 @@
(code= (status-code header)
code-class))
(defun header-input-request-p (header)
(or (header-code= header +10+)
(header-code= header +11+)))
(defgeneric header-input-request-p (object))
(defun header-success-p (header)
(header-code= header +20+))
(defmethod header-input-request-p ((object gemini-response))
(or (header-code= object +10+)
(header-code= object +11+)))
(defun header-redirect-p (header)
(or (header-code= header +30+)
(header-code= header +31+)))
(defmethod header-input-request-p ((object number))
(or (code= object +10+)
(code= object +11+)))
(defun header-temporary-failure-p (header)
(or (header-code= header +40+)
(header-code= header +41+)
(header-code= header +42+)
(header-code= header +43+)
(header-code= header +44+)))
(defgeneric header-success-p (object))
(defun header-permanent-failure-p (header)
(or (header-code= header +50+)
(header-code= header +51+)
(header-code= header +52+)
(header-code= header +53+)
(header-code= header +59+)))
(defmethod header-success-p ((object gemini-response))
(header-code= object +20+))
(defun header-certificate-failure-p (header)
(or (header-code= header +61+)
(header-code= header +62+)))
(defmethod header-success-p ((object number))
(code= object +20+))
(defun header-not-implemented-p (header)
(declare (ignore header))
(defgeneric header-redirect-p (object))
(defmethod header-redirect-p ((object gemini-response))
(or (header-code= object +30+)
(header-code= object +31+)))
(defmethod header-redirect-p ((object number))
(or (code= object +30+)
(code= object +31+)))
(defgeneric header-temporary-failure-p (object))
(defmethod header-temporary-failure-p ((object gemini-response))
(or (header-code= object +40+)
(header-code= object +41+)
(header-code= object +42+)
(header-code= object +43+)
(header-code= object +44+)))
(defmethod header-temporary-failure-p ((object number))
(or (code= object +40+)
(code= object +41+)
(code= object +42+)
(code= object +43+)
(code= object +44+)))
(defgeneric header-permanent-failure-p (object))
(defmethod header-permanent-failure-p ((object gemini-response))
(or (header-code= object +50+)
(header-code= object +51+)
(header-code= object +52+)
(header-code= object +53+)
(header-code= object +59+)))
(defmethod header-permanent-failure-p ((object number))
(or (code= object +50+)
(code= object +51+)
(code= object +52+)
(code= object +53+)
(code= object +59+)))
(defgeneric header-certificate-failure-p (object))
(defmethod header-certificate-failure-p ((object gemini-response))
(or (header-code= object +61+)
(header-code= object +62+)))
(defmethod header-certificate-failure-p ((object number))
(or (code= object +61+)
(code= object +62+)))
(defun header-not-implemented-p (object)
(declare (ignore object))
nil)
(defun header-certificate-requested-p (header)
(header-code= header +60+))
(defgeneric header-certificate-requested-p (object))
(defmethod header-certificate-requested-p ((object gemini-response))
(header-code= object +60+))
(defmethod header-certificate-requested-p ((object number))
(code= object +60+))
(defgeneric header-input-p (object))
(defmethod header-input-p ((object gemini-response))
(header-code= object +10+))
(defmethod header-input-p ((object number))
(response-input-p object))
(defgeneric header-sensitive-input-p (object))
(defmethod header-sensitive-input-p ((object gemini-response))
(header-code= object +11+))
(defmethod header-sensitive-input-p ((object number))
(response-sensitive-input-p object))
(defun response-input-p (code)
(code= code +10+))

8
src/gemini/package.lisp
View File

@ -146,6 +146,14 @@
:+certificate-not-valid+
:mime-gemini-p
:mime-text-stream
:header-success-p
:header-redirect-p
:header-temporary-failure-p
:header-permanent-failure-p
:header-certificate-failure-p
:header-certificate-requested-p
:header-input-p
:header-sensitive-input-p
:gemini-protocol-error
:error-code
:error-description

144
src/gui/client/main-window.lisp
View File

@ -174,29 +174,121 @@
(getf match-results :indices))))
hint)))
(defun start-stream-iri-clsr (widget use-cache)
(defmacro gen-ir-access (key)
`(defun ,(misc:format-fn-symbol t "ir-~a" key) (line)
(getf line ,(a:make-keyword key))))
(gen-ir-access type)
(gen-ir-access source-id)
(gen-ir-access header-group-id)
(gen-ir-access source-line)
(gen-ir-access line)
(gen-ir-access href)
(defun collect-ir-lines (main-window lines)
(with-accessors ((ir-lines ir-lines)
(ir-rendered-lines ir-rendered-lines)) main-window
(flet ((push-prefixed (prefix ir)
(let ((raw-line (format nil "~a~a" prefix (ir-line ir))))
(vector-push-extend raw-line ir-rendered-lines)))
(linkify (line)
(let* ((link-name (ir-line line))
(link-value (ir-href line))
(prefix-gemini (gui-conf:gemini-link-prefix-to-gemini))
(prefix-www (gui-conf:gemini-link-prefix-to-http))
(prefix-other (gui-conf:gemini-link-prefix-to-other))
(link-text (if (text-utils:starting-emoji link-name)
(format nil
"~a~a"
(trim-blanks prefix-other)
link-name)
(cond
((gemini-parser::gemini-link-iri-p link-value)
(format nil "~a~a" prefix-gemini link-name))
((html-utils::http-link-iri-p link-value)
(format nil "~a~a" prefix-www link-name))
(t
(format nil "~a~a" prefix-other link-name))))))
(vector-push-extend link-text ir-rendered-lines))))
(loop for line in lines do
(vector-push-extend line ir-lines)
(let ((type (ir-type line)))
(ecase (format-keyword type)
(:vertical-space
(vector-push-extend (format nil "~%") ir-rendered-lines))
(:as-is
(vector-push-extend (ir-line line) ir-rendered-lines))
(:text
(vector-push-extend (ir-line line) ir-rendered-lines))
(:h1
(push-prefixed (gui-conf:gemini-h1-prefix) line))
(:h2
(push-prefixed (gui-conf:gemini-h1-prefix) line))
(:h3
(push-prefixed (gui-conf:gemini-h1-prefix) line))
(:li
(push-prefixed (gui-conf:gemini-bullet-prefix) line))
(:quote
(push-prefixed (gui-conf:gemini-quote-prefix) line))
(:pre
(vector-push-extend (format nil "~%") ir-rendered-lines))
(:pre-end
(vector-push-extend (format nil "~%") ir-rendered-lines))
(:a
(linkify line))))))))
(defun displace-gemini-response (response)
(values (getf response :status)
(getf response :status-description)
(getf response :meta)
(getf response :cached)
(getf response :iri)))
(defun start-stream-iri-clsr (main-window use-cache &optional (status :streaming))
(lambda ()
(with-accessors ((iri-entry iri-entry)) widget
(let ((iri (gui:text iri-entry)))
(slurp-gemini-stream iri
:use-cache use-cache
:process-function (lambda (lines)
(misc:dbg "lines ~a" lines)))))))
(with-accessors ((tool-bar tool-bar)) main-window
(with-accessors ((iri-entry iri-entry)) tool-bar
(let* ((iri (trim-blanks (gui:text iri-entry)))
(connecting-response (cev:enqueue-request-and-wait-results :gemini-request
1
ev:+maximum-event-priority+
iri
use-cache)))
(multiple-value-bind (status-code
status-description
meta
cached
original-iri)
(displace-gemini-response connecting-response)
(cond
((gemini-client:header-success-p status-code)
(start-streaming-thread iri
:use-cache nil
:process-function (lambda (lines)
(collect-ir-lines main-window lines)
(misc:dbg "lines ~a" lines))
:status status)))))))))
(defun setup-main-window-events (main-window)
(with-accessors ((iri-entry iri-entry)
(back-button back-button)
(reload-button reload-button)
(up-button up-button)
(go-button go-button)) main-window
(let ((entry-autocomplete (gui-mw:autocomplete-entry-widget iri-entry)))
(gui:bind entry-autocomplete
#$<KeyPress-Return>$
(lambda (e)
(declare (ignore e))
(funcall (start-stream-iri-clsr main-window t)))
:append nil))
(setf (gui:command go-button) (start-stream-iri-clsr main-window t))))
(with-accessors ((tool-bar tool-bar)) main-window
(with-accessors ((iri-entry iri-entry)
(back-button back-button)
(reload-button reload-button)
(up-button up-button)
(go-button go-button)) tool-bar
(let ((entry-autocomplete (gui-mw:autocomplete-entry-widget iri-entry)))
(gui:bind entry-autocomplete
#$<KeyPress-Return>$
(lambda (e)
(declare (ignore e))
(funcall (start-stream-iri-clsr main-window t)))
:append nil))
(setf (gui:command go-button) (start-stream-iri-clsr main-window t)))))
(defmethod initialize-instance :after ((object tool-bar) &key &allow-other-keys)
(with-accessors ((iri-entry iri-entry)
@ -222,7 +314,6 @@
(gui:grid reload-button 0 4 :sticky :e)
(gui:grid up-button 0 5 :sticky :e)
(gui:grid-columnconfigure object 2 :weight 2)
(setup-main-window-events object)
object))
(defclass toc-frame (gui:frame)
@ -273,7 +364,15 @@
(info-text
:initform nil
:initarg :info-text
:accessor info-text)))
:accessor info-text)
(ir-rendered-lines
:initform (misc:make-fresh-array 0)
:initarg :ir-rendered-lines
:accessor ir-rendered-lines)
(ir-lines
:initform (misc:make-fresh-array 0)
:initarg :ir-lines
:accessor ir-lines)))
(defmethod initialize-instance :after ((object main-frame) &key &allow-other-keys)
(with-accessors ((main-window main-window)
@ -296,6 +395,7 @@
(gui:grid info-frame 3 0 :sticky :news :columnspan 2)
(gui:grid-columnconfigure object 1 :weight 1)
(gui:grid-rowconfigure object 1 :weight 1)
(setup-main-window-events object)
object))
(defun print-info-message (message &key (color (gui-goodies:parse-color "gray")) (bold nil))