Import Debian changes 3a2-1debian/3a2-1

slib (3a2-1) unstable; urgency=low

  * New upstream release.
  * Acknowledge NMU. (Closes: #281809)
  * Makefile: Don't hack Makefile; use rules instead.
  * debian/rules: Set on make invocations: prefix, htmldir, TEXI2HTML.
  * debian/rules (clean): Clean more stuff here.
  * Makefile: Comment out old rule for $(htmldir)slib_toc.html.  Instead,
    specify directly that the texi2html invocation produces that file.
  * debian/rules (binary-indep): Find web files in slib subdir.
  
  * debian/control (Build-Depends-Indep): Go back to using scm.

1 files changed, 73 insertions, 90 deletions

diff --git a/psxtime.scm b/psxtime.scm
index 753e81f..fed0707 100644
--- a/psxtime.scm
+++ b/psxtime.scm
@@ -19,106 +19,32 @@
 
 ;;; No, it doesn't do leap seconds.
 
+(require 'time-core)
 (require-if 'compiling 'time-zone)
-
-(define time:days/month
-  '#(#(31 28 31 30 31 30 31 31 30 31 30 31) ; Normal years.
-     #(31 29 31 30 31 30 31 31 30 31 30 31)))
-(define (leap-year? year)
-  (and (zero? (remainder year 4))
-       (or (not (zero? (remainder year 100)))
-	   (zero? (remainder year 400))))) ; Leap years.
-
-;;; Returns the `struct tm' representation of T,
-;;; offset TM_GMTOFF seconds east of UCT.
-(define (time:split t tm_isdst tm_gmtoff tm_zone)
-  (set! t (difftime t tm_gmtoff))
-  (let* ((secs (modulo t 86400))	; SECS/DAY
-	 (days (+ (quotient t 86400)	; SECS/DAY
-		  (if (and (negative? t) (positive? secs)) -1 0))))
-    (let ((tm_hour (quotient secs 3600))
-	  (secs (remainder secs 3600))
-	  (tm_wday (modulo (+ 4 days) 7))) ; January 1, 1970 was a Thursday.
-      (let loop ((tm_year 1970)
-		 (tm_yday days))
-	(let ((diy (if (leap-year? tm_year) 366 365)))
-	  (cond
-	   ((negative? tm_yday) (loop (+ -1 tm_year) (+ tm_yday diy)))
-	   ((>= tm_yday diy) (loop (+ 1 tm_year) (- tm_yday diy)))
-	   (else
-	    (let* ((mv (vector-ref time:days/month (- diy 365))))
-	      (do ((tm_mon 0 (+ 1 tm_mon))
-		   (tm_mday tm_yday (- tm_mday (vector-ref mv tm_mon))))
-		  ((< tm_mday (vector-ref mv tm_mon))
-		   (vector
-		    (remainder secs 60) ; Seconds.	[0-61] (2 leap seconds)
-		    (quotient secs 60)	; Minutes.	[0-59]
-		    tm_hour		; Hours.	[0-23]
-		    (+ tm_mday 1)	; Day.		[1-31]
-		    tm_mon		; Month.	[0-11]
-		    (- tm_year 1900)	; Year	- 1900.
-		    tm_wday		; Day of week.	[0-6]
-		    tm_yday		; Days in year. [0-365]
-		    tm_isdst		; DST.		[-1/0/1]
-		    tm_gmtoff		; Seconds west of UTC.
-		    tm_zone		; Timezone abbreviation.
-		    )))))))))))
 ;@
-(define (gmtime t)
-  (time:split t 0 0 "GMT"))
+(define (tz:std-offset zone)
+  (case (vector-ref zone 0)
+    ((tz:fixed) (vector-ref zone 3))
+    ((tz:rule) (vector-ref zone 4))
+    ((tz:file)
+     (let ((mode-table (vector-ref zone 2)))
+       (do ((type-idx 0 (+ 1 type-idx)))
+	   ((or (>= type-idx (vector-length mode-table))
+		(not (vector-ref (vector-ref mode-table type-idx) 2)))
+	    (if (>= type-idx (vector-length mode-table))
+		(vector-ref (vector-ref mode-table 0) 1)
+		(- (vector-ref (vector-ref mode-table type-idx) 1)))))))
+    (else (slib:error 'tz:std-offset "unknown timezone type" zone))))
 ;@
 (define (localtime caltime . tz)
   (require 'time-zone)
   (set! tz (if (null? tz) (tzset) (car tz)))
   (apply time:split caltime (tz:params caltime tz)))
-
-(define time:year-70
-  (let* ((t (current-time)))
-    (offset-time (offset-time t (- (difftime t 0))) (* -70 32140800))))
-
-(define (time:invert decoder target)
-  (let* ((times '#(1 60 3600 86400 2678400 32140800))
-	 (trough			; rough time for target
-	  (do ((i 5 (+ i -1))
-	       (trough time:year-70
-		       (offset-time trough (* (vector-ref target i)
-					      (vector-ref times i)))))
-	      ((negative? i) trough))))
-;;;    (print 'trough trough 'target target)
-    (let loop ((guess trough)
-	       (j 0)
-	       (guess-tm (decoder trough)))
-;;;      (print 'guess guess 'guess-tm guess-tm)
-      (do ((i 5 (+ i -1))
-	   (rough time:year-70
-		  (offset-time rough (* (vector-ref guess-tm i)
-					(vector-ref times i))))
-	   (sign (let ((d (- (vector-ref target 5)
-			     (vector-ref guess-tm 5))))
-		   (and (not (zero? d)) d))
-		 (or sign
-		     (let ((d (- (vector-ref target i)
-				 (vector-ref guess-tm i))))
-		       (and (not (zero? d)) d)))))
-	  ((negative? i)
-	   (let* ((distance (abs (- trough rough))))
-	     (cond ((and (zero? distance) sign)
-;;;		    (print "trying to jump")
-		    (set! distance (if (negative? sign) -86400 86400)))
-		   ((and sign (negative? sign)) (set! distance (- distance))))
-	     (set! guess (offset-time guess distance))
-;;;	     (print 'distance distance 'sign sign)
-	     (cond ((zero? distance) guess)
-		   ((> j 5) #f)		;to prevent inf loops.
-		   (else
-		    (loop guess
-			  (+ 1 j)
-			  (decoder guess))))))))))
 ;@
 (define (mktime univtime . tz)
   (require 'time-zone)
   (set! tz (if (null? tz) (tzset) (car tz)))
-  (+ (gmktime univtime) (tz:std-offset tz)))
+  (offset-time (gmktime univtime) (tz:std-offset tz)))
 ;@
 (define (gmktime univtime)
   (time:invert time:gmtime univtime))
@@ -150,8 +76,65 @@
   (time:asctime (time:gmtime time)))
 
 ;;;	GMT				Local -- take optional 2nd TZ arg
-(define time:gmtime gmtime)	(define time:localtime localtime)
+;;@
+(define gmtime time:gmtime)
+
+(define time:localtime localtime)
 ;;(define time:gmktime gmktime)	(define time:mktime mktime)
 ;;(define time:gtime gtime)	(define time:ctime ctime)
 
 (define time:asctime asctime)
+
+;@
+(define daylight? #f)
+(define *timezone* 0)
+(define tzname '#("UTC" "???"))
+
+(define tz:default #f)
+
+;;;@ Interpret the TZ envariable.
+(define (tzset . opt-tz)
+  (define tz (if (null? opt-tz)
+		 (getenv "TZ")
+		 (car opt-tz)))
+  (if (or (not tz:default)
+	  (and (string? tz) (not (string-ci=? tz (vector-ref tz:default 1)))))
+      (let ()
+	(require 'time-zone)
+	(set! tz:default (or (time-zone tz) '#(tz:fixed "UTC" "GMT" 0)))))
+  (case (vector-ref tz:default 0)
+    ((tz:fixed)
+     (set! tzname (vector (vector-ref tz:default 2) "???"))
+     (set! daylight? #f)
+     (set! *timezone* (vector-ref tz:default 3)))
+    ((tz:rule)
+     (set! tzname (vector (vector-ref tz:default 2)
+			  (vector-ref tz:default 3)))
+     (set! daylight? #t)
+     (set! *timezone* (vector-ref tz:default 4)))
+    ((tz:file)
+     (let ((mode-table (vector-ref tz:default 2))
+	   (transition-types (vector-ref tz:default 5)))
+       (set! daylight? #f)
+       (set! *timezone* (vector-ref (vector-ref mode-table 0) 1))
+       (set! tzname (make-vector 2 #f))
+       (do ((type-idx 0 (+ 1 type-idx)))
+	   ((>= type-idx (vector-length mode-table)))
+	 (let ((rec (vector-ref mode-table type-idx)))
+	   (if (vector-ref rec 2)
+	       (set! daylight? #t)
+	       (set! *timezone* (- (vector-ref rec 1))))))
+
+       (do ((transition-idx (+ -1 (vector-length transition-types))
+			    (+ -1 transition-idx)))
+	   ((or (negative? transition-idx)
+		(and (vector-ref tzname 0) (vector-ref tzname 1))))
+	 (let ((rec (vector-ref mode-table
+				(vector-ref transition-types transition-idx))))
+	   (if (vector-ref rec 2)
+	       (if (not (vector-ref tzname 1))
+		   (vector-set! tzname 1 (vector-ref rec 0)))
+	       (if (not (vector-ref tzname 0))
+		   (vector-set! tzname 0 (vector-ref rec 0))))))))
+    (else (slib:error 'tzset "unknown timezone type" tz)))
+  tz:default)