|
@@ -22,16 +22,24 @@
|
22
|
22
|
|
23
|
23
|
;; Slugs
|
24
|
24
|
|
25
|
|
-(defun slug-char-p (char)
|
|
25
|
+(defun slug-char-p (char &key (allowed-chars (list #\- #\~)))
|
26
|
26
|
"Determine if CHAR is a valid slug (i.e. URL) character."
|
27
|
|
- (or (char<= #\0 char #\9)
|
28
|
|
- (char<= #\a char #\z)
|
29
|
|
- (char<= #\A char #\Z)
|
30
|
|
- (member char '(#\_ #\-))))
|
|
27
|
+ ; use the first char of the general unicode category as kind of
|
|
28
|
+ ; hyper general category
|
|
29
|
+ (let ((cat (aref (cl-unicode:general-category char) 0))
|
|
30
|
+ (allowed-cats (list #\L #\N))) ; allowed Unicode categories in URLs
|
|
31
|
+ (cond
|
|
32
|
+ ((member cat allowed-cats) t)
|
|
33
|
+ ((member char allowed-chars) t)
|
|
34
|
+ (t nil))))
|
|
35
|
+
|
|
36
|
+(defun unicode-space-p (char)
|
|
37
|
+ "Determine if CHAR is a kind of whitespace by unicode category means"
|
|
38
|
+ (char= (aref (cl-unicode:general-category char) 0) #\Z))
|
31
|
39
|
|
32
|
40
|
(defun slugify (string)
|
33
|
41
|
"Return a version of STRING suitable for use as a URL."
|
34
|
|
- (remove-if-not #'slug-char-p (substitute #\- #\Space string)))
|
|
42
|
+ (remove-if-not #'slug-char-p (substitute-if #\- #'unicode-space-p string)))
|
35
|
43
|
|
36
|
44
|
;; Content Types
|
37
|
45
|
|