[log4cl-cvs] CVS update: log4cl/logger.lisp

[Nicolas Lamirault]

Update of /project/log4cl/cvsroot/log4cl
In directory common-lisp.net:/tmp/cvs-serv9184

Modified Files:
	logger.lisp 
Log Message:
some modifications

Date: Fri Mar  5 10:09:34 2004
Author: nlamirault

Index: log4cl/logger.lisp
diff -u log4cl/logger.lisp:1.3 log4cl/logger.lisp:1.4
--- log4cl/logger.lisp:1.3	Thu Mar  4 06:36:31 2004
+++ log4cl/logger.lisp	Fri Mar  5 10:09:34 2004
@@ -51,6 +51,15 @@
 
 
 
+(defmacro with-logger ((logger &key name appenders level) &body body)
+  `(let ((,logger (make-instance 'logger
+				 :name ,name
+				 :appenders ,appenders
+				 :level ,level)))
+     , at body))
+
+
+
 ;; -------
 ;; Levels
 ;; -------
@@ -96,10 +105,10 @@
 				    (append levels (list new-level)))
 				   ((string-equal place "relative")
 				    (with-level logger level
-						(let ((rank (level-rank logger level)))
-						  (append (subseq levels 0 rank)
-							  (list new-level)
-							  (subseq levels rank (length levels)))))))
+					(let ((rank (level-rank logger level)))
+					  (append (subseq levels 0 rank)
+						  (list new-level)
+						  (subseq levels rank (length levels)))))))
 			     levels)))
 	(setf (slot-value logger 'possible-levels) new-levels))))
 
@@ -137,8 +146,7 @@
   "Remove an appender"
   (with-slots (appenders current-appender) logger
     (setf appenders (remove (appender-name appender) (logger-appenders logger) 
-			    :test #'string-equal 
-			    :key #'appender-name))
+			    :test #'string-equal :key #'appender-name))
     (when (string-equal (logger-current-appender logger) (appender-name appender))
       (setf current-appender (car (logger-appenders logger))))))
 
@@ -187,7 +195,7 @@
 	(level-name (symbol-name level)))
     (when (is-enabled-for logger level)
       (if (not (null appender-type))
-	  (with-appender (appender) logger appender-type
+	  (with-appender (appender) logger (symbol-name appender-type)
 	      (log-msg appender name level-name message))
 	  (mapc #'(lambda (app)
 		    (log-msg app name level-name message))
@@ -198,6 +206,11 @@
 ;; -----------------------------------
 ;; Predicat to know the current level
 ;; -----------------------------------
+
+
+(defmethod levelp ((logger logger) level)
+  "Predicat for level"
+  (not (null (member level (logger-possible-levels logger)))))
 
 
 (defmethod debugp ((logger logger))