From 98de22054ed8c5ba8220cf12df449da5840593d1 Mon Sep 17 00:00:00 2001
From: sperber <sperber>
Date: Mon, 11 Jun 2001 13:06:25 +0000
Subject: [PATCH] Syslog interface cleanup.

---
 scsh/scsh-interfaces.scm |  9 +++++++-
 scsh/syslog.scm          | 45 +++++++++++++++++++++++++++++++++-------
 2 files changed, 46 insertions(+), 8 deletions(-)

diff --git a/scsh/scsh-interfaces.scm b/scsh/scsh-interfaces.scm
index 5daf19a..28a31b7 100644
--- a/scsh/scsh-interfaces.scm
+++ b/scsh/scsh-interfaces.scm
@@ -1079,25 +1079,32 @@
 (define-interface syslog-interface
   (export (syslog-option :syntax)
 	  make-syslog-options
+	  syslog-options->list
 	  syslog-options?
 	  (syslog-options :syntax)
 	  syslog-options-on?
+	  syslog-options=?
 
 	  (syslog-facility :syntax)
 	  syslog-facility?
+	  syslog-facility=?
 
 	  (syslog-level :syntax)
 	  syslog-level?
+	  syslog-level=?
 
 	  levels->syslog-mask
 	  (syslog-mask :syntax)
+	  syslog-mask->levels
 	  syslog-mask-all
 	  syslog-mask-upto
 	  syslog-mask-levels-on?
+	  syslog-mask?
+	  syslog-mask=?
 
 	  open-syslog-channel
 	  close-syslog-channel
-	  syslog-write
 
 	  with-syslog-destination
 	  syslog))
+
diff --git a/scsh/syslog.scm b/scsh/syslog.scm
index 5c77aa2..6571976 100644
--- a/scsh/syslog.scm
+++ b/scsh/syslog.scm
@@ -21,9 +21,7 @@
   syslog-options?
   (value syslog-options-value))
 
-(define (syslog-options=? options-1 options-2)
-  (= (syslog-options-value options-1)
-     (syslog-options-value options-2)))
+(define syslog-options=? eq?)
 
 (define-exported-binding "syslog-options-type" :syslog-options)
 
@@ -37,6 +35,26 @@
 
 (define default-syslog-options (make-syslog-options '()))
 
+(define (make-mask-record->list get-value get-mask record-vector)
+  (lambda (mask-record)
+    (let ((value (get-value mask-record))
+	  (n-syslog-options (vector-length record-vector)))
+      (let loop ((i 0) (list '()))
+	(cond
+	 ((>= i n-syslog-options)
+	  list)
+	 ((zero? (bitwise-and value
+			      (get-mask (vector-ref record-vector i))))
+	  (loop (+ 1 i) list))
+	 (else
+	  (loop (+ 1 i) (cons (vector-ref record-vector i)
+			      list))))))))
+
+(define syslog-options->list
+  (make-mask-record->list syslog-options-value
+			  syslog-option-mask
+			  the-syslog-options))
+
 ; Simplifying syntax, e.g. (syslog-options delay console)
 
 (define-syntax syslog-options
@@ -62,6 +80,8 @@
    uucp
    local0 local1 local2 local3 local4 local5 local6 local7))
 
+(define syslog-facility=? eq?)
+
 (define default-syslog-facility (syslog-facility user))
 
 (define-exported-binding "syslog-facility-type" :syslog-facility)
@@ -85,6 +105,8 @@
    (info	#o100)
    (debug	#o200)))
 
+(define syslog-level=? eq?)
+
 (define-exported-binding "syslog-level-type" :syslog-level)
 (define-exported-binding "syslog-levels" syslog-levels)
 
@@ -108,6 +130,11 @@
    (apply bitwise-ior
 	  (map syslog-level-mask levels))))
 
+(define syslog-mask->levels
+  (make-mask-record->list syslog-mask-value
+			  syslog-level-mask
+			  syslog-levels))
+
 (define-syntax syslog-mask
   (syntax-rules ()
     ((syslog-mask name ...)
@@ -216,10 +243,14 @@
 
 (define (syslog level message . rest)
   (syslog-write level message
-		;; this might be a little excessive allocation
-		(apply change-syslog-channel
-		       (thread-fluid dynamic-syslog-channel)
-		       rest)))
+		(if (and (not (null? rest))
+			 (null? (cdr rest))
+			 (syslog-channel? (car rest)))
+		    (car rest)
+		    ;; this might be a little excessive allocation
+		    (apply change-syslog-channel
+			   (thread-fluid dynamic-syslog-channel)
+			   rest))))
 
 (define (with-syslog-destination ident options facility mask thunk)
   (let-thread-fluid dynamic-syslog-channel