mirror of https://codeberg.org/cage/tinmop/
- [gemini] attached source line to each parsed gemtext node.
This commit is contained in:
parent
be100347ef
commit
41bf046a29
|
@ -386,6 +386,12 @@
|
||||||
:initform nil
|
:initform nil
|
||||||
:accessor viewport)))
|
:accessor viewport)))
|
||||||
|
|
||||||
|
(defclass with-raw-text ()
|
||||||
|
((raw-text
|
||||||
|
:initform nil
|
||||||
|
:initarg :raw-text
|
||||||
|
:accessor raw-text)))
|
||||||
|
|
||||||
(defclass with-group-id ()
|
(defclass with-group-id ()
|
||||||
((group-id
|
((group-id
|
||||||
:initform nil
|
:initform nil
|
||||||
|
@ -410,7 +416,7 @@
|
||||||
:initarg :pre-group-id
|
:initarg :pre-group-id
|
||||||
:accessor 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)
|
(defmethod print-object ((object pre-start) stream)
|
||||||
(print-unreadable-object (object stream :type t :identity t)
|
(print-unreadable-object (object stream :type t :identity t)
|
||||||
|
@ -427,7 +433,7 @@
|
||||||
(defun make-pre-end ()
|
(defun make-pre-end ()
|
||||||
(make-instance '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
|
((prefix
|
||||||
:initform "@ "
|
:initform "@ "
|
||||||
:initarg :prefix
|
:initarg :prefix
|
||||||
|
@ -439,7 +445,7 @@
|
||||||
:group-id group-id
|
:group-id group-id
|
||||||
:lines (list text)))
|
: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)
|
(defmethod print-object ((object pre-line) stream)
|
||||||
(print-unreadable-object (object stream :type t)
|
(print-unreadable-object (object stream :type t)
|
||||||
|
@ -462,7 +468,7 @@
|
||||||
:initarg :size
|
:initarg :size
|
||||||
:accessor size)))
|
:accessor size)))
|
||||||
|
|
||||||
(defclass header-line (with-group-id with-lines)
|
(defclass header-line (with-group-id with-lines with-raw-text)
|
||||||
((level
|
((level
|
||||||
:initform nil
|
:initform nil
|
||||||
:initarg :level
|
:initarg :level
|
||||||
|
@ -474,14 +480,14 @@
|
||||||
:group-id gid
|
:group-id gid
|
||||||
:level level))
|
: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)
|
(defun make-unordered-list-line (text header-group-id)
|
||||||
(make-instance 'unordered-list-line
|
(make-instance 'unordered-list-line
|
||||||
:group-id header-group-id
|
:group-id header-group-id
|
||||||
:lines (list text)))
|
:lines (list text)))
|
||||||
|
|
||||||
(defclass link-line (with-group-id)
|
(defclass link-line (with-group-id with-raw-text)
|
||||||
((link-text
|
((link-text
|
||||||
:initarg :link-text
|
:initarg :link-text
|
||||||
:initform nil
|
:initform nil
|
||||||
|
@ -502,13 +508,13 @@
|
||||||
:link-name link-name
|
:link-name link-name
|
||||||
:link-value link-value))
|
:link-value link-value))
|
||||||
|
|
||||||
(defclass simple-line (with-group-id)
|
(defclass simple-line (with-group-id with-raw-text)
|
||||||
((text-line
|
((text-line
|
||||||
:initarg :text-line
|
:initarg :text-line
|
||||||
:initform nil
|
:initform nil
|
||||||
:accessor text-line)))
|
: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
|
(make-instance 'simple-line
|
||||||
:text-line text
|
:text-line text
|
||||||
:group-id header-group-id))
|
:group-id header-group-id))
|
||||||
|
@ -573,8 +579,10 @@
|
||||||
(current-pre-group-id)
|
(current-pre-group-id)
|
||||||
(current-pre-alt-text))))
|
(current-pre-alt-text))))
|
||||||
((html-utils:tag= :text node)
|
((html-utils:tag= :text node)
|
||||||
(make-simple-line (format nil "~a~%" (text-value node))
|
(let ((text (text-value node)))
|
||||||
(current-header-group-id)))
|
(make-simple-line (format nil "~a~%" text)
|
||||||
|
(current-header-group-id)
|
||||||
|
text)))
|
||||||
((html-utils:tag= :h1 node)
|
((html-utils:tag= :h1 node)
|
||||||
(make-header 1
|
(make-header 1
|
||||||
(header-prefix-h1 (text-value node))
|
(header-prefix-h1 (text-value node))
|
||||||
|
@ -588,7 +596,7 @@
|
||||||
(header-prefix-h3 (text-value node))
|
(header-prefix-h3 (text-value node))
|
||||||
+h3-underline+))
|
+h3-underline+))
|
||||||
((html-utils:tag= :li node)
|
((html-utils:tag= :li node)
|
||||||
(let ((text (format nil
|
(let* ((text (format nil
|
||||||
"~a ~a"
|
"~a ~a"
|
||||||
(bullet-prefix theme)
|
(bullet-prefix theme)
|
||||||
(text-value node))))
|
(text-value node))))
|
||||||
|
@ -620,23 +628,28 @@
|
||||||
(flatten (build-rows))))
|
(flatten (build-rows))))
|
||||||
|
|
||||||
(defun parse-gemini-file (data)
|
(defun parse-gemini-file (data)
|
||||||
(let* ((lines (if (string= (format nil "~%") data)
|
(let* ((lines (if (string= (format nil "~%") data)
|
||||||
(list (format nil "~%"))
|
(list (format nil "~%"))
|
||||||
(mapcar (lambda (a)
|
(mapcar (lambda (a)
|
||||||
(strcat a (string #\Newline)))
|
(strcat a (string #\Newline)))
|
||||||
(split-lines data)))))
|
(split-lines data))))
|
||||||
(loop for line in lines
|
(parsed (loop for line in lines
|
||||||
collect
|
collect
|
||||||
(let ((was-raw-mode *raw-mode-data*)
|
(let ((was-raw-mode *raw-mode-data*)
|
||||||
(parsed-line (parse 'gemini-file line :junk-allowed t)))
|
(parsed-line (parse 'gemini-file line :junk-allowed t)))
|
||||||
(if was-raw-mode
|
(if was-raw-mode
|
||||||
(if *raw-mode-data*
|
(if *raw-mode-data*
|
||||||
(let ((*blanks* '(#\Newline #\Linefeed #\Return)))
|
(let ((*blanks* '(#\Newline #\Linefeed #\Return)))
|
||||||
(html-utils:make-tag-node :as-is
|
(html-utils:make-tag-node :as-is
|
||||||
(list (list :alt *raw-mode-data*))
|
(list (list :alt *raw-mode-data*))
|
||||||
(trim-blanks line)))
|
(trim-blanks line)))
|
||||||
parsed-line)
|
parsed-line)
|
||||||
parsed-line)))))
|
parsed-line)))))
|
||||||
|
(mapcar (lambda (a b)
|
||||||
|
(when b
|
||||||
|
(html-utils:add-attribute :source-line a b)))
|
||||||
|
lines parsed)
|
||||||
|
parsed))
|
||||||
|
|
||||||
;; response header
|
;; response header
|
||||||
|
|
||||||
|
|
|
@ -29,7 +29,9 @@
|
||||||
|
|
||||||
(defun make-tag-node (tag attributes value)
|
(defun make-tag-node (tag attributes value)
|
||||||
"create a node"
|
"create a node"
|
||||||
(list tag attributes value))
|
(if (listp value)
|
||||||
|
(append (list tag attributes) value)
|
||||||
|
(list tag attributes value)))
|
||||||
|
|
||||||
(defun tag (node)
|
(defun tag (node)
|
||||||
"Given a node returns the tag part"
|
"Given a node returns the tag part"
|
||||||
|
@ -47,6 +49,9 @@
|
||||||
"Given an attribute the value part"
|
"Given an attribute the value part"
|
||||||
(second attribute))
|
(second attribute))
|
||||||
|
|
||||||
|
(defun make-attribute (attribute-name attribute-value)
|
||||||
|
(list attribute-name attribute-value))
|
||||||
|
|
||||||
(defun children (node)
|
(defun children (node)
|
||||||
"Return children of this nodes if exists"
|
"Return children of this nodes if exists"
|
||||||
(when (and node
|
(when (and node
|
||||||
|
@ -75,6 +80,12 @@
|
||||||
(position-if (lambda (a) (tag= tag a))
|
(position-if (lambda (a) (tag= tag a))
|
||||||
node))
|
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)
|
(defun node->link (node)
|
||||||
(html-utils:attribute-value (html-utils:find-attribute :href node)))
|
(html-utils:attribute-value (html-utils:find-attribute :href node)))
|
||||||
|
|
||||||
|
|
|
@ -418,6 +418,7 @@
|
||||||
:attributes
|
:attributes
|
||||||
:attribute-key
|
:attribute-key
|
||||||
:attribute-value
|
:attribute-value
|
||||||
|
:add-attribute
|
||||||
:children
|
:children
|
||||||
:tag=
|
:tag=
|
||||||
:find-attribute
|
:find-attribute
|
||||||
|
|
Loading…
Reference in New Issue