The Lambda Lab
/
projects
/
scratchy.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Query serving error report improvement.
[scratchy.git]
/
burrower.scm
diff --git
a/burrower.scm
b/burrower.scm
index
867a289
..
581ea9c
100644
(file)
--- a/
burrower.scm
+++ b/
burrower.scm
@@
-82,7
+82,7
@@
((or (= (string-length l) 0) (string-suffix? "/" l)) 1)
((has-suffix? l ".txt" ".org" ".md") 0)
((has-suffix? l ".png" ".jpg" ".gif" ".bmp" ".tif" ".tga") 'I)
((or (= (string-length l) 0) (string-suffix? "/" l)) 1)
((has-suffix? l ".txt" ".org" ".md") 0)
((has-suffix? l ".png" ".jpg" ".gif" ".bmp" ".tif" ".tga") 'I)
- ((has-suffix? l "?") 7)
+ ((has-suffix? l "?
.scm
") 7)
(else 9))))
(else 9))))
@@
-145,8
+145,7
@@
(error "File not found." file-name))))
(define (serve-query selector arguments remote-ip config)
(error "File not found." file-name))))
(define (serve-query selector arguments remote-ip config)
- (let ((file-name (make-pathname (config-root-dir config)
- (conc (string-chomp selector "?") ".scm"))))
+ (let ((file-name (make-pathname (config-root-dir config) selector)))
(if (and (regular-file? file-name)
(= (length arguments) 1))
(with-input-from-file file-name
(if (and (regular-file? file-name)
(= (length arguments) 1))
(with-input-from-file file-name
@@
-157,7
+156,7
@@
(lambda ()
(apply (eval (read))
(list (car arguments) remote-ip)))))))
(lambda ()
(apply (eval (read))
(list (car arguments) remote-ip)))))))
- (error "Invalid query."))))
+ (error "Invalid query."
selector arguments
))))
;;; Index rendering
;;; Index rendering
@@
-203,7
+202,10
@@
dir-selector config
(lambda ()
(let-values (((in-port out-port id) (process command)))
dir-selector config
(lambda ()
(let-values (((in-port out-port id) (process command)))
- (serve-info-records (string-chomp (read-string #f in-port) "\n"))))))
+ (let ((string (read-string #f in-port)))
+ (if (and (not (eof-object? string))
+ (> (string-length string) 0))
+ (serve-info-records (string-chomp string "\n"))))))))
(define (serve-expression expression dir-selector config)
(with-selector-dir
(define (serve-expression expression dir-selector config)
(with-selector-dir
@@
-217,10
+219,15
@@
(define (with-current-working-directory directory thunk)
(let ((old-wd (current-directory))
(result 'none))
(define (with-current-working-directory directory thunk)
(let ((old-wd (current-directory))
(result 'none))
- (change-directory directory)
- (set! result (thunk))
- (change-directory old-wd)
- result))
+ (condition-case
+ (begin
+ (change-directory directory)
+ (set! result (thunk))
+ (change-directory old-wd)
+ result)
+ (o (exn)
+ (change-directory old-wd)
+ (signal o)))))
(define (with-selector-dir selector config thunk)
(with-current-working-directory
(define (with-selector-dir selector config thunk)
(with-current-working-directory