diff --git a/coleslaw.asd b/coleslaw.asd index fe13837..24d224d 100644 --- a/coleslaw.asd +++ b/coleslaw.asd @@ -13,7 +13,8 @@ :inferior-shell :cl-fad :cl-ppcre - :closer-mop) + :closer-mop + :cl-unicode) :serial t :components ((:file "packages") (:file "util") diff --git a/src/content.lisp b/src/content.lisp index a19be2d..1c301f6 100644 --- a/src/content.lisp +++ b/src/content.lisp @@ -20,18 +20,25 @@ "Test if the slugs for tag A and B are equal." (string= (tag-slug a) (tag-slug b))) -;; Slugs +; Slugs -(defun slug-char-p (char) +(defun slug-char-p (char &key (allowed-chars (list #\- #\Space #\~))) "Determine if CHAR is a valid slug (i.e. URL) character." - (or (char<= #\0 char #\9) - (char<= #\a char #\z) - (char<= #\A char #\Z) - (member char '(#\_ #\-)))) + ; use the first char of the general unicode category as kind of + ; hyper general category + (let ((cat (char (cl-unicode:general-category char) 0)) + (allowed-cats (list #\L #\N))) + (cond + ((member cat allowed-cats) 't) + ((member char allowed-chars) 't) + (t 'nil)))) + +(defun unicode-space-p (char) + (equal (char (cl-unicode:general-category char) 0) #\Z)) (defun slugify (string) "Return a version of STRING suitable for use as a URL." - (remove-if-not #'slug-char-p (substitute #\- #\Space string))) + (remove-if-not #'slug-char-p (substitute-if #\- #'unicode-space-p string))) ;; Content Types