[clfswm-cvs] CVS clfswm

[pbrochard]

Update of /project/clfswm/cvsroot/clfswm
In directory clnet:/tmp/cvs-serv19527

Modified Files:
	ChangeLog clfswm-util.lisp 
Log Message:
Add show parent matching in query string

--- /project/clfswm/cvsroot/clfswm/ChangeLog	2008/01/01 19:13:44	1.10
+++ /project/clfswm/cvsroot/clfswm/ChangeLog	2008/01/01 21:24:47	1.11
@@ -1,5 +1,8 @@
 2008-01-01  Philippe Brochard  <hocwp at free.fr>
 
+	* clfswm-util.lisp (query-show-paren): Add show parent matching in
+	query string.
+
 	* clfswm-second-mode.lisp (draw-second-mode-window): Display
 	the action on mouse motion in second mode.
 
--- /project/clfswm/cvsroot/clfswm/clfswm-util.lisp	2007/12/30 12:03:36	1.7
+++ /project/clfswm/cvsroot/clfswm/clfswm-util.lisp	2008/01/01 21:24:47	1.8
@@ -1,7 +1,7 @@
 ;;; --------------------------------------------------------------------------
 ;;; CLFSWM - FullScreen Window Manager
 ;;;
-;;; #Date#: Sun Dec 30 12:59:59 2007
+;;; #Date#: Tue Jan  1 22:22:10 2008
 ;;;
 ;;; --------------------------------------------------------------------------
 ;;; Documentation: Utility
@@ -476,6 +476,34 @@
 
 
 
+(defun query-show-paren (orig-string pos)
+  "Replace matching parentheses with brackets"
+  (let ((string (copy-seq orig-string))) 
+    (labels ((have-to-find-right? ()
+	       (and (< pos (length string)) (char= (aref string pos) #\()))
+	     (have-to-find-left? ()
+	       (and (> (1- pos) 0) (char= (aref string (1- pos)) #\))))
+	     (pos-right ()
+	       (loop :for p :from (1+ pos) :below (length string)
+		  :with level = 1   :for c = (aref string p)
+		  :do (when (char= c #\() (incf level))
+		  (when (char= c #\)) (decf level))
+		  (when (= level 0) (return p))))
+	     (pos-left ()
+	       (loop :for p :from (- pos 2) :downto 0
+		  :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)))
+
+
 ;;; CONFIG - Query string mode
 (let ((history nil))
   (defun clear-history ()
@@ -503,15 +531,16 @@
 	   (result-string default)
 	   (pos (length default))
 	   (local-history history))
-      (labels ((print-string ()
+      (labels ((add-cursor (string)
+		 (concatenate 'string (subseq string 0 pos) "|" (subseq string pos)))
+	       (print-string ()
 		 (clear-area window)
 		 (setf (gcontext-foreground gc) (get-color *query-foreground*))
 		 (draw-image-glyphs window gc 5 (+ (max-char-ascent font) 5) msg)
 		 (when (< pos 0) (setf pos 0))
 		 (when (> pos (length result-string)) (setf pos (length result-string)))
 		 (draw-image-glyphs window gc 10 (+ (* 2 (+ (max-char-ascent font) (max-char-descent font))) 5)
-				    (concatenate 'string (subseq result-string 0 pos)
-						 "|" (subseq result-string pos))))
+				    (add-cursor (query-show-paren result-string pos))))
 	       (call-backspace (modifiers)
 		 (let ((del-pos (if (member :control modifiers)
 				    (or (position #\Space result-string :from-end t :end pos) 0)