mirror of https://codeberg.org/cage/tinmop/
- prefixed all parsing rule for gemini parsing to avoid clash with other rules in the code.
This commit is contained in:
cage
parent
4924016dcf
commit
f0ba8aad71
|
|
@ -122,36 +122,36 @@
|
|||
(geminize-link url)
|
||||
title))
|
||||
|
||||
(defrule space (or #\Space #\Tab)
|
||||
(defrule gemini-space (or #\Space #\Tab)
|
||||
(:constant nil))
|
||||
|
||||
(defrule new-line #\Newline
|
||||
(defrule gemini-new-line #\Newline
|
||||
(:constant nil))
|
||||
|
||||
(defrule carriage-return #\Return
|
||||
(defrule gemini-carriage-return #\Return
|
||||
(:constant nil))
|
||||
|
||||
(defrule cr-lf (and (? carriage-return) new-line)
|
||||
(defrule gemini-cr-lf (and (? carriage-return) new-line)
|
||||
(:constant nil))
|
||||
|
||||
(defrule h1-prefix "#"
|
||||
(defrule gemini-h1-prefix "#"
|
||||
(:constant :h1))
|
||||
|
||||
(defrule h2-prefix "##"
|
||||
(defrule gemini-h2-prefix "##"
|
||||
(:constant :h2))
|
||||
|
||||
(defrule h3-prefix "###"
|
||||
(defrule gemini-h3-prefix "###"
|
||||
(:constant :h3))
|
||||
|
||||
(defrule list-bullet "* "
|
||||
(defrule gemini-list-bullet "* "
|
||||
(:constant :li))
|
||||
|
||||
(defrule quote-prefix ">"
|
||||
(defrule gemini-quote-prefix ">"
|
||||
(:constant :quote))
|
||||
|
||||
(defrule preformatted-text-tag (and "```"
|
||||
(* (not cr-lf))
|
||||
cr-lf)
|
||||
(defrule gemini-preformatted-text-tag (and "```"
|
||||
(* (not gemini-cr-lf))
|
||||
gemini-cr-lf)
|
||||
(:function (lambda (a)
|
||||
(let ((saved-raw-mode *raw-mode-data*)
|
||||
(alt-text (coerce (second a) 'string)))
|
||||
|
|
@ -164,84 +164,84 @@
|
|||
(list :pre-end
|
||||
(list (list :alt saved-raw-mode))))))))
|
||||
|
||||
(defrule link-prefix (and "=>"
|
||||
(* space))
|
||||
(defrule gemini-link-prefix (and "=>"
|
||||
(* gemini-space))
|
||||
(:constant :a))
|
||||
|
||||
(defrule text-line (and (+ (not cr-lf)) cr-lf)
|
||||
(defrule gemini-text-line (and (+ (not gemini-cr-lf)) gemini-cr-lf)
|
||||
(:function (lambda (a)
|
||||
(list :text
|
||||
nil
|
||||
(coerce (first a) 'string)))))
|
||||
|
||||
(defrule link-url (+ (not (or space
|
||||
cr-lf)))
|
||||
(defrule gemini-link-url (+ (not (or gemini-space
|
||||
gemini-cr-lf)))
|
||||
(:text t))
|
||||
|
||||
(defrule link-name (+ (not cr-lf))
|
||||
(defrule gemini-link-name (+ (not gemini-cr-lf))
|
||||
(:text t))
|
||||
|
||||
(defrule link (and link-prefix
|
||||
link-url
|
||||
(? (and space
|
||||
(? link-name)))
|
||||
cr-lf)
|
||||
(defrule gemini-link (and gemini-link-prefix
|
||||
gemini-link-url
|
||||
(? (and gemini-space
|
||||
(? gemini-link-name)))
|
||||
cr-lf)
|
||||
(:function (lambda (a)
|
||||
(list (first a)
|
||||
(list (list :href (second a)))
|
||||
(text-utils:trim-blanks (second (third a)))))))
|
||||
|
||||
(defrule h1 (and h1-prefix
|
||||
text-line)
|
||||
(defrule gemini-h1 (and gemini-h1-prefix
|
||||
gemini-text-line)
|
||||
(:function (lambda (a)
|
||||
(list (first a)
|
||||
nil
|
||||
(tag-value (second a))))))
|
||||
|
||||
(defrule h2 (and h2-prefix
|
||||
text-line)
|
||||
(defrule gemini-h2 (and gemini-h2-prefix
|
||||
gemini-text-line)
|
||||
(:function (lambda (a)
|
||||
(list (first a)
|
||||
nil
|
||||
(tag-value (second a))))))
|
||||
|
||||
(defrule h3 (and h3-prefix
|
||||
text-line)
|
||||
(defrule gemini-h3 (and gemini-h3-prefix
|
||||
gemini-text-line)
|
||||
(:function (lambda (a)
|
||||
(list (first a)
|
||||
nil
|
||||
(tag-value (second a))))))
|
||||
|
||||
(defrule list-item (and list-bullet
|
||||
text-line)
|
||||
(defrule gemini-list-item (and gemini-list-bullet
|
||||
gemini-text-line)
|
||||
(:function (lambda (a)
|
||||
(list (first a)
|
||||
nil
|
||||
(tag-value (second a))))))
|
||||
|
||||
(defrule preformatted-text (and preformatted-text-tag
|
||||
(* (not preformatted-text-tag))
|
||||
preformatted-text-tag)
|
||||
(defrule gemini-preformatted-text (and gemini-preformatted-text-tag
|
||||
(* (not gemini-preformatted-text-tag))
|
||||
gemini-preformatted-text-tag)
|
||||
(:function (lambda (a) (append (first a)
|
||||
(list (coerce (second a) 'string))))))
|
||||
|
||||
(defrule quote-line (and quote-prefix
|
||||
(? text-line))
|
||||
(defrule gemini-quote-line (and gemini-quote-prefix
|
||||
(? gemini-text-line))
|
||||
(:function (lambda (a) (list (first a)
|
||||
nil
|
||||
(if (second a)
|
||||
(tag-value (second a))
|
||||
"")))))
|
||||
|
||||
(defrule gemini-file (* (or h3
|
||||
h2
|
||||
h1
|
||||
preformatted-text-tag
|
||||
link
|
||||
list-item
|
||||
quote-line
|
||||
text-line
|
||||
cr-lf))
|
||||
(defrule gemini-gemini-file (* (or gemini-h3
|
||||
gemini-h2
|
||||
gemini-h1
|
||||
gemini-preformatted-text-tag
|
||||
gemini-link
|
||||
gemini-list-item
|
||||
gemini-quote-line
|
||||
gemini-text-line
|
||||
gemini-cr-lf))
|
||||
(:function first))
|
||||
|
||||
(define-constant +h1-underline+ #\━ :test #'char=)
|
||||
|
|
@ -374,21 +374,21 @@
|
|||
(let* ((link-value (html-utils:node->link node))
|
||||
(absolute-p (iri:absolute-url-p link-value))
|
||||
(rendered-link (cond
|
||||
(absolute-p
|
||||
link-value)
|
||||
(comes-from-local-file
|
||||
(strcat original-path
|
||||
iri:+segment-separator+
|
||||
link-value))
|
||||
(t
|
||||
(absolutize-link link-value
|
||||
original-host
|
||||
original-port
|
||||
original-path
|
||||
original-query)))))
|
||||
(make-instance 'gemini-link
|
||||
:target rendered-link
|
||||
:name (tag-value node)))))
|
||||
(absolute-p
|
||||
link-value)
|
||||
(comes-from-local-file
|
||||
(strcat original-path
|
||||
iri:+segment-separator+
|
||||
link-value))
|
||||
(t
|
||||
(absolutize-link link-value
|
||||
original-host
|
||||
original-port
|
||||
original-path
|
||||
original-query)))))
|
||||
(make-instance 'gemini-link
|
||||
:target rendered-link
|
||||
:name (tag-value node)))))
|
||||
|
||||
(defun gemini-link-iri-p (iri)
|
||||
(conditions:with-default-on-error (nil)
|
||||
|
|
@ -754,7 +754,9 @@
|
|||
(parsed (loop for line in lines
|
||||
collect
|
||||
(let ((was-raw-mode *raw-mode-data*)
|
||||
(parsed-line (parse 'gemini-file line :junk-allowed t)))
|
||||
(parsed-line (parse 'gemini-gemini-file
|
||||
line
|
||||
:junk-allowed t)))
|
||||
(if was-raw-mode
|
||||
(if *raw-mode-data*
|
||||
(let ((*blanks* '(#\Newline #\Linefeed #\Return)))
|
||||
|
|
@ -854,13 +856,13 @@
|
|||
|
||||
(define-constant +max-meta-length+ 1024 :test #'=)
|
||||
|
||||
(defrule response-first-digit (or "1" "2" "3" "4" "5" "6")
|
||||
(defrule gemini-response-first-digit (or "1" "2" "3" "4" "5" "6")
|
||||
(:text t))
|
||||
|
||||
(defrule response-second-digit (or "0" "1" "2" "3" "4" "5" "6" "7" "8" "9")
|
||||
(defrule gemini-response-second-digit (or "0" "1" "2" "3" "4" "5" "6" "7" "8" "9")
|
||||
(:text t))
|
||||
|
||||
(defrule meta (+ (not carriage-return))
|
||||
(defrule gemini-meta (+ (not gemini-carriage-return))
|
||||
(:text t))
|
||||
|
||||
(defclass gemini-response ()
|
||||
|
|
@ -878,12 +880,12 @@
|
|||
(meta meta)) object
|
||||
(format stream "status: ~a meta: ~a" status-code meta))))
|
||||
|
||||
(defrule response (and response-first-digit
|
||||
response-second-digit
|
||||
space
|
||||
meta
|
||||
carriage-return
|
||||
new-line)
|
||||
(defrule gemini-response (and gemini-response-first-digit
|
||||
gemini-response-second-digit
|
||||
gemini-space
|
||||
gemini-meta
|
||||
gemini-carriage-return
|
||||
gemini-new-line)
|
||||
(:function (lambda (a)
|
||||
(make-instance 'gemini-response
|
||||
:status-code (parse-integer (strcat (first a)
|
||||
|
|
@ -891,7 +893,7 @@
|
|||
:meta (fourth a)))))
|
||||
|
||||
(defun parse-gemini-response-header (data)
|
||||
(let ((parsed (parse 'response data)))
|
||||
(let ((parsed (parse 'gemini-response data)))
|
||||
(if (> (length (meta parsed))
|
||||
+max-meta-length+)
|
||||
(error 'conditions:length-error
|
||||
|
|
|
|||
Loading…
Reference in New Issue