[clfswm-cvs] r347 - in clfswm: . src

[Philippe Brochard]

Author: pbrochard
Date: Wed Oct  6 16:46:53 2010
New Revision: 347

Log:
src/clfswm-query.lisp (query-print-string): Change cursor color and show parenthesis matching with colors (on match and on errors).

Modified:
   clfswm/ChangeLog
   clfswm/src/clfswm-query.lisp
   clfswm/src/config.lisp

Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog	(original)
+++ clfswm/ChangeLog	Wed Oct  6 16:46:53 2010
@@ -1,3 +1,9 @@
+2010-10-06  Philippe Brochard  <pbrochard at common-lisp.net>
+
+	* src/clfswm-query.lisp (query-print-string): Change cursor color
+	and show parenthesis matching with colors (on match and on
+	errors).
+
 2010-10-05  Philippe Brochard  <pbrochard at common-lisp.net>
 
 	* src/clfswm-internal.lisp (show-all-children): Do not raise a

Modified: clfswm/src/clfswm-query.lisp
==============================================================================
--- clfswm/src/clfswm-query.lisp	(original)
+++ clfswm/src/clfswm-query.lisp	Wed Oct  6 16:46:53 2010
@@ -57,14 +57,23 @@
 		  :with level = 1   :for c = (aref string p)
 		  :do (when (char= c #\() (decf level))
 		  (when (char= c #\)) (incf level))
-		  (when (= level 0) (return p)))))
-      (when (have-to-find-right?)
-	(let ((p (pos-right)))
-	  (when p (setf (aref string p) #\]))))
-      (when (have-to-find-left?)
-	(let ((p (pos-left)))
-	  (when p (setf (aref string p) #\[))))
-      string)))
+		  (when (= level 0) (return p))))
+	     (draw-bloc (p &optional (color *query-parent-color*))
+	       (setf (xlib:gcontext-foreground *query-gc*) (get-color color))
+	       (xlib:draw-rectangle *pixmap-buffer* *query-gc*
+				    (+ 10 (* p (xlib:max-char-width *query-font*)))
+				    (+ (xlib:max-char-ascent *query-font*) (xlib:max-char-descent *query-font*) 7)
+				    (xlib:max-char-width *query-font*)
+				    (+ (xlib:max-char-ascent *query-font*) (xlib:max-char-descent *query-font*))
+				    t)))
+      (cond ((have-to-find-left?) (let ((p (pos-left)))
+				    (if p
+					(progn (draw-bloc p) (draw-bloc (1- pos)))
+					(draw-bloc (1- pos) *query-parent-error-color*))))
+	    ((have-to-find-right?) (let ((p (pos-right)))
+				     (if p
+					 (progn (draw-bloc p) (draw-bloc pos))
+					 (draw-bloc pos *query-parent-error-color*))))))))
 
 
 (defun clear-query-history ()
@@ -88,21 +97,26 @@
 (add-hook *binding-hook* 'init-*query-keys*)
 
 
-(defun query-add-cursor (string)
-  (concatenate 'string (subseq string 0 *query-pos*) "|" (subseq string *query-pos*)))
-
 (defun query-print-string ()
   (clear-pixmap-buffer *query-window* *query-gc*)
-  (setf (xlib:gcontext-foreground *query-gc*) (get-color *query-foreground*))
+  (setf (xlib:gcontext-foreground *query-gc*) (get-color *query-message-color*))
   (xlib:draw-glyphs *pixmap-buffer* *query-gc* 5 (+ (xlib:max-char-ascent *query-font*) 5) *query-message*)
   (when (< *query-pos* 0)
     (setf *query-pos* 0))
   (when (> *query-pos* (length *query-string*))
     (setf *query-pos* (length *query-string*)))
+  (query-show-paren *query-string* *query-pos*)
+  (setf (xlib:gcontext-foreground *query-gc*) (get-color *query-foreground*))
   (xlib:draw-glyphs *pixmap-buffer* *query-gc*
 		    10
 		    (+ (* 2 (+ (xlib:max-char-ascent *query-font*) (xlib:max-char-descent *query-font*))) 5)
-		    (query-add-cursor (query-show-paren *query-string* *query-pos*)))
+		    *query-string*)
+  (setf (xlib:gcontext-foreground *query-gc*) (get-color *query-cursor-color*))
+  (xlib:draw-line *pixmap-buffer* *query-gc*
+		  (+ 10 (* *query-pos* (xlib:max-char-width *query-font*)))
+		  (+ (* 2 (+ (xlib:max-char-ascent *query-font*) (xlib:max-char-descent *query-font*))) 6)
+		  (+ 10 (* *query-pos* (xlib:max-char-width *query-font*)))
+		  (+ (* 1 (+ (xlib:max-char-ascent *query-font*) (xlib:max-char-descent *query-font*))) 7))
   (copy-pixmap-buffer *query-window* *query-gc*))
 
 

Modified: clfswm/src/config.lisp
==============================================================================
--- clfswm/src/config.lisp	(original)
+++ clfswm/src/config.lisp	Wed Oct  6 16:46:53 2010
@@ -221,8 +221,16 @@
   "Config(Query string group): Query string window font string")
 (defparameter *query-background* "black"
   "Config(Query string group): Query string window background color")
+(defparameter *query-message-color* "yellow"
+  "Config(Query string group): Query string window message color")
 (defparameter *query-foreground* "green"
   "Config(Query string group): Query string window foreground color")
+(defparameter *query-cursor-color* "white"
+  "Config(Query string group): Query string window foreground cursor color")
+(defparameter *query-parent-color* "blue"
+  "Config(Query string group): Query string window parenthesis color")
+(defparameter *query-parent-error-color* "red"
+  "Config(Query string group): Query string window parenthesis color when no match")
 (defparameter *query-border* "red"
   "Config(Query string group): Query string window border color")