|
|
|
|
24
|
|
24
|
|
25
|
(defun slug-char-p (char &key (allowed-chars (list #\- #\~)))
|
25
|
(defun slug-char-p (char &key (allowed-chars (list #\- #\~)))
|
26
|
"Determine if CHAR is a valid slug (i.e. URL) character."
|
26
|
"Determine if CHAR is a valid slug (i.e. URL) character."
|
27
|
- ; use the first char of the general unicode category as kind of
|
|
|
28
|
- ; hyper general category
|
|
|
|
|
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))
|
29
|
(let ((cat (char (cl-unicode:general-category char) 0))
|
30
|
(allowed-cats (list #\L #\N))) ; allowed Unicode categories in URLs
|
30
|
(allowed-cats (list #\L #\N))) ; allowed Unicode categories in URLs
|
31
|
(cond
|
31
|
(cond
|
|
|
|
|
39
|
|
39
|
|
40
|
(defun slugify (string)
|
40
|
(defun slugify (string)
|
41
|
"Return a version of STRING suitable for use as a URL."
|
41
|
"Return a version of STRING suitable for use as a URL."
|
42
|
- (let ((slugified (remove-if-not #'slug-char-p
|
|
|
|
|
42
|
+ (let ((slugified (remove-if-not #'slug-char-p
|
43
|
(substitute-if #\- #'unicode-space-p string))))
|
43
|
(substitute-if #\- #'unicode-space-p string))))
|
44
|
(if (zerop (length slugified))
|
44
|
(if (zerop (length slugified))
|
45
|
- (error "Post title '~a' does not contain characters suitable for a slug!" string
|
|
|
46
|
- slugified)))
|
|
|
|
|
45
|
+ (error "Post title '~a' does not contain characters suitable for a slug!" string )
|
|
|
46
|
+ slugified)))
|
47
|
|
47
|
|
48
|
;; Content Types
|
48
|
;; Content Types
|
49
|
|
49
|
|