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

Philippe Brochard pbrochard at common-lisp.net
Sat Oct 30 20:18:56 UTC 2010


Author: pbrochard
Date: Sat Oct 30 16:18:55 2010
New Revision: 371

Log:
src/clfswm-query.lisp (query-print-string): Handle long lines correctly.

Modified:
   clfswm/ChangeLog
   clfswm/TODO
   clfswm/src/bindings-second-mode.lisp
   clfswm/src/bindings.lisp
   clfswm/src/clfswm-query.lisp

Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog	(original)
+++ clfswm/ChangeLog	Sat Oct 30 16:18:55 2010
@@ -1,3 +1,8 @@
+2010-10-30  Philippe Brochard  <pbrochard at common-lisp.net>
+
+	* src/clfswm-query.lisp (query-print-string): Handle long lines
+	correctly.
+
 2010-10-27  Philippe Brochard  <pbrochard at common-lisp.net>
 
 	* src/clfswm-expose-mode.lisp (expose-create-window): Ensure that

Modified: clfswm/TODO
==============================================================================
--- clfswm/TODO	(original)
+++ clfswm/TODO	Sat Oct 30 16:18:55 2010
@@ -10,6 +10,7 @@
 - handle cursor with too long lines in info mode
 - info mode: complet on [tab] without living the info mode.
 
+- Make frame/window border size variable.
 
 MAYBE
 =====

Modified: clfswm/src/bindings-second-mode.lisp
==============================================================================
--- clfswm/src/bindings-second-mode.lisp	(original)
+++ clfswm/src/bindings-second-mode.lisp	Sat Oct 30 16:18:55 2010
@@ -78,7 +78,6 @@
 	 (leave-second-mode))))
 
 
-
 (defun set-default-second-keys ()
   (define-second-key ("F1" :mod-1) 'help-on-clfswm)
   (define-second-key ("m") 'open-menu)

Modified: clfswm/src/bindings.lisp
==============================================================================
--- clfswm/src/bindings.lisp	(original)
+++ clfswm/src/bindings.lisp	Sat Oct 30 16:18:55 2010
@@ -35,6 +35,9 @@
 (add-hook *binding-hook* 'init-*main-keys* 'init-*main-mouse*)
 
 
+(defun test-hello ()
+  (info-mode '("Hello" "World")))
+
 
 (defun help-on-clfswm ()
   "Open the help and info window"

Modified: clfswm/src/clfswm-query.lisp
==============================================================================
--- clfswm/src/clfswm-query.lisp	(original)
+++ clfswm/src/clfswm-query.lisp	Sat Oct 30 16:18:55 2010
@@ -39,7 +39,7 @@
 
 
 
-(defun query-show-paren (orig-string pos)
+(defun query-show-paren (orig-string pos dec)
   "Replace matching parentheses with brackets"
   (let ((string (copy-seq orig-string)))
     (labels ((have-to-find-right? ()
@@ -61,7 +61,7 @@
 	     (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*)))
+				    (+ 10 (* p (xlib:max-char-width *query-font*)) dec)
 				    (+ (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*))
@@ -98,26 +98,28 @@
 
 
 (defun query-print-string ()
-  (clear-pixmap-buffer *query-window* *query-gc*)
-  (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-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*))
+  (let ((dec (min 0 (- (- (xlib:drawable-width *query-window*) 10)
+		       (+ 10 (* *query-pos* (xlib:max-char-width *query-font*)))))))
+    (clear-pixmap-buffer *query-window* *query-gc*)
+    (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* dec)
+    (setf (xlib:gcontext-foreground *query-gc*) (get-color *query-foreground*))
+    (xlib:draw-glyphs *pixmap-buffer* *query-gc*
+		      (+ 10 dec)
+		      (+ (* 2 (+ (xlib:max-char-ascent *query-font*) (xlib:max-char-descent *query-font*))) 5)
+		      *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*)) dec)
+		    (+ (* 2 (+ (xlib:max-char-ascent *query-font*) (xlib:max-char-descent *query-font*))) 6)
+		    (+ 10 (* *query-pos* (xlib:max-char-width *query-font*)) dec)
+		    (+ (* 1 (+ (xlib:max-char-ascent *query-font*) (xlib:max-char-descent *query-font*))) 7))
+    (copy-pixmap-buffer *query-window* *query-gc*)))
 
 
 




More information about the clfswm-cvs mailing list