commit - 0276d7708733672f17b88aacd62a3092b0137019
commit + 59eabf3e4744859e2fd707b688425bd616d621bb
blob - b584cd9f422621febd835f22f0a57b9e44e58fcf
blob + 6942a2359b7346672cb6fcea89b769f7531a81d3
--- ui.lisp
+++ ui.lisp
(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"))
(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)
;; :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
: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)
: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))))