@@ -34,6 +34,35 @@

 (defvar *all-color-themes* (make-hash-table :test 'string=))

+(defvar *editor-face-names*

+  '(:region

+    :show-point-face

+    :interactive-input-face

+    :highlight

+    :non-focus-complete-face

+    :font-lock-function-name-face

+    :font-lock-comment-face

+    :font-lock-type-face

+    :font-lock-variable-name-face

+    :font-lock-string-face

+    :font-lock-keyword-face

+    :font-lock-builtin-face

+    :compiler-note-highlight

+    :compiler-warning-highlight

+    :compiler-error-highlight

+    :incremental-search-face

+    :incremental-search-other-matches-face

+    ))

+

+(defvar *all-editor-panes* nil)

+

+(defvar *all-listener-editor-panes* nil)

+

+(defvar *all-collector-panes* nil)

+                              

+

+;; (eq (capi:capi-object-name b) 'lw-tools::buffers-list)

+

 (defun all-color-themes ()

   (maphash #'(lambda (key value)

                (declare (ignore value))

@@ -53,13 +82,9 @@

 (defun color-theme-args (theme-name)

   (rest (color-theme-data theme-name)))

-(defvar *all-editor-panes* (make-hash-table :test 'eq

-                                            :weak-kind :key))

-(defvar *all-listener-editor-panes* (make-hash-table :test 'eq

-                                                     :weak-kind :key))

-(defun update-editor-pane (pane foreground background)

+(defun update-pane-colors (pane foreground background)

   (setf (capi:simple-pane-foreground pane) foreground)

   (setf (capi:simple-pane-background pane) background)

@@ -71,49 +96,32 @@

 (defun update-editor-panes ()

   (let ((foreground (gethash :foreground-color *current-colors*))

         (background (gethash :background-color *current-colors*)))

-    (maphash #'(lambda (pane value)

-                 (declare (ignore value))

-                 (update-editor-pane pane foreground background))

-             *all-editor-panes*))

-  (values))

+    (mapcar #'(lambda (pane)

+                 (update-pane-colors pane foreground background))

+             *all-editor-panes*)))

 (defun update-listener-panes ()

   (let ((foreground (gethash :listener-foreground-color *current-colors*))

         (background (gethash :listener-background-color *current-colors*)))

-    (maphash #'(lambda (pane value)

-                 (declare (ignore value))

-                 (update-editor-pane pane foreground background))

+    (mapcar #'(lambda (pane)

+                 (update-pane-colors pane foreground background))

              *all-listener-editor-panes*))

-    (values))

+  (let ((foreground (gethash :output-foreground-color *current-colors*))

+        (background (gethash :output-background-color *current-colors*)))

+    (mapcar #'(lambda (pane)

+                (update-pane-colors pane foreground background))

+            *all-collector-panes*)))

-(defvar *editor-face-names*

-  '(:region

-    :show-point-face

-    :interactive-input-face

-    :highlight

-    :non-focus-complete-face

-    :font-lock-function-name-face

-    :font-lock-comment-face

-    :font-lock-type-face

-    :font-lock-variable-name-face

-    :font-lock-string-face

-    :font-lock-keyword-face

-    :font-lock-builtin-face

-    :compiler-note-highlight

-    :compiler-warning-highlight

-    :compiler-error-highlight

-    :incremental-search-face

-    :incremental-search-other-matches-face

-    ))

-

 (defun set-color-theme (theme-name)

   (destructuring-bind (&rest color-theme-args

                              &key foreground background

                              listener-foreground

                              listener-background

+                             output-foreground

+                             output-background

                              &allow-other-keys)

       (color-theme-args theme-name)

@@ -132,6 +140,17 @@

           (or listener-background

               (gethash :background-color *current-colors*)

               +default-background-color+))

+    ;; output foreground and background, uses :background and

+    ;; :foreground if not specified

+    (setf (gethash :output-foreground-color *current-colors*)

+          (or output-foreground

+              (gethash :foreground-color *current-colors*)

+              +default-foreground-color+)

+          (gethash :output-background-color *current-colors*)

+          (or output-background

+              (gethash :background-color *current-colors*)

+              +default-background-color+))

+    

     (dolist (name *editor-face-names*)

       (let* ((color-theme-args-for-face (getf color-theme-args name))

@@ -173,9 +192,18 @@

 (defun set-editor-pane-colors (pane)

   (typecase pane

+     (capi:collector-pane

+     (progn

+       (pushnew pane *all-collector-panes*)

+       (let ((bg-color (gethash :output-background-color *current-colors*))

+             (fg-color (gethash :output-foreground-color *current-colors*)))

+         (when fg-color

+           (setf (capi:simple-pane-foreground pane) fg-color))

+         (when bg-color

+           (setf (capi:simple-pane-background pane) bg-color)))))

     (capi:editor-pane

      (progn

-       (setf (gethash pane *all-editor-panes*) pane)

+       (pushnew pane *all-editor-panes*)

        (let ((bg-color (gethash :background-color *current-colors*))

              (fg-color (gethash :foreground-color *current-colors*)))

          (when fg-color

@@ -183,11 +211,12 @@

          (when bg-color

            (setf (capi:simple-pane-background pane) bg-color)))))))

+

 (defun set-listener-pane-colors (pane)

   (typecase pane

     (capi:editor-pane

      (progn

-       (setf (gethash pane *all-listener-editor-panes*) pane)

+       (pushnew pane *all-listener-editor-panes*)

        (let ((bg-color (gethash :listener-background-color *current-colors*))

              (fg-color (gethash :listener-foreground-color *current-colors*)))

          (when fg-color

@@ -196,6 +225,19 @@

            (setf (capi:simple-pane-background pane) bg-color)))))))

+(defun set-collector-pane-colors (pane)

+  ;; only for listener output panes

+  ;(when (typep (capi:top-level-interface o) 'lw-tools:listener)

+    (pushnew pane *all-collector-panes*)

+    (let ((bg-color (gethash :output-background-color *current-colors*))

+          (fg-color (gethash :output-foreground-color *current-colors*)))

+      (when fg-color

+        (setf (capi:simple-pane-foreground pane) fg-color))

+      (when bg-color

+        (setf (capi:simple-pane-background pane) bg-color))))

+   

+

+

 (lispworks:defadvice ((method capi:interface-display :before (lw-tools:editor))

                       change-editor-colors

@@ -212,6 +254,15 @@

     (capi:map-pane-descendant-children

      self 'set-listener-pane-colors)))

+(defvar called nil)

+

+;; capi:collector-pane does'nt have interface-display method called,

+;; so we adding the :after constuctor instead

+(sys::without-warning-on-redefinition

+  (defmethod initialize-instance :after ((self capi:collector-pane) &rest

+                                         clos::initargs &key &allow-other-keys)

+    (set-collector-pane-colors self)))

+

 ;; This makes it "work" after the podium is launched

 (defun is-editor-pane-p (obj)

@@ -219,7 +270,7 @@

        (not (eq obj (hcl:class-prototype (class-of obj))))))

 (defun cache-existing-pane (pane)

-  (setf (gethash pane *all-editor-panes*) pane))

+  (pushnew pane *all-editor-panes*))

 (defun cache-if-pane (obj)

   (when (is-editor-pane-p obj)