commit - 6b4d9ef20633b7e62988eb86b6e18da1e67519b2
commit + 073b25eb0b22b8306c6e711aff1483a20be2f8f8
blob - f109d967bacfc70956ec2c0f243e931c24547d17
blob + b6d8c80d80f6ba9748b686f4db959340645cbdad
--- gemini.lisp
+++ gemini.lisp
(let ((resp (parse-response (read-until ssl-stream #\newline))))
(values resp (read-all-stream ssl-stream))))))
-(defun request (url)
+(defgeneric request (url)
+ (:documentation "Perform a request for the URL"))
+
+(defmethod request ((url string))
+ (request (quri:uri url)))
+
+(defmethod request ((url quri:uri))
(let* ((u (quri:uri url))
(port (or (quri:uri-port u) 1965))
(host (quri:uri-host u)))
blob - a6728f74ef17bd880c198e6055a4b47da7729ec1
blob + e60cb1bfca592cf15d1b03512995e0e754a48ee2
--- gemtext.lisp
+++ gemtext.lisp
(in-package #:phos/gemtext)
+(defparameter *relative-to* nil)
+
(defclass element ()
((text :initarg :text)))
:text text)))
(defun make-link (url &optional text)
- (make-instance 'link :url (quri:uri url)
- :text text))
+ (if *relative-to*
+ (let ((u (quri:copy-uri *relative-to*)))
+ (setf (quri:uri-path u) url)
+ (make-instance 'link :url u
+ :text text))
+ (make-instance 'link :url (quri:uri url)
+ :text text)))
(defun parse-link (s)
"Parse a line into link."
(defmacro markerp (line)
`(uiop:string-prefix-p "```" ,line))
-(defun parse (in)
- "Parse gemtext from the stream IN."
+(defun parse (in &optional relative-to)
+ "Parse gemtext from the stream IN.
+
+RELATIVE-TO is the base URL of the page, it is used to transform url
+to absolute urls, if null the transformation does not happen."
(loop with doc = nil
+ with *relative-to* = (when relative-to
+ (quri:uri relative-to))
for line = (read-line in nil)
unless line
return (nreverse doc)
when (markerp line)
return (make-instance 'verbatim
:alt label
- :text (format nil "~{~A~%~^~}" content))
+ :text (format nil "~{~A~%~^~}"
+ (nreverse content)))
do (push line content))
(parse-line line))
doc)))
-(defun parse-string (str)
+(defun parse-string (str &optional relative-to)
+ "Parse the string STR as gemtext. See the documentation of `parse'
+for more info."
(with-input-from-string (s str)
- (parse s)))
+ (parse s relative-to)))
;; (unparse
;; (with-open-file (stream #P"~/quicklisp/local-projects/phos/test.gmi")
blob - 4dd6d7ccc81049f949f9085d7d6dfb50e2ff71d9
blob + d22930faa65e7e687ff98f6626097ede18476d8f
--- package.lisp
+++ package.lisp
(defpackage #:phos/ui
(:documentation "User Interface for phos")
- (:use #:cl #:ltk))
+ (:use #:cl #:nodgui))
blob - 0034e00ac26d68a3a2db8680e55c96e1fc5d99c4
blob + 4a5b1596b89438c292ec9ac0d0ab15ade98beb82
--- phos.asd
+++ phos.asd
:license "ISC"
:version "0.0.1"
:serial t
- :depends-on ("quri" "cl-ppcre" "trivia" "ltk" "usocket" "cl+ssl" "cl-mime")
+ :depends-on ("quri" "cl-ppcre" "trivia" "nodgui" "usocket" "cl+ssl" "cl-mime")
:components ((:file "package")
(:file "phos")
(:file "gemtext")
- (:file "gemini")))
+ (:file "gemini")
+ (:file "ui")))
blob - dbccf3c87a5ed3b58666dac25cd29027535476e4
blob + b584cd9f422621febd835f22f0a57b9e44e58fcf
--- ui.lisp
+++ ui.lisp
(in-package #:phos/ui)
+(defparameter *title-1-font* "serif 22"
+ "Font for the level 1 title.")
+
+(defparameter *title-2-font* "serif 19"
+ "Font for the level 2 title.")
+
+(defparameter *title-3-font* "serif 16"
+ "Font for the level 3 title.")
+
+(defparameter *verbatim-font* "monospace 12"
+ "Font for the verbatim element.")
+
+(defparameter *item-font* "serif 12"
+ "Font for the item.")
+
+(defparameter *link-font* "serif 12"
+ "Font for the links.")
+
+(defparameter *paragraph-font* "serif 12"
+ "Font for the normal text")
+
+(defparameter *window-content* nil)
+
+(defparameter *current-url* nil)
+
(defgeneric render (obj frame)
- (:documentation "Render OBJ in the ltk FRAME"))
+ (:documentation "Render OBJ in the nodgui FRAME"))
(defmethod render ((l list) f)
(dolist (el l)
(render el f)))
(defmethod render ((title gemtext:title) f)
- (with-slots ((text phos/gemtext:text)
+ (with-slots ((text phos/gemtext:text)
(level phos/gemtext:level))
title
(let ((w (make-instance 'label
:master f
- :text (format nil "#(level ~a) ~a" level text))))
+ :font (case level
+ (1 *title-1-font*)
+ (2 *title-2-font*)
+ (3 *title-3-font*))
+ :text (format nil "~v{~A~:*~} ~a" level '("#") text))))
(pack w :side :top))))
(defmethod render ((link gemtext:link) f)
link
(let ((w (make-instance 'button
:master f
- :text (format nil "~a" (or text url)))))
+ ;; :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))))
(defmethod render ((item gemtext:item) f)
(with-slots ((text phos/gemtext:text)) item
(let ((w (make-instance 'label
:master f
+ :font *item-font*
:text (format nil "* ~a" text))))
(pack w :side :top))))
(with-slots ((text phos/gemtext:text)) par
(let ((w (make-instance 'label
:master f
+ :font *paragraph-font*
:text text)))
(pack w :side :top))))
v
(let ((w (make-instance 'label
:master f
- :text (format nil "```~a~%~a~&```"
- (or alt "")
- text))))
- (pack w :side :top))))
+ :font *verbatim-font*
+ :text text)))
+ (pack w :side :top)
+ (when alt
+ (pack (make-instance 'label
+ :master f
+ :text alt)
+ :side :top)))))
-(defun render-page (page)
- (with-ltk ()
- (let ((frame (make-instance 'frame)))
- (pack frame)
- (render page frame))))
+(defun clear-window ()
+ (pack-forget-all *window-content*))
-(defvar doc (with-open-file (stream #P"~/quicklisp/local-projects/phos/test.gmi")
- (gemtext:parse stream)))
+(defun do-render (url)
+ (let* ((uri (quri:uri url))
+ (*current-url* uri)
+ (base (quri:copy-uri uri)))
+ (setf (quri:uri-path base) nil)
+ (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)
+ *window-content*))))
-;; (render-page doc)
+(defun main (url)
+ (with-nodgui (:title "phos")
+ (let ((sf (make-instance 'scrolled-frame)))
+ (setf *window-content* (interior sf))
+ (pack sf :side :top :fill :both :expand t)
+ (do-render url))))
+
+;; (nodgui.demo:demo)
+
+;; (main "gemini://gemini.omarpolo.com/")
