浏览代码

made slugs unicode-safe like
used mozilla's slugify implementation as reference:
https://github.com/mozilla/unicode-slugify/blob/master/slugify/__init__.py

lukasepple 10 年之前
父节点
当前提交
fbacd3b81f
共有 2 个文件被更改,包括 16 次插入8 次删除
  1. 2 1
      coleslaw.asd
  2. 14 7
      src/content.lisp

+ 2 - 1
coleslaw.asd

@@ -13,7 +13,8 @@
13 13
                :inferior-shell
14 14
                :cl-fad
15 15
                :cl-ppcre
16
-               :closer-mop)
16
+               :closer-mop
17
+			   :cl-unicode)
17 18
   :serial t
18 19
   :components ((:file "packages")
19 20
                (:file "util")

+ 14 - 7
src/content.lisp

@@ -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