mirror of https://codeberg.org/cage/tinmop/
- added 'match-words'.
This commit is contained in:
parent
9d0e588b0b
commit
b1b412ad89
|
@ -405,6 +405,9 @@
|
||||||
:initarg :source-line-id
|
:initarg :source-line-id
|
||||||
:accessor source-line-id)))
|
:accessor source-line-id)))
|
||||||
|
|
||||||
|
(defmethod print-object ((object with-raw-text) stream)
|
||||||
|
(format stream "sid: ~a raw-text: ~a" (source-line-id object) (raw-text object)))
|
||||||
|
|
||||||
(defclass with-group-id ()
|
(defclass with-group-id ()
|
||||||
((group-id
|
((group-id
|
||||||
:initform nil
|
:initform nil
|
||||||
|
|
|
@ -403,6 +403,7 @@
|
||||||
:maybe-percent-encode
|
:maybe-percent-encode
|
||||||
:display-corrupting-utf8-p
|
:display-corrupting-utf8-p
|
||||||
:remove-corrupting-utf8-chars
|
:remove-corrupting-utf8-chars
|
||||||
|
:match-words
|
||||||
:emojip
|
:emojip
|
||||||
:starting-emoji))
|
:starting-emoji))
|
||||||
|
|
||||||
|
|
|
@ -45,3 +45,12 @@
|
||||||
'(((((:a . "1") (:b . "12") (:c . "1")) ((:a . "2") (:b . "3") (:c . "4 ")))
|
'(((((:a . "1") (:b . "12") (:c . "1")) ((:a . "2") (:b . "3") (:c . "4 ")))
|
||||||
(((:a . " 5") (:b . "6") (:c . "7")) ((:padding . " ")))))
|
(((:a . " 5") (:b . "6") (:c . "7")) ((:padding . " ")))))
|
||||||
:test #'string=)))
|
:test #'string=)))
|
||||||
|
|
||||||
|
(deftest match-words (text-utils-suite)
|
||||||
|
(assert-true (match-words '("a" "b" "c") '("a" "b" "c")))
|
||||||
|
(assert-true (match-words '("a" "b" "c" "d") '("a" "b" "c")))
|
||||||
|
(assert-true (match-words '("a" "foo" "bar" "d") '("foo" "bar")))
|
||||||
|
(assert-true (match-words '("a" "b" "c" "d") '("c" "d")))
|
||||||
|
(assert-false (match-words '("a" "b" "c" "d") '("b" "a")))
|
||||||
|
(assert-false (match-words '("a" "b" "c" "d") '("a" "b" "x")))
|
||||||
|
(assert-false (match-words '("a" "b" "c" "d") '("a" "b" "c" "d" "e"))))
|
||||||
|
|
|
@ -759,3 +759,12 @@ printed in the box column by column; in the example above the results are:
|
||||||
|
|
||||||
(defmethod remove-corrupting-utf8-chars ((object sequence))
|
(defmethod remove-corrupting-utf8-chars ((object sequence))
|
||||||
(remove-if #'display-corrupting-utf8-p object))
|
(remove-if #'display-corrupting-utf8-p object))
|
||||||
|
|
||||||
|
(defun match-words (words probe &optional (test #'string=))
|
||||||
|
(loop for start-words = words then (rest start-words)
|
||||||
|
while start-words do
|
||||||
|
(if (<= (length probe)
|
||||||
|
(length start-words))
|
||||||
|
(let ((slice (subseq start-words 0 (length probe))))
|
||||||
|
(tree-equal slice probe :test test))
|
||||||
|
(return-from match-words nil))))
|
||||||
|
|
Loading…
Reference in New Issue