(defun maybe-initialize-appender (logger)
  (unless (or (#"hasMoreElements" (#"getAllAppenders" logger))
	      (and (#"getParent" logger) (#"hasMoreElements" (#"getAllAppenders" (#"getParent" logger)))))
    (#"addAppender" logger (new 'consoleappender (new 'simplelayout)))))

(defun log-abox (&optional (level "ALL") (kb *default-kb*))
  (let ((logger (#"getLogger" (get-java-field (#"getABox" (kb-kb kb)) "log"))))
    (maybe-initialize-appender logger)
    (#"setLevel" logger (get-java-field  'org.apache.log4j.Level level))))

(defun log-tbox (&optional (level "ALL") (kb *default-kb*))
  (ignore-errors
    (let ((logger (#"getLogger" (get-java-field (#"getTBox" (kb-kb kb)) "log"))))
        (maybe-initialize-appender logger)
      (#"setLevel" logger (get-java-field  'org.apache.log4j.Level level)))))

(defun log-kb (&optional (level "ALL") (kb *default-kb*))
  (let ((logger (#"getLogger" (get-java-field (kb-kb kb) "log"))))
    (maybe-initialize-appender logger)
    (#"setLevel" logger (get-java-field  'org.apache.log4j.Level level))))

(defun log-taxonomy-builder (&optional (level "ALL") (kb *default-kb*))
  (ignore-errors
  (let ((logger (#"getLogger" (get-java-field 'taxonomy "log"))))
    (maybe-initialize-appender logger)
    (#"setLevel" logger (get-java-field  'org.apache.log4j.Level level)))))

(defun pellet-log-level (kb level)
  (log-taxonomy-builder level kb)
  (log-kb level kb)
  (log-tbox level kb)
  (log-abox level kb))

(defun log-info (kb)
  (pellet-log-level kb "INFO"))

(defun log-off (kb)
  (pellet-log-level kb "OFF"))

(defun log-debug (kb)
  (pellet-log-level kb "DEBUG"))

(defun pellet-progress-monitor (&optional set-type)
  (assert (member set-type '("CONSOLE" "SWING" "NONE" nil) :test 'equal) ()
	  "The valid options are CONSOLE, SWING, or NONE")
  (let* ((field (aref (#"getFields" (find-java-class "PelletOptions")) 
		      (position "USE_CLASSIFICATION" 
				(map 'list #"toString" (#"getFields" (find-java-class "PelletOptions"))) :test 'search)))
	 (field-type (#"getGenericType" field))
	 (new-value (#"get" (find-if (lambda(e) (search set-type (#"toString" e)))  (#"getFields" field-type)) field)))
    (if set-type
	(#"set" field field-type new-value)
	(#"toString" (#"get" field field-type))
	)))

(defmacro with-pellet-timeout ((kb timeout) &body body)
  `(let ((timer (get-java-field (get-java-field (kb-kb ,kb) "timers") "mainTimer")))
     (unwind-protect 
	  (progn (#"reset" timer)
		 (#"setTimeout" timer (* ,timeout 1000))
		 (#"start" timer) 
		 ,@body)
       (#"setTimeout" timer 0)
       (#"reset" timer)
       (#"start" timer) ; keep it running
       )))

(defun interrupt-pellet (kb)
  (let ((timer (get-java-field (get-java-field (kb-kb kb) "timers") "mainTimer")))
    (#"setTimeout" timer 1)
    ))

;org.mindswap.pellet.exceptions.TimeoutException

;(timeout-pellet-now (kb s))

(defun reset-pellet-timeout (kb)
  (let ((timer (get-java-field (get-java-field (kb-kb kb) "timers") "mainTimer")))
    (#"setTimeout" timer 0)
    (#"reset" timer)
    (#"start" timer)))


(defmacro capturing-log-to-string ((mute &rest loggers) &body body)
  (let ((loggersv (make-symbol "LOGGERS")))
    `(let ((,loggersv (list ,@loggers)))
       (setq ,loggersv (loop for logger in ,loggersv
			  if (listp logger)
			  append logger
			  else  collect logger))
       (capture-log-to-string-1 (lambda() (progn ,@body)) ,mute ,loggersv))))

(defun capture-log-to-string-1 (continue mute loggers)
  (let* ((logger (car loggers))
	 (stringwriter (new 'stringwriter))
	 (appender (new 'writerappender (new 'simplelayout) stringwriter))
	 (previous (#"getAllAppenders" logger))
	 (additive? (#"getAdditivity" logger)))
    (when mute
      (#"removeAllAppenders" logger)
      (#"setAdditivity" logger nil))
    (#"addAppender" logger appender)
    (unwind-protect 
	 (if (cdr loggers)
	     (capture-log-to-string-1 continue mute (cdr loggers))
	     (funcall continue))
      (#"removeAppender" logger appender)
      (when mute
	(loop for appender in (vector-to-list previous)
	   do (#"addAppender" logger appender))
	(#"setAdditivity" logger additive?)))
    (#"toString" stringwriter)))

(defun pellet-loggers (kb)
  (list
   (#"getLogger" (get-java-field (#"getABox" (kb-kb kb)) "log"))
   (#"getLogger" (get-java-field (#"getTBox" (kb-kb kb)) "log"))
   (#"getLogger" (get-java-field (kb-kb kb) "log"))
   (#"getLogger" (get-java-field 'taxonomy "log"))
   ))

(defmethod maybe-cache-supers ((kb kb))
  (unless (kb-explicit-supers kb)
    (let ((table (make-hash-table)))
      (loop for (sub super) in
	   (sparql '(:select (?sub ?super) () (?sub !rdfs:subClassOf ?super)
		     (:filter (and (not (or (isblank ?sub) (isblank ?super))))))
		   :use-reasoner :none :kb kb)
	   do (pushnew super (gethash sub table)))
      (loop for class in
	   (sparql '(:select (?class) () (?sub !rdf:type !owl:Class)
		     (:filter (and (not (isblank ?class)))))
		   :use-reasoner :none :kb kb)
	   do (when (not (gethash class table)) (pushnew !owl:Thing (gethash class table))))
      (let ((remaining nil))
	(maphash (lambda (k v)
		   (declare (ignore k))
		   (loop for class in v
		      when (not (gethash class table))
		      do (push class remaining)))
		 table)
	(loop for class in remaining do (setf (gethash class table) (list !owl:Thing))))
      (remhash !owl:Thing table) ; how does !owl:Thing get to be a super of !owl:Thing? oops.
      (setf (kb-explicit-supers kb) table))))

(defmethod explicit-ancestors ((kb kb) class)
  (maybe-cache-supers kb)
  (loop for super in (gethash class (kb-explicit-supers kb)) collect super append (explicit-ancestors kb super)))

(defmethod explicit-ancestor ((kb kb) class parent)
  (maybe-cache-supers kb)
  (let ((supers (gethash class (kb-explicit-supers kb))))
    (or (member parent supers)
	(loop for super in supers thereis
	     (explicit-ancestor kb super parent)))))

(defmethod most-specific ((kb kb) classes)
  (let ((queue classes)
	(most nil))
    (loop while queue
       for one = (pop queue)
       do
	 (loop with issuper = nil
	    for two in queue
	    until issuper
	    do
	    (if (explicit-ancestor kb one two)
		(setq queue (remove two queue))
		(when (explicit-ancestor kb two one)
		  (setq issuper t)))
	    finally (unless issuper (push one most))))
    (or most (list "Thing"))))