[[project @ 1997-04-05 21:54:33 by ghouston]
ghouston**19970405215440
 Ignore-this: 608b814f7445fed697bf206831f34512
 * init.scm: load time.scm.  require 'format from slib.
 	* time.scm: copied from scsh and modified to use Guile primitives.
 	* rdelim.scm: uncomment read-paragraph.
 
 	* Makefile.am (subpkgdata_DATA): add re.scm.
 	* init.scm: load re.scm.
 	* re.scm: copied from scsh and modified to use Guile regular
 	expressions.
] addfile ./re.scm
addfile ./time.scm
hunk ./ChangeLog 1
+Sat Apr  5 06:44:32 1997  Gary Houston  <ghouston@actrix.gen.nz>
+
+	* init.scm: load time.scm.  require 'format from slib.
+
+Tue Apr  1 23:19:08 1997  Gary Houston  <ghouston@actrix.gen.nz>
+
+	* time.scm: copied from scsh and modified to use Guile primitives.
+
+Mon Mar 31 02:24:25 1997  Gary Houston  <ghouston@actrix.gen.nz>
+
+	* rdelim.scm: uncomment read-paragraph.
+
+	* Makefile.am (subpkgdata_DATA): add re.scm.
+	* init.scm: load re.scm.
+	* re.scm: copied from scsh and modified to use Guile regular
+	expressions.
+
hunk ./Makefile.am 8
-	network.scm rdelim.scm receive.scm \
+	network.scm rdelim.scm re.scm receive.scm \
hunk ./Makefile.in 51
-	network.scm rdelim.scm receive.scm \
+	network.scm rdelim.scm re.scm receive.scm \
hunk ./init.scm 30
+(require 'format)
hunk ./init.scm 46
+(load-from-path "scsh/re.scm")
hunk ./init.scm 48
+(load-from-path "scsh/time.scm")
hunk ./rdelim.scm 5
-;;; read-paragraph could be fixed.
hunk ./rdelim.scm 292
-;(define blank-line-regexp (make-regexp "^[ \t]*\n$"))
+(define blank-line-regexp (make-regexp "^[ \t]*\n$"))
hunk ./rdelim.scm 294
-;(define (read-paragraph . args)
-;  (let-optionals args ((port         (current-input-port))
-;		       (handle-delim 'trim))
-;    ;; First, skip all blank lines.
-;    (let lp ()
-;      (let ((line (read-line port 'concat)))
-;	(cond ((eof-object? line)
-;	       (if (eq? handle-delim 'split) (values line line) line))
+(define (read-paragraph . args)
+  (let-optionals args ((port         (current-input-port))
+		       (handle-delim 'trim))
+    ;; First, skip all blank lines.
+    (let lp ()
+      (let ((line (read-line port 'concat)))
+	(cond ((eof-object? line)
+	       (if (eq? handle-delim 'split) (values line line) line))
hunk ./rdelim.scm 303
-;	      ((regexp-exec blank-line-regexp line) (lp))
+	      ((regexp-exec blank-line-regexp line) (lp))
hunk ./rdelim.scm 305
-;	      ;; Then, read in non-blank lines.
-;	      (else
-;	       (let lp ((lines (list line)))
-;		 (let ((line (read-line port 'concat)))
-;		   (if (and (string? line)
-;			    (not (regexp-exec blank-line-regexp line)))
+	      ;; Then, read in non-blank lines.
+	      (else
+	       (let lp ((lines (list line)))
+		 (let ((line (read-line port 'concat)))
+		   (if (and (string? line)
+			    (not (regexp-exec blank-line-regexp line)))
hunk ./rdelim.scm 312
-;		       (lp (cons line lines))
+		       (lp (cons line lines))
hunk ./rdelim.scm 314
-;		       ;; Return the paragraph
-;		       (let ((->str (lambda (lns) (apply string-append (reverse lns)))))
-;			 (case handle-delim
-;			   ((trim) (->str lines))
+		       ;; Return the paragraph
+		       (let ((->str (lambda (lns) (apply string-append (reverse lns)))))
+			 (case handle-delim
+			   ((trim) (->str lines))
hunk ./rdelim.scm 319
-;			   ((concat)
-;			    (->str (if (eof-object? line) lines (cons line lines))))
+			   ((concat)
+			    (->str (if (eof-object? line) lines (cons line lines))))
hunk ./rdelim.scm 322
-;			   ((split)
-;			    (values (->str lines) line))
+			   ((split)
+			    (values (->str lines) line))
hunk ./rdelim.scm 325
-;			   (else (error "Illegal HANDLE-DELIM parameter to READ-PARAGRAPH")))))))))))))
+			   (else (error "Illegal HANDLE-DELIM parameter to READ-PARAGRAPH")))))))))))))
hunk ./re.scm 1
+;;; Regular expression matching for scsh
+;;; Copyright (c) 1994 by Olin Shivers.
+
+;;; Parts rewritten for Guile.
+
+(foreign-source
+  "/* Make sure foreign-function stubs interface to the C funs correctly: */"
+  "#include \"re1.h\""
+  "" ""
+  )
+
+;;; Match data for regexp matches.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define-record regexp-match
+  string	; The string against which we matched.
+  start		; 10 elt vec
+  end)		; 10 elt vec
+
+(define (match:start match . maybe-index)
+  (let ((i (:optional maybe-index 0)))
+    (or (vector-ref (regexp-match:start match) i)
+	(error match:start "No sub-match found." match i))))
+
+(define (match:end match . maybe-index)
+  (let ((i (:optional maybe-index 0)))
+    (or (vector-ref (regexp-match:end match) i)
+	(error match:start "No sub-match found." match i))))
+
+(define (match:substring match . maybe-index)
+  (let* ((i (:optional maybe-index 0))
+	 (start (vector-ref (regexp-match:start match) i)))
+    (if start
+	(substring (regexp-match:string match)
+		   start
+		   (vector-ref (regexp-match:end match) i))
+	(error match:substring "No sub-match found." match i))))
+
+
+;;; Compiling regexps
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;(define-record %regexp
+;  string	; The string form of the regexp.
+;  bytes		; The compiled representation, stuffed into a Scheme string.
+;  ((disclose self) (list "Regexp" (%regexp:string self))))
+
+;(define regexp? %regexp?)
+
+(define regexp? compiled-regexp?)
+
+;(define (make-regexp pattern)
+;  (receive (err len) (%regexp-compiled-length pattern)
+;    (if err (error err make-regexp pattern)
+;	(let ((buf (make-string len)))
+;	  (%regexp-compile pattern buf)
+;	  (make-%regexp pattern buf)))))
+
+(define (make-regexp pattern)
+  (regcomp pattern REG_EXTENDED))
+
+(define-foreign %regexp-compiled-length (re_byte_len (string pattern))
+  static-string	; Error msg or #f
+  integer)	; number of bytes needed to compile REGEXP.
+
+(define-foreign %regexp-compile (re_compile (string pattern)
+					    (string-desc bytes))
+  static-string) ; Error msg or #f
+
+
+;;; Executing compiled regexps
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define (regexp-exec regexp str . maybe-start)
+  (let* ((start (:optional maybe-start 0))
+	 (start-vec (make-vector 10 #f))
+	 (end-vec (make-vector 10 #f))
+	 (match (regexec regexp (make-shared-substring str start))))
+    (and match
+	 (let ((match-count (vector-length match)))
+	   (do ((i 0 (+ i 1)))
+	       ((= i match-count)
+		(make-regexp-match str start-vec end-vec))
+	     (vector-set! start-vec i (+ start (car (vector-ref match i))))
+	     (vector-set! end-vec i (+ start (cdr (vector-ref match i)))))))))
+
+(define-foreign %regexp-exec (re_exec (string-desc compiled-regexp)
+				      (string s)
+				      (integer start)
+				      (vector-desc start-vec)
+				      (vector-desc end-vec))
+  static-string	; Error msg or #f
+  bool)		; Matched?
+
+
+;;; Compile&match regexps in one go
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;; I could do this with the separate compile and execute procedures, 
+;;; but I go straight to C just for fun.
+;;; For Guile, we do it with the separate compile and execute procedures.
+
+(define (string-match pattern string . maybe-start)
+  (let ((rx (make-regexp pattern))
+	(start (:optional maybe-start 0)))
+    (regexp-exec rx string start)))
+
+(define-foreign %string-match (re_match (string pattern)
+					(string s)
+					(integer start)
+					(vector-desc start-vec)
+					(vector-desc end-vec))
+  static-string ; Error string or #f if all is ok.
+  bool)		; match?
+
+
+
+;;; Substitutions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define-foreign %regexp-subst (re_subst (string-desc compiled-regexp)
+					(string match)
+					(string str)
+					(integer start)
+					(vector-desc start-vec)
+					(vector-desc end-vec)
+					(string-desc outbuf))
+  static-string	; Error msg or #f
+  integer)
+
+(define-foreign %regexp-subst-len (re_subst_len (string-desc compiled-regexp)
+						(string match)
+						(string str)
+						(integer start)
+						(vector-desc start-vec)
+						(vector-desc end-vec))
+  static-string	; Error msg or #f
+  integer)
+
+;;; What does this do?
+
+;(define (regexp-subst re match replacement)
+;  (let ((cr (%regexp:bytes re))
+;	(str       (regexp-match:string match))
+;	(start-vec (regexp-match:start  match))
+;	(end-vec   (regexp-match:end    match)))
+;    (receive (err out-len) (%regexp-subst-len cr str replacement 0
+;					      start-vec end-vec)
+;      (if err (error err regexp-subst str replacement) ; More data here
+;	  (let ((out-buf (make-string out-len)))
+;	    (receive (err out-len) (%regexp-subst cr str replacement 0
+;						  start-vec end-vec out-buf)
+;	      (if err (error err regexp-subst str replacement)
+;		  (substring out-buf 0 out-len))))))))
+
+;;; Miscellaneous
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;; I do this one in C, I'm not sure why:
+;;; It is used by MATCH-FILES.
+;;; For Guile it's done in Scheme.
+
+(define-foreign %filter-C-strings!
+  (filter_stringvec (string pattern) ((C "char const ** ~a") cvec))
+  static-string	; error message -- #f if no error.
+  integer)	; number of files that pass the filter.
+
+(define (%filter-C-strings! pattern vec)
+  (let ((rx (make-regexp pattern))
+	(len (vector-length vec)))
+    (let loop ((i 0) (j 0))
+      (if (= i len)
+	  (values #f j)
+	  (loop (+ i 1)
+		(if (regexec rx (vector-ref vec i) #f)
+		    (begin
+		      (vector-set! vec j (vector-ref vec i))
+		      (+ j 1))
+		    j))))))
+
+;;; Convert a string into a regex pattern that matches that string exactly --
+;;; in other words, quote the special chars with backslashes.
+
+(define (regexp-quote string)
+  (let lp ((i (- (string-length string) 1))
+	   (result '()))
+    (if (< i 0) (list->string result)
+	(lp (- i 1)
+	    (let* ((c (string-ref string i))
+		   (result (cons c result)))
+	      (if (memv c '(#\[ #\] #\. #\* #\? #\( #\) #\| #\\ #\$ #\^ #\+))
+		  (cons #\\ result)
+		  result))))))
hunk ./time.scm 1
+;;; Time interface for scsh.
+;;; Copyright (c) 1994 by Olin Shivers.
+
+;;; Modified to use Guile primitives.
+
+;;; Should I have a (FILL-IN-DATE! date) procedure that fills in
+;;; the redundant info in a date record?
+;;; - month-day & month defined -> week-day & year-day filled in.
+;;; - month-day and year-day filled in from week-day and year-day
+;;;   (not provided by mktime(), but can be synthesized)
+;;; - If tz-secs and tz-name not defined, filled in from current time zone.
+;;; - If tz-name not defined, fabbed from tz-secs.
+;;; - If tz-secs not defined, filled in from tz-name.
+
+(foreign-source "#include \"time1.h\""	; Import the time1.h interface.
+		"")
+
+;;; A TIME is an instant in the history of the universe; it is location
+;;; independent, barring relativistic effects. It is measured as the
+;;; number of seconds elapsed since "epoch" -- January 1, 1970 UTC.
+
+;;; A DATE is a *local* name for an instant in time -- which instant
+;;; it names depends on your time zone (February 23, 1994 4:37 pm happens 
+;;; at different moments in Boston and Hong Kong).
+
+;;; DATE definition
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; We hack this so the date maker can take take the last three slots
+;;; as optional arguments.
+
+(define-record %date	; A Posix tm struct
+  seconds	; Seconds after the minute (0-59)
+  minute	; Minutes after the hour (0-59)
+  hour   	; Hours since midnight (0-23)
+  month-day	; Day of the month (1-31)
+  month   	; Months since January (0-11)
+  year    	; Years since 1900
+  tz-name	; Time zone as a string.
+  tz-secs	; Time zone as an integer: seconds west of UTC.
+  summer?	; Summer time (Daylight savings) in effect?
+  week-day	; Days since Sunday (0-6)	; Redundant
+  year-day)	; Days since Jan. 1 (0-365)	; Redundant
+
+(define date? %date?)
+
+(define date:seconds	%date:seconds)
+(define date:minute	%date:minute)
+(define date:hour	%date:hour)
+(define date:month-day	%date:month-day)
+(define date:month	%date:month)
+(define date:year	%date:year)
+(define date:tz-name	%date:tz-name)
+(define date:tz-secs	%date:tz-secs)
+(define date:summer?	%date:summer?)
+(define date:week-day	%date:week-day)
+(define date:year-day	%date:year-day)
+
+(define set-date:seconds	set-%date:seconds)
+(define set-date:minute		set-%date:minute)
+(define set-date:hour		set-%date:hour)
+(define set-date:month-day	set-%date:month-day)
+(define set-date:month		set-%date:month)
+(define set-date:year		set-%date:year)
+(define set-date:tz-name	set-%date:tz-name)
+(define set-date:tz-secs	set-%date:tz-secs)
+(define set-date:summer?	set-%date:summer?)
+(define set-date:week-day	set-%date:week-day)
+(define set-date:year-day	set-%date:year-day)
+
+(define (make-date s mi h md mo y . args)
+  (let-optionals args ((tzn #f) (tzs #f) (s?  #f) (wd  0)  (yd  0))
+    (make-%date s mi h md mo y tzn tzs s? wd yd)))
+
+
+;;; Not exported to interface.
+(define (time-zone? x)
+  (or (integer? x)	; Seconds offset from UTC.
+      (string? x)	; Time zone name, e.g. "EDT"
+      (not x)))		; Local time
+
+
+;;; Time
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+; TICKS/SEC is defined in OS-dependent code.
+
+(define-foreign %time+ticks/errno (time_plus_ticks)	; C fun is OS-dependent
+  desc	  ; errno or #f
+  fixnum  ; hi secs
+  fixnum  ; lo secs
+  fixnum  ; hi ticks
+  fixnum) ; lo ticks
+
+;; convert pair to multiple values.
+(if (not (defined? 'guile-time+ticks))
+    (define guile-time+ticks time+ticks))
+(set! time+ticks
+      (lambda ()
+	(let ((rv (guile-time+ticks)))
+	  (values (car rv) (cdr rv)))))
+
+(define (time+ticks->time secs ticks)
+  (+ secs (/ ticks ticks/sec)))
+
+(define-foreign %time/errno (scheme_time)
+  desc	  ; errno or #f
+  fixnum  ; hi secs
+  fixnum) ; lo secs
+
+
+(define-foreign %date->time/errno (date2time (fixnum sec)
+					     (fixnum min)
+					     (fixnum hour)
+					     (fixnum month-day)
+					     (fixnum month)
+					     (fixnum year)
+					     (desc   tz-name)	; #f or string
+					     (desc   tz-secs)	; #f or int
+					     (bool   summer?))
+  desc	  ; errno or #f
+  fixnum  ; hi secs
+  fixnum) ; lo secs
+
+;(define (time . args) ; optional arg [date]
+;  (let lp ()
+;    (receive (err hi-secs lo-secs)
+;	(if (null? args)
+;	    (%time/errno)		; Fast path for (time).
+;	    (let ((date (check-arg date? (car args) time)))
+;	      (%date->time/errno (date:seconds   date)
+;				 (date:minute    date)
+;				 (date:hour      date)
+;				 (date:month-day date)
+;				 (date:month     date)
+;				 (date:year      date)
+;				 (date:tz-name   date) ; #f or string
+;				 (date:tz-secs   date) ; #f or int
+;				 (date:summer?   date))))
+
+;      (cond ((not err) (compose-8/24 hi-secs lo-secs))	; Win.
+;	    ((= errno/intr err) (lp))			; Retry.
+;	    (else (apply errno-error err time args)))))); Lose.
+
+
+;;; Date
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define-foreign %time->date (time2date (fixnum time-hi)
+				       (fixnum time-lo)
+				       (desc zone))
+  desc		; errno or #f
+  fixnum	; seconds
+  fixnum	; minute
+  fixnum	; hour
+  fixnum	; month-day
+  fixnum	; month
+  fixnum	; year
+  string	; tz-name (#f if we need to make it from tz-secs)
+  fixnum	; tz-secs
+  bool		; summer?
+  fixnum	; week-day
+  fixnum)	; year-day
+
+
+;(define (date . args)	; Optional args [time zone]
+;  (let* ((time (if (pair? args)
+;		   (car args)
+;		   (time)))
+;	 (zone (check-arg time-zone?
+;			  (and (pair? args) (:optional (cdr args) #f))
+;			  date))
+;	 (bt (if zone
+;		 (localtime time zone)
+;		 (localtime time))))
+;    (make-%date (tm:sec bt) (tm:min bt) (tm:hour bt) (tm:mday bt)
+;		(tm:mon bt) (tm:year bt)
+;		(format-time-zone (tm:zone bt) (tm:gmtoff bt))
+;		(tm:gmtoff bt) (= (tm:isdst bt) 1) (tm:wday bt) 
+;		(tm:yday bt))))
+
+;;; Formatting date strings
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define (date->string date)	; Sun Sep 16 01:03:52 1973
+  (format-date "~a ~b ~d ~H:~M:~S ~Y" date))
+
+;(define (format-date fmt date)
+;  (check-arg date? date format-date)
+;  (receive (err result)
+;	   (%format-date/errno fmt
+;			       (date:seconds   date)
+;			       (date:minute    date)
+;			       (date:hour      date)
+;			       (date:month-day date)
+;			       (date:month     date)
+;			       (date:year      date)
+;			       (if (string? (date:tz-name date))
+;				   (date:tz-name date)
+;				   (deintegerize-time-zone (date:tz-secs date)))
+;			       (date:summer?   date)
+;			       (date:week-day  date)
+;			       (date:year-day  date))
+;    (cond ((not err) result)
+;	  ((= errno/intr err) (format-date fmt date))
+;	  (else (errno-error err format-date fmt date)))))
+
+(define-foreign %format-date/errno (format_date (string fmt)
+						(fixnum seconds)
+						(fixnum minute)
+						(fixnum hour)
+						(fixnum month-day)
+						(fixnum month)
+						(fixnum year)
+						(desc   tz-name)
+						(bool   summer?)
+						(fixnum week-day)
+						(fixnum year-day))
+  desc		; false or errno
+  string)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;; Obsoleted, since DATE records now include time zone info.
+;;; If you want the UTC offset, just do (date:tz-secs (date [time tz])).
+;;;
+;(define (utc-offset . args) ; Optional args [time tz]
+;  (let ((tim (if (pair? args)
+;		 (real->exact-integer (check-arg real? (car args) utc-offset))
+;		 (time)))
+;	(tz (and (pair? args)
+;		 (check-arg time-zone? (:optional (cdr args) #f) utc-offset))))
+;    (if (integer? tz) tz
+;	(- (time (date tim tz) 0) tim))))
+
+
+;(define (time-zone . args)	; Optional args [summer? tz]
+;  (let ((tz (and (pair? args)
+;		 (check-arg time-zone? (:optional (cdr args) #f) time-zone))))
+;    (if (integer? tz)
+;	(deintegerize-time-zone tz)
+;	(let* ((summer? (if (pair? args) (car args) (time)))
+;	       (summer? (if (real? summer?) (real->exact-integer summer?) summer?)))
+;	  (receive (err zone) (%time-zone/errno summer? tz)
+;		   (if err (errno-error err time-zone summer? tz)
+;	    zone))))))
+		 
+;;; 8/24 bit signed integer splitting and recombination.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;(define (hi8  n) (bitwise-and (arithmetic-shift n -24) #xff))
+;(define (lo24 n) (bitwise-and n #xffffff))
+
+;(define (compose-8/24 hi-8 lo-24)
+;  (let ((val (+ (arithmetic-shift hi-8 24) lo-24)))
+;    (if (zero? (bitwise-and hi-8 #x80)) val
+;	;; Oops -- it's a negative 32-bit value.
+;	;; Or in all the sign bits.
+;	(bitwise-ior (bitwise-not #xffffffff)
+;		     val))))
+
+;;; Render a number as a two-digit base ten numeral. 
+;;; Pathetic. FORMAT should do this for me.
+(define (two-digits n)
+  (let ((s (number->string n)))
+    (if (= (string-length s) 1)
+	(string-append "0" s)
+	s)))
+
+;;; If time-zone is an integer, convert to a Posix-format string of the form:
+;;;     UTC+hh:mm:ss
+(define (deintegerize-time-zone tz)
+  (if (integer? tz)
+      (format-time-zone "UTC" tz)
+      tz))
+
+
+;;; NAME is a simple time-zone name such as "EST" or "UTC". You get them
+;;; back from the Unix time functions as the values of the char *tzname[2]
+;;; standard/dst vector. The problem is that these time are ambiguous.
+;;; This function makes them unambiguous by tacking on the UTC offset
+;;; in Posix format, such as "EST+5". You need to do this for two reasons:
+;;; 1. Simple time-zone strings are not recognised at all sites.
+;;;    For example, HP-UX doesn't understand "EST", but does understand "EST+5"
+;;; 2. Time zones represented as UTC offsets (e.g., "UTC+5") are returned
+;;;    back from the Unix time software as just "UTC", which in the example
+;;;    just given is 5 hours off. Try setting TZ=UTC+5 and running the date(1)
+;;;    program. It will give you EST time, but print the time zone as "UTC".
+;;;    Oops.
+
+(define (format-time-zone name offset)
+  (if (zero? offset) name
+      (receive (sign offset)
+	       (if (< offset 0)
+		   (values #\+ (- offset))	    ; Notice the flipped sign
+		   (values #\- offset))		    ; of SIGN.
+        (let* ((offset (modulo offset 86400))
+	       (h (quotient offset 3600))
+	       (m (quotient (modulo offset 3600) 60))
+	       (s (modulo offset 60)))
+	  (if (zero? s)
+	      (if (zero? m)
+		  (format #f "~a~a~d" name sign h)	; name+h
+		  (format #f "~a~a~a:~a"		; name+hh:mm
+			  name sign (two-digits h) (two-digits m)))
+	      (format #f "~a~a~a:~a:~a"			; name+hh:mm:ss
+		      name sign (two-digits h) (two-digits m) (two-digits s)))))))