mirror of https://codeberg.org/cage/tinmop/
- prefixed all parsing rule for software configuration to avoid clashes with other rules in the code.
This commit is contained in:
cage
parent
4ac967966b
commit
07bdc7c65c
|
|
@ -109,40 +109,40 @@
|
||||||
|
|
||||||
(define-constant +false-values+ '("no" "false") :test #'equalp)
|
(define-constant +false-values+ '("no" "false") :test #'equalp)
|
||||||
|
|
||||||
(defrule blank (or #\space #\Newline #\Tab)
|
(defrule conf-blank (or #\space #\Newline #\Tab)
|
||||||
(:constant nil))
|
(:constant nil))
|
||||||
|
|
||||||
(defrule blanks (* blank)
|
(defrule conf-blanks (* conf-blank)
|
||||||
(:constant nil))
|
(:constant nil))
|
||||||
|
|
||||||
(defrule assign #\=
|
(defrule conf-assign #\=
|
||||||
(:constant nil))
|
(:constant nil))
|
||||||
|
|
||||||
(defrule comment (and blanks #\# (* (not #\Newline)) blanks)
|
(defrule conf-comment (and conf-blanks #\# (* (not #\Newline)) conf-blanks)
|
||||||
(:constant nil))
|
(:constant nil))
|
||||||
|
|
||||||
(defrule hexcolor-prefix #\#)
|
(defrule conf-hexcolor-prefix #\#)
|
||||||
|
|
||||||
(defrule digit (character-ranges (#\0 #\9))
|
(defrule conf-digit (character-ranges (#\0 #\9))
|
||||||
(:text t))
|
(:text t))
|
||||||
|
|
||||||
(defrule hex-digit
|
(defrule conf-hex-digit
|
||||||
(or (character-ranges (#\0 #\9))
|
(or (character-ranges (#\0 #\9))
|
||||||
(character-ranges (#\a #\f))
|
(character-ranges (#\a #\f))
|
||||||
(character-ranges (#\A #\F))))
|
(character-ranges (#\A #\F))))
|
||||||
|
|
||||||
(defrule hexcolor
|
(defrule conf-hexcolor
|
||||||
(and hexcolor-prefix
|
(and conf-hexcolor-prefix
|
||||||
hex-digit hex-digit ; r
|
conf-hex-digit conf-hex-digit ; r
|
||||||
hex-digit hex-digit ; g
|
conf-hex-digit conf-hex-digit ; g
|
||||||
hex-digit hex-digit) ; b
|
conf-hex-digit conf-hex-digit) ; b
|
||||||
(:text t)
|
(:text t)
|
||||||
(:function (lambda (a) (parse-integer a :start 1 :radix 16))))
|
(:function (lambda (a) (parse-integer a :start 1 :radix 16))))
|
||||||
|
|
||||||
(defun keywordize (a)
|
(defun keywordize (a)
|
||||||
(make-keyword (string-upcase a)))
|
(make-keyword (string-upcase a)))
|
||||||
|
|
||||||
(defrule colorname
|
(defrule conf-colorname
|
||||||
(or "black"
|
(or "black"
|
||||||
"red"
|
"red"
|
||||||
"green"
|
"green"
|
||||||
|
|
@ -153,25 +153,25 @@
|
||||||
"white")
|
"white")
|
||||||
(:function keywordize))
|
(:function keywordize))
|
||||||
|
|
||||||
(defrule escaped-character (and #\\ character)
|
(defrule conf-escaped-character (and #\\ character)
|
||||||
(:function (lambda (a) (list (second a)))))
|
(:function (lambda (a) (list (second a)))))
|
||||||
|
|
||||||
(defrule field-separator #\.)
|
(defrule conf-field-separator #\.)
|
||||||
|
|
||||||
(defrule field
|
(defrule conf-field
|
||||||
(* (or escaped-character
|
(* (or conf-escaped-character
|
||||||
(not (or #\# assign field-separator blank))))
|
(not (or #\# conf-assign conf-field-separator conf-blank))))
|
||||||
|
|
||||||
(:text t))
|
(:text t))
|
||||||
|
|
||||||
;; this rule is not actually part of the grammar but jus a convenience
|
;; this rule is not actually part of the grammar but jus a convenience
|
||||||
;; function to remove duplicated code (see rules: key and value)
|
;; function to remove duplicated code (see rules: key and value)
|
||||||
(defrule fields
|
(defrule conf-fields
|
||||||
(and field
|
(and conf-field
|
||||||
(? (and field-separator fields)))
|
(? (and conf-field-separator conf-fields)))
|
||||||
(:function flatten))
|
(:function flatten))
|
||||||
|
|
||||||
(defrule key fields
|
(defrule conf-key conf-fields
|
||||||
(:function (lambda (a)
|
(:function (lambda (a)
|
||||||
(mapcar (lambda (element)
|
(mapcar (lambda (element)
|
||||||
(if (string= +field-separator-value+ element)
|
(if (string= +field-separator-value+ element)
|
||||||
|
|
@ -180,25 +180,25 @@
|
||||||
a)))
|
a)))
|
||||||
(:function remove-if-null))
|
(:function remove-if-null))
|
||||||
|
|
||||||
(defrule generic-value fields
|
(defrule conf-generic-value conf-fields
|
||||||
(:text t))
|
(:text t))
|
||||||
|
|
||||||
(defrule generic-assign
|
(defrule conf-generic-assign
|
||||||
(and key blanks assign blanks
|
(and conf-key conf-blanks conf-assign conf-blanks
|
||||||
(or quoted-string
|
(or conf-quoted-string
|
||||||
hexcolor
|
conf-hexcolor
|
||||||
colorname
|
conf-colorname
|
||||||
generic-value) ; the order in this list *is* important
|
conf-generic-value) ; the order in this list *is* important
|
||||||
blanks)
|
conf-blanks)
|
||||||
(:function remove-if-null))
|
(:function remove-if-null))
|
||||||
|
|
||||||
(defrule quoted-string (and #\" (* (not #\")) #\")
|
(defrule conf-quoted-string (and #\" (* (not #\")) #\")
|
||||||
(:function (lambda (a) (second a)))
|
(:function (lambda (a) (second a)))
|
||||||
(:text t))
|
(:text t))
|
||||||
|
|
||||||
(defrule regexp quoted-string)
|
(defrule conf-regexp conf-quoted-string)
|
||||||
|
|
||||||
(defrule color-re-key "color-regexp"
|
(defrule conf-color-re-key "color-regexp"
|
||||||
(:constant :color-re))
|
(:constant :color-re))
|
||||||
|
|
||||||
(defclass color-re-assign ()
|
(defclass color-re-assign ()
|
||||||
|
|
@ -253,61 +253,83 @@
|
||||||
(and (not color-name-p) color)
|
(and (not color-name-p) color)
|
||||||
attributes))))
|
attributes))))
|
||||||
|
|
||||||
(defrule attribute-value (or "bold"
|
(defrule conf-attribute-value (or "bold"
|
||||||
"italic"
|
"italic"
|
||||||
"underline"
|
"underline"
|
||||||
"blink")
|
"blink")
|
||||||
(:text t)
|
(:text t)
|
||||||
(:function (lambda (a) (tui-utils:text->tui-attribute a))))
|
(:function (lambda (a) (tui-utils:text->tui-attribute a))))
|
||||||
|
|
||||||
(defrule color-re-assign
|
(defrule conf-color-re-assign
|
||||||
(and color-re-key blanks
|
(and conf-color-re-key
|
||||||
assign blanks regexp blanks
|
conf-blanks
|
||||||
(or hexcolor colorname) blanks
|
conf-assign
|
||||||
(? (and attribute-value blanks)))
|
conf-blanks
|
||||||
|
conf-regexp
|
||||||
|
conf-blanks
|
||||||
|
(or conf-hexcolor conf-colorname) conf-blanks
|
||||||
|
(? (and conf-attribute-value conf-blanks)))
|
||||||
(:function remove-if-null)
|
(:function remove-if-null)
|
||||||
(:function build-color-re-assign))
|
(:function build-color-re-assign))
|
||||||
|
|
||||||
(defrule ignore-user-re-key "ignore-user-regexp"
|
(defrule conf-ignore-user-re-key "ignore-user-regexp"
|
||||||
(:constant :ignore-user-re))
|
(:constant :ignore-user-re))
|
||||||
|
|
||||||
(defrule ignore-user-boost-re-key "ignore-user-boost-regexp"
|
(defrule conf-ignore-user-boost-re-key "ignore-user-boost-regexp"
|
||||||
(:constant :ignore-user-boost-re))
|
(:constant :ignore-user-boost-re))
|
||||||
|
|
||||||
(defrule ignore-tag-re-assign "ignore-tag-regexp"
|
(defrule conf-ignore-tag-re-assign "ignore-tag-regexp"
|
||||||
(:constant :ignore-tag-re))
|
(:constant :ignore-tag-re))
|
||||||
|
|
||||||
(defrule ignore-user-re-assign
|
(defrule conf-ignore-user-re-assign
|
||||||
(and ignore-user-re-key blanks
|
(and conf-ignore-user-re-key
|
||||||
assign blanks regexp blanks)
|
conf-blanks
|
||||||
|
conf-assign
|
||||||
|
conf-blanks
|
||||||
|
conf-regexp
|
||||||
|
conf-blanks)
|
||||||
(:function (lambda (a) (list (first a) (fifth a)))))
|
(:function (lambda (a) (list (first a) (fifth a)))))
|
||||||
|
|
||||||
(defrule ignore-user-boost-re-assign
|
(defrule conf-ignore-user-boost-re-assign
|
||||||
(and ignore-user-boost-re-key blanks
|
(and conf-ignore-user-boost-re-key
|
||||||
assign blanks regexp blanks)
|
conf-blanks
|
||||||
|
conf-assign
|
||||||
|
conf-blanks
|
||||||
|
conf-regexp
|
||||||
|
conf-blanks)
|
||||||
(:function (lambda (a) (list (first a) (fifth a)))))
|
(:function (lambda (a) (list (first a) (fifth a)))))
|
||||||
|
|
||||||
(defrule server-key "server"
|
(defrule conf-server-key "server"
|
||||||
(:constant :server))
|
(:constant :server))
|
||||||
|
|
||||||
(defrule username-key "username"
|
(defrule conf-username-key "username"
|
||||||
(:constant :username))
|
(:constant :username))
|
||||||
|
|
||||||
(defrule open "open"
|
(defrule conf-open "open"
|
||||||
(:constant :open))
|
(:constant :open))
|
||||||
|
|
||||||
(defrule open-link-helper-key open)
|
(defrule conf-open-link-helper-key conf-open)
|
||||||
|
|
||||||
(defrule with "with"
|
(defrule conf-with "with"
|
||||||
(:constant :with))
|
(:constant :with))
|
||||||
|
|
||||||
(defrule server-assign
|
(defrule conf-server-assign
|
||||||
(and server-key blanks assign blanks generic-value blanks)
|
(and conf-server-key
|
||||||
|
conf-blanks
|
||||||
|
conf-assign
|
||||||
|
conf-blanks
|
||||||
|
conf-generic-value
|
||||||
|
conf-blanks)
|
||||||
(:function (lambda (a)
|
(:function (lambda (a)
|
||||||
(list (first a) (fifth a)))))
|
(list (first a) (fifth a)))))
|
||||||
|
|
||||||
(defrule username-assign
|
(defrule conf-username-assign
|
||||||
(and username-key blanks assign blanks generic-value blanks)
|
(and conf-username-key
|
||||||
|
conf-blanks
|
||||||
|
conf-assign
|
||||||
|
conf-blanks
|
||||||
|
conf-generic-value
|
||||||
|
conf-blanks)
|
||||||
(:function (lambda (a)
|
(:function (lambda (a)
|
||||||
(list (first a) (fifth a)))))
|
(list (first a) (fifth a)))))
|
||||||
|
|
||||||
|
|
@ -366,42 +388,44 @@
|
||||||
:wait wait
|
:wait wait
|
||||||
:buffer-size buffer-size))
|
:buffer-size buffer-size))
|
||||||
|
|
||||||
(defrule use "use"
|
(defrule conf-use "use"
|
||||||
(:text t))
|
(:text t))
|
||||||
|
|
||||||
(defrule cache "cache"
|
(defrule conf-cache "cache"
|
||||||
(:text t))
|
(:text t))
|
||||||
|
|
||||||
(defrule no "no"
|
(defrule conf-no "no"
|
||||||
(:text t))
|
(:text t))
|
||||||
|
|
||||||
(defrule wait "wait"
|
(defrule conf-wait "wait"
|
||||||
(:text t))
|
(:text t))
|
||||||
|
|
||||||
(defrule buffer-label "buffer"
|
(defrule conf-buffer-label "buffer"
|
||||||
(:text t))
|
(:text t))
|
||||||
|
|
||||||
(defrule use-cache (and use blanks cache)
|
(defrule conf-use-cache (and conf-use conf-blanks conf-cache)
|
||||||
(:constant t))
|
(:constant t))
|
||||||
|
|
||||||
(defrule no-wait (and no blanks wait)
|
(defrule conf-no-wait (and conf-no conf-blanks conf-wait)
|
||||||
(:constant t))
|
(:constant t))
|
||||||
|
|
||||||
(defrule open-link-helper
|
(defrule conf-open-link-helper
|
||||||
(and open-link-helper-key
|
(and conf-open-link-helper-key
|
||||||
blanks
|
conf-blanks
|
||||||
regexp ; 2 link-pattern
|
conf-regexp ; 2 link-pattern
|
||||||
blanks
|
conf-blanks
|
||||||
with
|
conf-with
|
||||||
blanks
|
conf-blanks
|
||||||
regexp ; 6 program to use
|
conf-regexp ; 6 program to use
|
||||||
blanks
|
conf-blanks
|
||||||
(? (and use-cache ; 8 use cache?
|
(? (and conf-use-cache ; 8 use cache?
|
||||||
blanks))
|
conf-blanks))
|
||||||
(? (and no-wait ; 9 wait download? Buffer size?
|
(? (and conf-no-wait ; 9 wait download? Buffer size?
|
||||||
blanks
|
conf-blanks
|
||||||
(? (and buffer-label blanks (+ digit)))
|
(? (and conf-buffer-label
|
||||||
blanks)))
|
conf-blanks
|
||||||
|
(+ conf-digit)))
|
||||||
|
conf-blanks)))
|
||||||
(:function (lambda (args)
|
(:function (lambda (args)
|
||||||
(let* ((use-cache (elt args 8))
|
(let* ((use-cache (elt args 8))
|
||||||
(wait-parameters (elt args 9))
|
(wait-parameters (elt args 9))
|
||||||
|
|
@ -423,14 +447,20 @@
|
||||||
:wait waitp
|
:wait waitp
|
||||||
:buffer-size buffer-size))))))
|
:buffer-size buffer-size))))))
|
||||||
|
|
||||||
(defrule post-allowed-language (and "post-allowed-language" blanks assign regexp)
|
(defrule conf-post-allowed-language (and "post-allowed-language"
|
||||||
|
conf-blanks
|
||||||
|
conf-assign
|
||||||
|
conf-regexp)
|
||||||
(:function remove-if-null))
|
(:function remove-if-null))
|
||||||
|
|
||||||
(defrule filepath quoted-string)
|
(defrule conf-filepath conf-quoted-string)
|
||||||
|
|
||||||
(defparameter *already-included-files* ())
|
(defparameter *already-included-files* ())
|
||||||
|
|
||||||
(defrule use-file (and use blanks filepath blanks)
|
(defrule conf-use-file (and conf-use
|
||||||
|
conf-blanks
|
||||||
|
conf-filepath
|
||||||
|
conf-blanks)
|
||||||
(:function (lambda (a)
|
(:function (lambda (a)
|
||||||
(let ((file (third a)))
|
(let ((file (third a)))
|
||||||
(if (find file *already-included-files* :test #'string=)
|
(if (find file *already-included-files* :test #'string=)
|
||||||
|
|
@ -440,28 +470,28 @@
|
||||||
(load-config-file (third a) nil)))
|
(load-config-file (third a) nil)))
|
||||||
nil))))
|
nil))))
|
||||||
|
|
||||||
(defrule entries
|
(defrule conf-entries
|
||||||
(and (* comment)
|
(and (* conf-comment)
|
||||||
(or use-file
|
(or conf-use-file
|
||||||
color-re-assign
|
conf-color-re-assign
|
||||||
ignore-user-re-assign
|
conf-ignore-user-re-assign
|
||||||
ignore-user-boost-re-assign
|
conf-ignore-user-boost-re-assign
|
||||||
ignore-tag-re-assign
|
conf-ignore-tag-re-assign
|
||||||
server-assign
|
conf-server-assign
|
||||||
username-assign
|
conf-username-assign
|
||||||
open-link-helper
|
conf-open-link-helper
|
||||||
post-allowed-language
|
conf-post-allowed-language
|
||||||
generic-assign)
|
conf-generic-assign)
|
||||||
(* comment))
|
(* conf-comment))
|
||||||
(:function second))
|
(:function second))
|
||||||
|
|
||||||
(defrule config (* entries)
|
(defrule conf-config (* conf-entries)
|
||||||
(:function remove-if-null))
|
(:function remove-if-null))
|
||||||
|
|
||||||
(defgeneric parse-config (object))
|
(defgeneric parse-config (object))
|
||||||
|
|
||||||
(defmethod parse-config ((object string))
|
(defmethod parse-config ((object string))
|
||||||
(parse 'config object))
|
(parse 'conf-config object))
|
||||||
|
|
||||||
(defmethod parse-config ((object pathname))
|
(defmethod parse-config ((object pathname))
|
||||||
(parse-config (fs:slurp-file object)))
|
(parse-config (fs:slurp-file object)))
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue