[Scsh-checkins] CVS: scsh-0.6/scsh scsh-interfaces.scm,1.17,1.18 syslog.scm,1.1,1.2

[Mike Sperber <sperber@users.sourceforge.net>]

Update of /cvsroot/scsh/scsh-0.6/scsh
In directory usw-pr-cvs1:/tmp/cvs-serv4994/scsh

Modified Files:
        scsh-interfaces.scm syslog.scm 
Log Message:
Syslog interface cleanup.


Index: scsh-interfaces.scm
===================================================================
RCS file: /cvsroot/scsh/scsh-0.6/scsh/scsh-interfaces.scm,v
retrieving revision 1.17
retrieving revision 1.18
diff -C2 -r1.17 -r1.18
*** scsh-interfaces.scm 2001/06/01 16:22:26     1.17
--- scsh-interfaces.scm 2001/06/11 13:06:25     1.18
***************
*** 1080,1103 ****
    (export (syslog-option :syntax)
          make-syslog-options
          syslog-options?
          (syslog-options :syntax)
          syslog-options-on?
  
          (syslog-facility :syntax)
          syslog-facility?
  
          (syslog-level :syntax)
          syslog-level?
  
          levels->syslog-mask
          (syslog-mask :syntax)
          syslog-mask-all
          syslog-mask-upto
          syslog-mask-levels-on?
  
          open-syslog-channel
          close-syslog-channel
-         syslog-write
  
          with-syslog-destination
          syslog))
--- 1080,1110 ----
    (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
  
          with-syslog-destination
          syslog))
+ 

Index: syslog.scm
===================================================================
RCS file: /cvsroot/scsh/scsh-0.6/scsh/syslog.scm,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -r1.1 -r1.2
*** syslog.scm  2001/06/01 16:22:26     1.1
--- syslog.scm  2001/06/11 13:06:25     1.2
***************
*** 22,28 ****
    (value syslog-options-value))
  
! (define (syslog-options=? options-1 options-2)
!   (= (syslog-options-value options-1)
!      (syslog-options-value options-2)))
  
  (define-exported-binding "syslog-options-type" :syslog-options)
--- 22,26 ----
    (value syslog-options-value))
  
! (define syslog-options=? eq?)
  
  (define-exported-binding "syslog-options-type" :syslog-options)
***************
*** 38,41 ****
--- 36,59 ----
  (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)
  
***************
*** 63,66 ****
--- 81,86 ----
     local0 local1 local2 local3 local4 local5 local6 local7))
  
+ (define syslog-facility=? eq?)
+ 
  (define default-syslog-facility (syslog-facility user))
  
***************
*** 86,89 ****
--- 106,111 ----
     (debug     #o200)))
  
+ (define syslog-level=? eq?)
+ 
  (define-exported-binding "syslog-level-type" :syslog-level)
  (define-exported-binding "syslog-levels" syslog-levels)
***************
*** 109,112 ****
--- 131,139 ----
          (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 ()
***************
*** 217,224 ****
  (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)))
  
  (define (with-syslog-destination ident options facility mask thunk)
--- 244,255 ----
  (define (syslog level message . rest)
    (syslog-write level message
!               (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)