Hash :
c504f823
Author :
Thomas de Grivel
Date :
2017-06-21T11:39:20
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78
;;
;; RoL-uri - URL and URI utilities
;;
;; Copyright 2012-2015 Thomas de Grivel <thomas@lowh.net>
;;
;; Permission to use, copy, modify, and distribute this software for any
;; purpose with or without fee is hereby granted, provided that the above
;; copyright notice and this permission notice appear in all copies.
;;
;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
;; WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
;; MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
;; ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
;; WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
;; ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
;; OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
;;
;; pstr
(defstruct pstr
(str "" :type string :read-only t)
(pos 0 :type positive-fixnum))
(defmacro with-pstr ((str pos) x &body body)
(let ((g!pstr (gensym "PSTR-")))
`(let ((,g!pstr ,x))
(let ((,str (pstr-str ,g!pstr))
(,pos (pstr-pos ,g!pstr)))
,@body))))
(defun pstr-copy (x)
(declare (type pstr x))
(make-pstr :str (pstr-str x) :pos (pstr-pos x)))
(defun pstr-eat-n (x n)
(declare (type pstr x)
(type positive-fixnum n))
(when (< (length (pstr-str x)) (+ (pstr-pos x) n))
(error "pstr-eat-n past end of string"))
(incf (pstr-pos x) n)
x)
(defun pstr-peek (x &optional (n 0))
(with-pstr (s p) x
(let ((i (+ p n)))
(when (< i (length s))
(char s i)))))
(defun pstr-eat-char (x char)
(when (char= char (pstr-peek x))
(pstr-eat-n x 1)
char))
(defun pstr-eat-string (x string)
(with-pstr (s p) x
(let* ((len (length string))
(e (+ p len)))
(when (and (<= e (length s))
(string= s string :start1 p :end1 e))
(pstr-eat-n x len)
string))))
(define-constant +hexdigits+ "0123456789ABCDEFabcdef"
:test 'string=)
(defun pstr-eat-pct-encoded (x)
(when (and (char= #\% (pstr-peek x))
(find (pstr-peek x 1) +hexdigits+)
(find (pstr-peek x 2) +hexdigits+))
(with-pstr (s p) x
(prog1 (parse-integer s :start p :end (+ 2 p) :radix 16)
(pstr-eat-n x 3)))))
(defun pstr-eat-if (n fn x)
(when-let ((r (funcall fn (pstr-peek x))))
(pstr-eat x n)
r))