commit
b272c7880b
2 changed files with 16 additions and 7 deletions
|
@ -13,7 +13,8 @@
|
||||||
:inferior-shell
|
:inferior-shell
|
||||||
:cl-fad
|
:cl-fad
|
||||||
:cl-ppcre
|
:cl-ppcre
|
||||||
:closer-mop)
|
:closer-mop
|
||||||
|
:cl-unicode)
|
||||||
:serial t
|
:serial t
|
||||||
:components ((:file "packages")
|
:components ((:file "packages")
|
||||||
(:file "util")
|
(:file "util")
|
||||||
|
|
|
@ -22,16 +22,24 @@
|
||||||
|
|
||||||
;; Slugs
|
;; Slugs
|
||||||
|
|
||||||
(defun slug-char-p (char)
|
(defun slug-char-p (char &key (allowed-chars (list #\- #\~)))
|
||||||
"Determine if CHAR is a valid slug (i.e. URL) character."
|
"Determine if CHAR is a valid slug (i.e. URL) character."
|
||||||
(or (char<= #\0 char #\9)
|
; use the first char of the general unicode category as kind of
|
||||||
(char<= #\a char #\z)
|
; hyper general category
|
||||||
(char<= #\A char #\Z)
|
(let ((cat (aref (cl-unicode:general-category char) 0))
|
||||||
(member char '(#\_ #\-))))
|
(allowed-cats (list #\L #\N))) ; allowed Unicode categories in URLs
|
||||||
|
(cond
|
||||||
|
((member cat allowed-cats) t)
|
||||||
|
((member char allowed-chars) t)
|
||||||
|
(t nil))))
|
||||||
|
|
||||||
|
(defun unicode-space-p (char)
|
||||||
|
"Determine if CHAR is a kind of whitespace by unicode category means"
|
||||||
|
(char= (aref (cl-unicode:general-category char) 0) #\Z))
|
||||||
|
|
||||||
(defun slugify (string)
|
(defun slugify (string)
|
||||||
"Return a version of STRING suitable for use as a URL."
|
"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
|
;; Content Types
|
||||||
|
|
||||||
|
|
Loading…
Add table
Reference in a new issue