cage
/
tinmop
mirror of https://codeberg.org/cage/tinmop/
1
0
Fork 0
Code Issues

- [gemini] attached source line to each parsed gemtext node.

This commit is contained in:
cage 2021-10-24 15:53:31 +02:00
parent be100347ef
commit 41bf046a29
3 changed files with 54 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

69
src/gemini/gemini-parser.lisp
View File

@ -386,6 +386,12 @@
:initform nil
:accessor viewport)))
(defclass with-raw-text ()
((raw-text
:initform nil
:initarg :raw-text
:accessor raw-text)))
(defclass with-group-id ()
((group-id
:initform nil
@ -410,7 +416,7 @@
:initarg :pre-group-id
:accessor pre-group-id)))
(defclass pre-start (with-group-id with-pre-group-id with-alt-text) ())
(defclass pre-start (with-group-id with-pre-group-id with-alt-text with-raw-text) ())
(defmethod print-object ((object pre-start) stream)
(print-unreadable-object (object stream :type t :identity t)
@ -427,7 +433,7 @@
(defun make-pre-end ()
(make-instance 'pre-end))
(defclass quoted-lines (with-group-id with-lines)
(defclass quoted-lines (with-group-id with-lines with-raw-text)
((prefix
:initform "@ "
:initarg :prefix
@ -439,7 +445,7 @@
:group-id group-id
:lines (list text)))
(defclass pre-line (with-group-id with-pre-group-id with-lines with-alt-text) ())
(defclass pre-line (with-group-id with-pre-group-id with-lines with-alt-text with-raw-text) ())
(defmethod print-object ((object pre-line) stream)
(print-unreadable-object (object stream :type t)
@ -462,7 +468,7 @@
:initarg :size
:accessor size)))
(defclass header-line (with-group-id with-lines)
(defclass header-line (with-group-id with-lines with-raw-text)
((level
:initform nil
:initarg :level
@ -474,14 +480,14 @@
:group-id gid
:level level))
(defclass unordered-list-line (with-group-id with-lines) ())
(defclass unordered-list-line (with-group-id with-lines with-raw-text) ())
(defun make-unordered-list-line (text header-group-id)
(make-instance 'unordered-list-line
:group-id header-group-id
:lines (list text)))
(defclass link-line (with-group-id)
(defclass link-line (with-group-id with-raw-text)
((link-text
:initarg :link-text
:initform nil
@ -502,13 +508,13 @@
:link-name link-name
:link-value link-value))
(defclass simple-line (with-group-id)
(defclass simple-line (with-group-id with-raw-text)
((text-line
:initarg :text-line
:initform nil
:accessor text-line)))
(defun make-simple-line (text header-group-id)
(defun make-simple-line (text header-group-id raw-text)
(make-instance 'simple-line
:text-line text
:group-id header-group-id))
@ -573,8 +579,10 @@
(current-pre-group-id)
(current-pre-alt-text))))
((html-utils:tag= :text node)
(make-simple-line (format nil "~a~%" (text-value node))
(current-header-group-id)))
(let ((text (text-value node)))
(make-simple-line (format nil "~a~%" text)
(current-header-group-id)
text)))
((html-utils:tag= :h1 node)
(make-header 1
(header-prefix-h1 (text-value node))
@ -588,7 +596,7 @@
(header-prefix-h3 (text-value node))
+h3-underline+))
((html-utils:tag= :li node)
(let ((text (format nil
(let* ((text (format nil
"~a ~a"
(bullet-prefix theme)
(text-value node))))
@ -620,23 +628,28 @@
(flatten (build-rows))))
(defun parse-gemini-file (data)
(let* ((lines (if (string= (format nil "~%") data)
(list (format nil "~%"))
(mapcar (lambda (a)
(strcat a (string #\Newline)))
(split-lines data)))))
(loop for line in lines
collect
(let ((was-raw-mode *raw-mode-data*)
(parsed-line (parse 'gemini-file line :junk-allowed t)))
(if was-raw-mode
(if *raw-mode-data*
(let ((*blanks* '(#\Newline #\Linefeed #\Return)))
(html-utils:make-tag-node :as-is
(list (list :alt *raw-mode-data*))
(trim-blanks line)))
parsed-line)
parsed-line)))))
(let* ((lines (if (string= (format nil "~%") data)
(list (format nil "~%"))
(mapcar (lambda (a)
(strcat a (string #\Newline)))
(split-lines data))))
(parsed (loop for line in lines
collect
(let ((was-raw-mode *raw-mode-data*)
(parsed-line (parse 'gemini-file line :junk-allowed t)))
(if was-raw-mode
(if *raw-mode-data*
(let ((*blanks* '(#\Newline #\Linefeed #\Return)))
(html-utils:make-tag-node :as-is
(list (list :alt *raw-mode-data*))
(trim-blanks line)))
parsed-line)
parsed-line)))))
(mapcar (lambda (a b)
(when b
(html-utils:add-attribute :source-line a b)))
lines parsed)
parsed))
;; response header

13
src/html-utils.lisp
View File

@ -29,7 +29,9 @@
(defun make-tag-node (tag attributes value)
"create a node"
(list tag attributes value))
(if (listp value)
(append (list tag attributes) value)
(list tag attributes value)))
(defun tag (node)
"Given a node returns the tag part"
@ -47,6 +49,9 @@
"Given an attribute the value part"
(second attribute))
(defun make-attribute (attribute-name attribute-value)
(list attribute-name attribute-value))
(defun children (node)
"Return children of this nodes if exists"
(when (and node
@ -75,6 +80,12 @@
(position-if (lambda (a) (tag= tag a))
node))
(defun add-attribute (attribute-name attribute-value node)
(make-tag-node (tag node)
(append (list (make-attribute attribute-name attribute-value))
(attributes node))
(children node)))
(defun node->link (node)
(html-utils:attribute-value (html-utils:find-attribute :href node)))

1
src/package.lisp
View File

@ -418,6 +418,7 @@
:attributes
:attribute-key
:attribute-value
:add-attribute
:children
:tag=
:find-attribute