aliens/tekuti
1
0
Fork 0
Code Activity

remove with-backtrace definition; add date->timestamp

Browse source 
* tekuti/util.scm: Remove with-backtrace definition. Add date->timestamp
  definition.
This commit is contained in:
Andy Wingo 2010-11-13 18:58:36 +01:00
parent a8c28da20b
commit 5d85d1b7fe
1 changed files with 5 additions and 21 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

26
tekuti/util.scm
View file

@ -34,8 +34,8 @@
call-with-temp-file emailish? urlish? call-with-temp-file emailish? urlish?
date-increment date-comparator date-before? date-after? compose1 date-increment date-comparator date-before? date-after? compose1
rfc822-date->timestamp timestamp->rfc822-date timestamp->atom-date rfc822-date->timestamp timestamp->rfc822-date timestamp->atom-date
timestamp->date string-split/trimming date->timestamp timestamp->date string-split/trimming
list-intersperse with-backtrace with-time-debugging)) list-intersperse with-time-debugging))
(define (emailish? x) (define (emailish? x)
(match-bind "^([a-zA-Z0-9._+-]+)@([a-zA-Z0-9-]+\\.)+[a-zA-Z]+$" (match-bind "^([a-zA-Z0-9._+-]+)@([a-zA-Z0-9-]+\\.)+[a-zA-Z]+$"
@ -157,25 +157,6 @@
(if (null? l) (reverse dest) (if (null? l) (reverse dest)
(loop (cdr l) (cons (car l) (cons elem dest))))))) (loop (cdr l) (cons (car l) (cons elem dest)))))))
(define (with-backtrace* proc)
(let ((cep (current-error-port)))
(start-stack
'with-backtrace
(with-throw-handler
#t
proc
(lambda (k . args)
(newline cep)
(format cep "Throw to `~a', args: ~s\n" k args)
(display "Backtrace:\n" cep)
(display-backtrace (make-stack #t) cep)
(newline cep))))))
(define-syntax with-backtrace
(syntax-rules ()
((_ form0 forms ...)
(with-backtrace* (lambda () form0 forms ...)))))
(define (gettimeofday-diff prev) (define (gettimeofday-diff prev)
(let ((now (gettimeofday))) (let ((now (gettimeofday)))
(+ (- (car now) (car prev)) (+ (- (car now) (car prev))
@ -248,6 +229,9 @@
(define (timestamp->date timestamp) (define (timestamp->date timestamp)
(time-utc->date (make-time time-utc 0 timestamp) 0)) (time-utc->date (make-time time-utc 0 timestamp) 0))
(define (date->timestamp date)
(time-second (date->time-utc date)))
(define (timestamp->atom-date timestamp) (define (timestamp->atom-date timestamp)
(date->string (timestamp->date timestamp) (date->string (timestamp->date timestamp)
"~Y-~m-~dT~H:~M:~SZ")) "~Y-~m-~dT~H:~M:~SZ"))