[climacs-cvs] CVS update: climacs/gui.lisp

[Dwight Holman]

Update of /project/climacs/cvsroot/climacs
In directory common-lisp.net:/tmp/cvs-serv18686

Modified Files:
	gui.lisp 
Log Message:
Adds basic color customization and an example of its use.
See (climacs-gui::climacs-rv) for climacs in reverse video.
(Similar to `emacs -rv`)

Date: Sun Jan  8 10:08:18 2006
Author: dholman

Index: climacs/gui.lisp
diff -u climacs/gui.lisp:1.198 climacs/gui.lisp:1.199
--- climacs/gui.lisp:1.198	Mon Nov 14 17:30:13 2005
+++ climacs/gui.lisp	Sun Jan  8 10:08:17 2006
@@ -98,9 +98,18 @@
 ;;; windows
 (make-command-table 'window-table :errorp nil)
 
+(defvar *bg-color* +white+)
+(defvar *fg-color* +black+)
+(defvar *info-bg-color* +white+)
+(defvar *info-fg-color* +black+)
+(defvar *mini-bg-color* +white+)
+(defvar *mini-fg-color* +black+)
+
+
 (define-application-frame climacs (standard-application-frame
 				   esa-frame-mixin)
   ((buffers :initform '() :accessor buffers))
+  
   (:command-table (global-climacs-table
 		   :inherit-from (global-esa-table
 				  keyboard-macro-table
@@ -130,11 +139,15 @@
 		       :width 900 :height 400
 		       :end-of-line-action :scroll
 		       :incremental-redisplay t
+		       :background *bg-color*
+		       :foreground *fg-color*
 		       :display-function 'display-window
 		       :command-table 'global-climacs-table))
 	   (info-pane
 	    (make-pane 'climacs-info-pane
 		       :master-pane extended-pane
+		       :background *info-bg-color*
+		       :foreground *info-fg-color*
 		       :width 900)))
       (setf (windows *application-frame*) (list extended-pane)
 	    (buffers *application-frame*) (list (buffer extended-pane)))
@@ -145,7 +158,7 @@
 	      extended-pane)
 	    extended-pane)
 	info-pane)))
-   (minibuffer (make-pane 'climacs-minibuffer-pane :width 900)))
+   (minibuffer (make-pane 'climacs-minibuffer-pane :background *mini-bg-color* :foreground *mini-fg-color* :width 900)))
   (:layouts
    (default
        (vertically (:scroll-bars nil)
@@ -176,6 +189,17 @@
       (if new-process
 	  (clim-sys:make-process #'run :name process-name)
 	  (run)))))
+
+(defun climacs-rv (&key new-process (process-name "Climacs")
+                (width 900) (height 400))
+  "Starts up a climacs session"
+   (let ((*bg-color* +black+)
+	 (*fg-color* +white+)
+	 (*info-bg-color* +blue+)
+	 (*info-fg-color* +yellow+)
+	 (*mini-bg-color* +black+)
+	 (*mini-fg-color* +white+))
+     (climacs :new-process new-process :process-name process-name :width width :height height)))
 
 (defun display-info (frame pane)
   (declare (ignore frame))