Skip to content

Collapse whitespace #12

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
wants to merge 2 commits into
base: master
Choose a base branch
from
Open

Collapse whitespace #12

Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
c1cc3ba
xml-util.lisp (whitespace-char-p): Don't use a macro if a function is…
ralph-schleicher Sep 15, 2021
e44f3bf
xml-util.lisp (collapse-whitespace): Full Unicode support.
ralph-schleicher Sep 15, 2021
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
55 changes: 23 additions & 32 deletions src/nox/xml-util.lisp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -382,12 +382,11 @@
(return (concatenate 'string (nreverse chars)))))))


(defmacro whitespace-char-p (char)
(with-temps (c)
`(let ((,c ,char))
;; let's assume this works for now :-)
(or (char= ,c #\Space)
(not (graphic-char-p ,c))))))
(defun whitespace-char-p (char)
"Return true if CHAR is a whitespace character.
Argument CHAR has to be a character object."
(declare (type character char))
(or (char= char #\Space) (not (graphic-char-p char))))


(defequal -whitespace-chars-
Expand Down Expand Up @@ -416,32 +415,24 @@
char)))

(defun collapse-whitespace (string)
;; new version with "poor man's Unicode support" :-(
(labels ((collapse (mode old new)
(if old
(dsb (c &rest old) old
(cond ((zerop (logand (char-code c) #b10000000))
(if (whitespace-char-p c)
(collapse (if (eq mode :start) :start :white) old new)
(collapse :collect old
(if (eq mode :white)
(list* c #\Space new)
(cons c new)))))
((= (logand (char-code c) #b11100000) 192)
(collapse :collect (cdr old)
(if (eq mode :white)
(list* (car old) c #\Space new)
(list* (car old) c new))))
((= (logand (char-code c) #b11110000) 224)
(collapse :collect (cddr old)
(if (eq mode :white)
(list* (cadr old) (car old) c #\Space new)
(list* (cadr old) (car old) c new))))
(t
(error "Cannot decode this: ~S" (cons c old)))))
(concatenate 'string (nreverse new)))))
(declare (dynamic-extent #'collapse))
(collapse :start (coerce string 'list) nil)))
"Remove leading and trailing whitespace characters in STRING
and replace any intermediate sequence of whitespace characters
with a single space character."
(with-output-to-string (stream)
(loop :for char :across string
:with state = :start
:do (cond ((eq state :parse)
(if (whitespace-char-p char)
(setf state :space)
(princ char stream)))
((not (whitespace-char-p char))
;; Found a non-whitespace character after skipping
;; a sequence of whitespace characters.
(when (eq state :space)
(princ #\Space stream))
(princ char stream)
(setf state :parse))
))))


;;; --------------------------------------------------------------------------------------
Expand Down