[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.6-107-gc04c1
From: |
Ludovic Courtès |
Subject: |
[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.6-107-gc04c118 |
Date: |
Tue, 27 Nov 2012 23:08:00 +0000 |
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".
http://git.savannah.gnu.org/cgit/guile.git/commit/?id=c04c11846127d481afc56a1d4e7f657460cd4f21
The branch, stable-2.0 has been updated
via c04c11846127d481afc56a1d4e7f657460cd4f21 (commit)
via 4e81e9d9a37ee958bf4b9a636a8f106f1241f1ce (commit)
from 261af76005f0e31f570bed201a2ef2a43cdd6e11 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit c04c11846127d481afc56a1d4e7f657460cd4f21
Author: Ludovic Courtès <address@hidden>
Date: Tue Nov 27 23:02:15 2012 +0100
vlist: Remove Texinfo markup from docstrings.
* module/ice-9/vlist.scm: Remove Texinfo markup from docstrings with
sed -e"s/@var{\([a-z0-9?!-]\+\)}/\U\1/g ; s/@code{\([^}]\+\)}/â\1â/g".
commit 4e81e9d9a37ee958bf4b9a636a8f106f1241f1ce
Author: Daniel Hartwig <address@hidden>
Date: Tue Nov 27 16:48:41 2012 +0800
web client: correctly handle uri-query, etc. in relative URI headers
* module/web/uri.scm (uri-pat): Make scheme part optional.
(string->uri*): New private procedure to also parse relative URIs.
* module/web/http.scm (declare-relative-uri-header!): Use that.
-----------------------------------------------------------------------
Summary of changes:
module/ice-9/vlist.scm | 94 ++++++++++++++++++++++++------------------------
module/web/http.scm | 12 ++-----
module/web/uri.scm | 30 ++++++++++-----
3 files changed, 70 insertions(+), 66 deletions(-)
diff --git a/module/ice-9/vlist.scm b/module/ice-9/vlist.scm
index a09b374..0c0906c 100644
--- a/module/ice-9/vlist.scm
+++ b/module/ice-9/vlist.scm
@@ -208,7 +208,7 @@
(make-vlist base 0))))))
(define (vlist-cons item vlist)
- "Return a new vlist with @var{item} as its head and @var{vlist} as its
+ "Return a new vlist with ITEM as its head and VLIST as its
tail."
;; Note: Although the result of `vlist-cons' on a vhash is a valid
;; vlist, it is not a valid vhash. The new item does not get a hash
@@ -219,14 +219,14 @@ tail."
(block-cons item vlist #f))
(define (vlist-head vlist)
- "Return the head of @var{vlist}."
+ "Return the head of VLIST."
(assert-vlist vlist)
(let ((base (vlist-base vlist))
(offset (vlist-offset vlist)))
(block-ref (block-content base) offset)))
(define (vlist-tail vlist)
- "Return the tail of @var{vlist}."
+ "Return the tail of VLIST."
(assert-vlist vlist)
(let ((base (vlist-base vlist))
(offset (vlist-offset vlist)))
@@ -236,7 +236,7 @@ tail."
(block-offset base)))))
(define (vlist-null? vlist)
- "Return true if @var{vlist} is empty."
+ "Return true if VLIST is empty."
(assert-vlist vlist)
(let ((base (vlist-base vlist)))
(and (not (block-base base))
@@ -248,11 +248,11 @@ tail."
;;;
(define (list->vlist lst)
- "Return a new vlist whose contents correspond to @var{lst}."
+ "Return a new vlist whose contents correspond to LST."
(vlist-reverse (fold vlist-cons vlist-null lst)))
(define (vlist-fold proc init vlist)
- "Fold over @var{vlist}, calling @var{proc} for each element."
+ "Fold over VLIST, calling PROC for each element."
;; FIXME: Handle multiple lists.
(assert-vlist vlist)
(let loop ((base (vlist-base vlist))
@@ -267,7 +267,7 @@ tail."
(proc (block-ref (block-content base) offset) result))))))
(define (vlist-fold-right proc init vlist)
- "Fold over @var{vlist}, calling @var{proc} for each element, starting from
+ "Fold over VLIST, calling PROC for each element, starting from
the last element."
(assert-vlist vlist)
(let loop ((index (1- (vlist-length vlist)))
@@ -278,23 +278,23 @@ the last element."
(proc (vlist-ref vlist index) result)))))
(define (vlist-reverse vlist)
- "Return a new @var{vlist} whose content are those of @var{vlist} in reverse
+ "Return a new VLIST whose content are those of VLIST in reverse
order."
(vlist-fold vlist-cons vlist-null vlist))
(define (vlist-map proc vlist)
- "Map @var{proc} over the elements of @var{vlist} and return a new vlist."
+ "Map PROC over the elements of VLIST and return a new vlist."
(vlist-fold (lambda (item result)
(vlist-cons (proc item) result))
vlist-null
(vlist-reverse vlist)))
(define (vlist->list vlist)
- "Return a new list whose contents match those of @var{vlist}."
+ "Return a new list whose contents match those of VLIST."
(vlist-fold-right cons '() vlist))
(define (vlist-ref vlist index)
- "Return the element at index @var{index} in @var{vlist}."
+ "Return the element at index INDEX in VLIST."
(assert-vlist vlist)
(let loop ((index index)
(base (vlist-base vlist))
@@ -306,8 +306,8 @@ order."
(block-offset base)))))
(define (vlist-drop vlist count)
- "Return a new vlist that does not contain the @var{count} first elements of
address@hidden"
+ "Return a new vlist that does not contain the COUNT first elements of
+VLIST."
(assert-vlist vlist)
(let loop ((count count)
(base (vlist-base vlist))
@@ -319,8 +319,8 @@ order."
(block-offset base)))))
(define (vlist-take vlist count)
- "Return a new vlist that contains only the @var{count} first elements of
address@hidden"
+ "Return a new vlist that contains only the COUNT first elements of
+VLIST."
(let loop ((count count)
(vlist vlist)
(result vlist-null))
@@ -331,8 +331,8 @@ order."
(vlist-cons (vlist-head vlist) result)))))
(define (vlist-filter pred vlist)
- "Return a new vlist containing all the elements from @var{vlist} that
-satisfy @var{pred}."
+ "Return a new vlist containing all the elements from VLIST that
+satisfy PRED."
(vlist-fold-right (lambda (e v)
(if (pred e)
(vlist-cons e v)
@@ -341,14 +341,14 @@ satisfy @var{pred}."
vlist))
(define* (vlist-delete x vlist #:optional (equal? equal?))
- "Return a new vlist corresponding to @var{vlist} without the elements
address@hidden to @var{x}."
+ "Return a new vlist corresponding to VLIST without the elements
+EQUAL? to X."
(vlist-filter (lambda (e)
(not (equal? e x)))
vlist))
(define (vlist-length vlist)
- "Return the length of @var{vlist}."
+ "Return the length of VLIST."
(assert-vlist vlist)
(let loop ((base (vlist-base vlist))
(len (vlist-offset vlist)))
@@ -387,7 +387,7 @@ details."
vlists)))
(define (vlist-for-each proc vlist)
- "Call @var{proc} on each element of @var{vlist}. The result is unspecified."
+ "Call PROC on each element of VLIST. The result is unspecified."
(vlist-fold (lambda (item x)
(proc item))
(if #f #f)
@@ -442,13 +442,13 @@ details."
;; pass a hash function or equality predicate.
(define (vhash? obj)
- "Return true if @var{obj} is a hash list."
+ "Return true if OBJ is a hash list."
(and (vlist? obj)
(block-hash-table? (vlist-base obj))))
(define* (vhash-cons key value vhash #:optional (hash hash))
- "Return a new hash list based on @var{vhash} where @var{key} is associated
-with @var{value}. Use @var{hash} to compute @var{key}'s hash."
+ "Return a new hash list based on VHASH where KEY is associated
+with VALUE. Use HASH to compute KEY's hash."
(assert-vlist vhash)
;; We should also assert that it is a hash table. Need to check the
;; performance impacts of that. Also, vlist-null is a valid hash
@@ -493,18 +493,18 @@ with @var{value}. Use @var{hash} to compute @var{key}'s
hash."
(define* (vhash-fold* proc init key vhash
#:optional (equal? equal?) (hash hash))
- "Fold over all the values associated with @var{key} in @var{vhash}, with each
-call to @var{proc} having the form @code{(proc value result)}, where
address@hidden is the result of the previous call to @var{proc} and @var{init}
the
-value of @var{result} for the first call to @var{proc}."
+ "Fold over all the values associated with KEY in VHASH, with each
+call to PROC having the form â(proc value result)â, where
+RESULT is the result of the previous call to PROC and INIT the
+value of RESULT for the first call to PROC."
(%vhash-fold* proc init key vhash equal? hash))
(define (vhash-foldq* proc init key vhash)
- "Same as @code{vhash-fold*}, but using @code{hashq} and @code{eq?}."
+ "Same as âvhash-fold*â, but using âhashqâ and âeq?â."
(%vhash-fold* proc init key vhash eq? hashq))
(define (vhash-foldv* proc init key vhash)
- "Same as @code{vhash-fold*}, but using @code{hashv} and @code{eqv?}."
+ "Same as âvhash-fold*â, but using âhashvâ and âeqv?â."
(%vhash-fold* proc init key vhash eqv? hashv))
(define-inlinable (%vhash-assoc key vhash equal? hash)
@@ -532,23 +532,23 @@ value of @var{result} for the first call to @var{proc}."
(vlist-offset vhash))))
(define* (vhash-assoc key vhash #:optional (equal? equal?) (hash hash))
- "Return the first key/value pair from @var{vhash} whose key is equal to
address@hidden according to the @var{equal?} equality predicate."
+ "Return the first key/value pair from VHASH whose key is equal to
+KEY according to the EQUAL? equality predicate."
(%vhash-assoc key vhash equal? hash))
(define (vhash-assq key vhash)
- "Return the first key/value pair from @var{vhash} whose key is @code{eq?} to
address@hidden"
+ "Return the first key/value pair from VHASH whose key is âeq?â to
+KEY."
(%vhash-assoc key vhash eq? hashq))
(define (vhash-assv key vhash)
- "Return the first key/value pair from @var{vhash} whose key is @code{eqv?} to
address@hidden"
+ "Return the first key/value pair from VHASH whose key is âeqv?â to
+KEY."
(%vhash-assoc key vhash eqv? hashv))
(define* (vhash-delete key vhash #:optional (equal? equal?) (hash hash))
- "Remove all associations from @var{vhash} with @var{key}, comparing keys
-with @var{equal?}."
+ "Remove all associations from VHASH with KEY, comparing keys
+with EQUAL?."
(if (vhash-assoc key vhash equal? hash)
(vlist-fold (lambda (k+v result)
(let ((k (car k+v))
@@ -564,10 +564,10 @@ with @var{equal?}."
(define vhash-delv (cut vhash-delete <> <> eqv? hashv))
(define (vhash-fold proc init vhash)
- "Fold over the key/pair elements of @var{vhash} from left to right, with
-each call to @var{proc} having the form @code{(@var{proc} key value result)},
-where @var{result} is the result of the previous call to @var{proc} and
address@hidden the value of @var{result} for the first call to @var{proc}."
+ "Fold over the key/pair elements of VHASH from left to right, with
+each call to PROC having the form â(PROC key value result)â,
+where RESULT is the result of the previous call to PROC and
+INIT the value of RESULT for the first call to PROC."
(vlist-fold (lambda (key+value result)
(proc (car key+value) (cdr key+value)
result))
@@ -575,10 +575,10 @@ where @var{result} is the result of the previous call to
@var{proc} and
vhash))
(define (vhash-fold-right proc init vhash)
- "Fold over the key/pair elements of @var{vhash} from right to left, with
-each call to @var{proc} having the form @code{(@var{proc} key value result)},
-where @var{result} is the result of the previous call to @var{proc} and
address@hidden the value of @var{result} for the first call to @var{proc}."
+ "Fold over the key/pair elements of VHASH from right to left, with
+each call to PROC having the form â(PROC key value result)â,
+where RESULT is the result of the previous call to PROC and
+INIT the value of RESULT for the first call to PROC."
(vlist-fold-right (lambda (key+value result)
(proc (car key+value) (cdr key+value)
result))
@@ -586,7 +586,7 @@ where @var{result} is the result of the previous call to
@var{proc} and
vhash))
(define* (alist->vhash alist #:optional (hash hash))
- "Return the vhash corresponding to @var{alist}, an association list."
+ "Return the vhash corresponding to ALIST, an association list."
(fold-right (lambda (pair result)
(vhash-cons (car pair) (cdr pair) result hash))
vlist-null
diff --git a/module/web/http.scm b/module/web/http.scm
index f8dba30..216fddd 100644
--- a/module/web/http.scm
+++ b/module/web/http.scm
@@ -1182,21 +1182,15 @@ treated specially, and is just returned as a plain
string."
(define (declare-uri-header! name)
(declare-header! name
(lambda (str) (or (string->uri str) (bad-header-component 'uri str)))
- uri?
+ (@@ (web uri) absolute-uri?)
write-uri))
;; emacs: (put 'declare-relative-uri-header! 'scheme-indent-function 1)
(define (declare-relative-uri-header! name)
(declare-header! name
(lambda (str)
- ;; XXX: Attempt to build an absolute URI, and fall back to a URI
- ;; with no scheme to represent a relative URI.
- ;; See <http://bugs.gnu.org/12827> for ideas to fully support
- ;; relative URIs (aka. "URI references").
- (or (string->uri str) ; absolute URI
- (build-uri #f ; relative URI
- #:path str
- #:validate? #f)))
+ (or ((@@ (web uri) string->uri*) str)
+ (bad-header-component 'uri str)))
uri?
write-uri))
diff --git a/module/web/uri.scm b/module/web/uri.scm
index 6ff0076..b688ea8 100644
--- a/module/web/uri.scm
+++ b/module/web/uri.scm
@@ -53,6 +53,9 @@
(query uri-query)
(fragment uri-fragment))
+(define (absolute-uri? x)
+ (and (uri? x) (uri-scheme x) #t))
+
(define (uri-error message . args)
(throw 'uri-error message args))
@@ -165,21 +168,21 @@ is valid."
(define fragment-pat
".*")
(define uri-pat
- (format #f "^(~a):(//~a)?(~a)(\\?(~a))?(#(~a))?$"
+ (format #f "^((~a):)?(//~a)?(~a)(\\?(~a))?(#(~a))?$"
scheme-pat authority-pat path-pat query-pat fragment-pat))
(define uri-regexp
(make-regexp uri-pat))
-(define (string->uri string)
+(define (string->uri* string)
"Parse STRING into a URI object. Return â#fâ if the string
could not be parsed."
(% (let ((m (regexp-exec uri-regexp string)))
(if (not m) (abort))
- (let ((scheme (string->symbol
- (string-downcase (match:substring m 1))))
- (authority (match:substring m 2))
- (path (match:substring m 3))
- (query (match:substring m 5))
+ (let ((scheme (let ((str (match:substring m 2)))
+ (and str (string->symbol (string-downcase str)))))
+ (authority (match:substring m 3))
+ (path (match:substring m 4))
+ (query (match:substring m 6))
(fragment (match:substring m 7)))
(call-with-values
(lambda ()
@@ -191,6 +194,12 @@ could not be parsed."
(lambda (k)
#f)))
+(define (string->uri string)
+ "Parse STRING into a URI object. Return â#fâ if the string
+could not be parsed."
+ (let ((uri (string->uri* string)))
+ (and uri (uri-scheme uri) uri)))
+
(define *default-ports* (make-hash-table))
(define (declare-default-port! scheme port)
@@ -208,8 +217,7 @@ could not be parsed."
"Serialize URI to a string. If the URI has a port that is the
default port for its scheme, the port is not included in the
serialization."
- (let* ((scheme-str (string-append
- (symbol->string (uri-scheme uri)) ":"))
+ (let* ((scheme (uri-scheme uri))
(userinfo (uri-userinfo uri))
(host (uri-host uri))
(port (uri-port uri))
@@ -217,7 +225,9 @@ serialization."
(query (uri-query uri))
(fragment (uri-fragment uri)))
(string-append
- scheme-str
+ (if scheme
+ (string-append (symbol->string scheme) ":")
+ "")
(if host
(string-append "//"
(if userinfo (string-append userinfo "@")
hooks/post-receive
--
GNU Guile
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.6-107-gc04c118,
Ludovic Courtès <=