File tree Expand file tree Collapse file tree 1 file changed +12
-22
lines changed Expand file tree Collapse file tree 1 file changed +12
-22
lines changed Original file line number Diff line number Diff line change 415
415
(read-char stream t nil t )
416
416
char )))
417
417
418
+
418
419
(defun collapse-whitespace (string )
419
- ; ; new version with "poor man's Unicode support" :-(
420
+ " Trims and replaces multiple whitespace char occurences with a
421
+ single Space. Relies on the platform's unicode support. See also
422
+ https://github.com/lisp/de.setf.wilbur/issues/4"
420
423
(labels ((collapse (mode old new)
421
424
(if old
422
- (dsb (c &rest old) old
423
- (cond ((zerop (logand (char-code c) #b10000000 ))
424
- (if (whitespace-char-p c)
425
- (collapse (if (eq mode :start ) :start :white ) old new)
426
- (collapse :collect old
427
- (if (eq mode :white )
428
- (list* c #\Space new)
429
- (cons c new)))))
430
- ((= (logand (char-code c) #b11100000 ) 192 )
431
- (collapse :collect (cdr old)
432
- (if (eq mode :white )
433
- (list* (car old) c #\Space new)
434
- (list* (car old) c new))))
435
- ((= (logand (char-code c) #b11110000 ) 224 )
436
- (collapse :collect (cddr old)
437
- (if (eq mode :white )
438
- (list* (cadr old) (car old) c #\Space new)
439
- (list* (cadr old) (car old) c new))))
440
- (t
441
- (error " Cannot decode this: ~S " (cons c old)))))
442
- (concatenate ' string (nreverse new)))))
425
+ (dsb (c &rest old) old
426
+ (if (whitespace-char-p c)
427
+ (collapse (if (eq mode :start ) :start :white ) old new)
428
+ (collapse :collect old
429
+ (if (eq mode :white )
430
+ (list* c #\Space new)
431
+ (cons c new)))))
432
+ (concatenate ' string (nreverse new)))))
443
433
(declare (dynamic-extent #' collapse))
444
434
(collapse :start (coerce string ' list) nil )))
445
435
You can’t perform that action at this time.
0 commit comments