|
@@ -20,18 +20,25 @@
|
20
|
20
|
"Test if the slugs for tag A and B are equal."
|
21
|
21
|
(string= (tag-slug a) (tag-slug b)))
|
22
|
22
|
|
23
|
|
-;; Slugs
|
|
23
|
+; Slugs
|
24
|
24
|
|
25
|
|
-(defun slug-char-p (char)
|
|
25
|
+(defun slug-char-p (char &key (allowed-chars (list #\- #\Space #\~)))
|
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 (char (cl-unicode:general-category char) 0))
|
|
30
|
+ (allowed-cats (list #\L #\N)))
|
|
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
|
+ (equal (char (cl-unicode:general-category char) 0) #\Z))
|
31
|
38
|
|
32
|
39
|
(defun slugify (string)
|
33
|
40
|
"Return a version of STRING suitable for use as a URL."
|
34
|
|
- (remove-if-not #'slug-char-p (substitute #\- #\Space string)))
|
|
41
|
+ (remove-if-not #'slug-char-p (substitute-if #\- #'unicode-space-p string)))
|
35
|
42
|
|
36
|
43
|
;; Content Types
|
37
|
44
|
|