commit 59eabf3e4744859e2fd707b688425bd616d621bb
from: Omar Polo <op@omarpolo.com>
date: Wed Nov 11 16:55:33 2020 UTC

improve UI: add controls and fix click on non-absolute URLs

commit - 0276d7708733672f17b88aacd62a3092b0137019
commit + 59eabf3e4744859e2fd707b688425bd616d621bb
blob - b584cd9f422621febd835f22f0a57b9e44e58fcf
blob + 6942a2359b7346672cb6fcea89b769f7531a81d3
--- ui.lisp
+++ ui.lisp
@@ -21,10 +21,34 @@
 (defparameter *paragraph-font* "serif 12"
   "Font for the normal text")
 
+(defparameter *url-bar* nil)
 (defparameter *window-content* nil)
 
 (defparameter *current-url* nil)
 
+(defun join-paths (url path query)
+  (setf (quri:uri-query url) query)
+  (if (uiop:string-prefix-p "/" path)
+      (setf (quri:uri-path url) path)
+      (let ((p (quri:uri-path url)))
+        (setf (quri:uri-path url)
+              (format nil "~a~a"
+                      (if (uiop:string-suffix-p "/" p)
+                          p
+                          (directory-namestring p))
+                      path))))
+  url)
+
+(defun navigate-to (uri)
+  (let ((hostname (quri:uri-host uri))
+        (path (quri:uri-path uri))
+        (query (quri:uri-query uri)))
+    (if hostname
+        (do-render uri)
+        (do-render (join-paths (quri:copy-uri *current-url*)
+                               path
+                               query)))))
+
 (defgeneric render (obj frame)
   (:documentation "Render OBJ in the nodgui FRAME"))
 
@@ -43,7 +67,7 @@
                                     (2 *title-2-font*)
                                     (3 *title-3-font*))
                             :text (format nil "~v{~A~:*~} ~a" level '("#") text))))
-      (pack w :side :top))))
+      (pack w :side :top :fill :both :expand t))))
 
 (defmethod render ((link gemtext:link) f)
   (with-slots ((text phos/gemtext:text)
@@ -54,9 +78,8 @@
                             ;; :font *link-font*
                             :text (format nil "~a" (or text url))
                             :command (lambda ()
-                                       (format t "before rendering ~a~%" url)
-                                       (do-render url)))))
-      (pack w :side :top))))
+                                       (navigate-to url)))))
+      (pack w :side :top :fill :both :expand t))))
 
 (defmethod render ((item gemtext:item) f)
   (with-slots ((text phos/gemtext:text)) item
@@ -64,15 +87,19 @@
                             :master f
                             :font *item-font*
                             :text (format nil "* ~a" text))))
-      (pack w :side :top))))
+      (pack w :side :top :fill :both :expand t))))
 
 (defmethod render ((par gemtext:paragraph) f)
   (with-slots ((text phos/gemtext:text)) par
-    (let ((w (make-instance 'label
+    (let ((w (make-instance 'message
                             :master f
                             :font *paragraph-font*
-                            :text text)))
-      (pack w :side :top))))
+                            :justify "left"
+                            :text text
+                            :width 600)))
+      ;; (setf (text w) text)
+      ;; (configure w :state "disabled")
+      (pack w :side :top :expand t :anchor "w"))))
 
 (defmethod render ((v gemtext:verbatim) f)
   (with-slots ((text phos/gemtext:text)
@@ -82,34 +109,51 @@
                             :master f
                             :font *verbatim-font*
                             :text text)))
-      (pack w :side :top)
+      (pack w :side :top :fill :both :expand t)
       (when alt
         (pack (make-instance 'label
                              :master f
                              :text alt)
-              :side :top)))))
+              :side :top
+              :fill :both
+              :expand t)))))
 
 (defun clear-window ()
   (pack-forget-all *window-content*))
 
 (defun do-render (url)
-  (let* ((uri           (quri:uri url))
-         (*current-url* uri)
-         (base          (quri:copy-uri uri)))
-    (setf (quri:uri-path base) nil)
+  (let* ((uri (quri:uri url)))
+    (setf *current-url* uri)
+    (setf (text *url-bar*) url)
     (clear-window)
     (render (gemtext:parse-string "# loading...")
             *window-content*)
-    (clear-window)
     (multiple-value-bind (status body) (gemini:request url)
       (declare (ignore status))
-      (render (gemtext:parse-string body base)
+      (clear-window)
+      (render (gemtext:parse-string body)
               *window-content*))))
 
+(defun navigate-button-cb ()
+  (navigate-to (quri:uri (string-trim '(#\newline #\space) (text *url-bar*)))))
+
 (defun main (url)
   (with-nodgui (:title "phos")
-    (let ((sf (make-instance 'scrolled-frame)))
+    (set-geometry *tk* 800 600 0 0)
+    (let* ((nav      (make-instance 'frame))
+           (back-btn (make-instance 'button :text "←"   :master nav))
+           (forw-btn (make-instance 'button :text "→"   :master nav))
+           (go-btn   (make-instance 'button :text "GO!" :master nav :command #'navigate-button-cb))
+           (url-bar  (make-instance 'text :height 1     :master nav))
+           (sf       (make-instance 'scrolled-frame :padding 10 :takefocus nil)))
+      (setf *url-bar* url-bar)
       (setf *window-content* (interior sf))
+      (setf (text url-bar) "about:phos")
+      (pack nav :fill :both)
+      (pack back-btn :side :left)
+      (pack forw-btn :side :left)
+      (pack url-bar  :side :left :expand t :fill :both)
+      (pack go-btn   :side :left)
       (pack sf :side :top :fill :both :expand t)
       (do-render url))))