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

- [GUI] added theming to gemtext.

src/gemini/client.lisp

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

src/gemini/package.lisp

@@ -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

src/gui/client/main-window.lisp

@@ -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
+    (with-accessors ((tool-bar tool-bar)) main-window
-      (let ((iri (gui:text iri-entry)))
+      (with-accessors ((iri-entry iri-entry)) tool-bar
-        (slurp-gemini-stream iri
+        (let* ((iri                 (trim-blanks (gui:text iri-entry)))
-                             :use-cache use-cache
+               (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))