Commit e29ad87280daabe779a53f6c47912de3632ac82a

Thomas de Grivel 2014-01-31T16:13:30

Move TO-URL from L>server.

diff --git a/package.lisp b/package.lisp
index 824abf9..85e57c2 100644
--- a/package.lisp
+++ b/package.lisp
@@ -25,6 +25,8 @@
    ;;  URI
    #:canonical-document-uri
    #:%-encode-char
+   #:to-url
+   #:unaccent
    ;;  URI Template
    #:uri-template
    #:uri-template-p
diff --git a/uri.lisp b/uri.lisp
index fe9125c..8d039b9 100644
--- a/uri.lisp
+++ b/uri.lisp
@@ -107,3 +107,33 @@
 
 #+test
 (%-encode "plop/%é%C3")
+
+(defun unaccent (c)
+  (or (cl-ppcre:register-groups-bind (name)
+	  ("(.*) WITH .*" (cl-unicode:unicode-name c))
+	(cl-unicode:character-named name))
+      c))
+
+(defun to-url (str)
+  (string-trim
+   "-"
+   (with-output-to-string (out)
+     (let ((len (length str)))
+       (labels ((out (c)
+		  (write-char (unaccent (char-downcase c)) out))
+		(nohyphen (i)
+		  (when (< i len)
+		    (let ((c (char str i)))
+		      (if (alphanumericp c)
+			  (progn (out c)
+				 (hyphen (1+ i)))
+			  (nohyphen (1+ i))))))
+		(hyphen (i)
+		  (when (< i len)
+		    (let ((c (char str i)))
+		      (if (alphanumericp c)
+			  (progn (out c)
+				 (hyphen (1+ i)))
+			  (progn (write-char #\- out)
+				 (nohyphen (1+ i))))))))
+	 (nohyphen 0))))))