1
0
Fork 0

- added 'match-words'.

This commit is contained in:
cage 2021-11-05 14:48:40 +01:00
parent 9d0e588b0b
commit b1b412ad89
4 changed files with 22 additions and 0 deletions

View File

@ -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

View File

@ -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))

View File

@ -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"))))

View File

@ -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))))