mirror of https://codeberg.org/cage/tinmop/
- [GUI] started a news thread where getting gemini stream's data.
- [GUI] added theming to gemtext.
This commit is contained in:
cage
parent
8278ea485e
commit
9e7feacf8e
|
|
@ -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+))
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -174,21 +174,113 @@
|
|||
(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
|
||||
(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)
|
||||
(misc:dbg "lines ~a" lines)))))))
|
||||
(collect-ir-lines main-window lines)
|
||||
(misc:dbg "lines ~a" lines))
|
||||
:status status)))))))))
|
||||
|
||||
(defun setup-main-window-events (main-window)
|
||||
(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)) main-window
|
||||
(go-button go-button)) tool-bar
|
||||
(let ((entry-autocomplete (gui-mw:autocomplete-entry-widget iri-entry)))
|
||||
(gui:bind entry-autocomplete
|
||||
#$<KeyPress-Return>$
|
||||
|
|
@ -196,7 +288,7 @@
|
|||
(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))))
|
||||
(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))
|
||||
|
|
|
|||
Loading…
Reference in New Issue