[clfswm-cvs] CVS clfswm

pbrochard pbrochard at common-lisp.net
Tue Jan 1 21:44:17 UTC 2008


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

Modified Files:
	ChangeLog clfswm-util.lisp 
Log Message:
Bind control+k to delete end of line in query-string

--- /project/clfswm/cvsroot/clfswm/ChangeLog	2008/01/01 21:24:47	1.11
+++ /project/clfswm/cvsroot/clfswm/ChangeLog	2008/01/01 21:44:16	1.12
@@ -2,6 +2,7 @@
 
 	* clfswm-util.lisp (query-show-paren): Add show parent matching in
 	query string.
+	(query-string): Bind control+k to delete end of line.
 
 	* clfswm-second-mode.lisp (draw-second-mode-window): Display
 	the action on mouse motion in second mode.
--- /project/clfswm/cvsroot/clfswm/clfswm-util.lisp	2008/01/01 21:24:47	1.8
+++ /project/clfswm/cvsroot/clfswm/clfswm-util.lisp	2008/01/01 21:44:16	1.9
@@ -1,7 +1,7 @@
 ;;; --------------------------------------------------------------------------
 ;;; CLFSWM - FullScreen Window Manager
 ;;;
-;;; #Date#: Tue Jan  1 22:22:10 2008
+;;; #Date#: Tue Jan  1 22:39:40 2008
 ;;;
 ;;; --------------------------------------------------------------------------
 ;;; Documentation: Utility
@@ -558,6 +558,8 @@
 		       (setf result-string (concatenate 'string
 							(subseq result-string 0 pos)
 							(subseq result-string del-pos))))))
+	       (call-delete-eof ()
+		 (setf result-string (subseq result-string 0 pos)))
 	       (handle-query-key (&rest event-slots &key root code state &allow-other-keys)
 		 (declare (ignore event-slots root))
 		 (let* ((modifiers (make-state-keys state))
@@ -569,15 +571,7 @@
 		   (setf done (cond ((string-equal keysym-name "Return") :Return)
 				    ((string-equal keysym-name "Escape") :Escape)
 				    (t nil)))
-		   (cond ((and (characterp char) (standard-char-p char))
-			  (setf result-string (concatenate 'string
-							   (when (<= pos (length result-string))
-							     (subseq result-string 0 pos))
-							   (string char)
-							   (when (< pos (length result-string))
-							     (subseq result-string pos))))
-			  (incf pos))
-			 ((string-equal keysym-name "Left")
+		   (cond ((string-equal keysym-name "Left")
 			  (when (> pos 0)
 			    (setf pos (if (member :control modifiers)
 					  (let ((p (position #\Space result-string
@@ -603,7 +597,17 @@
 			 ((string-equal keysym-name "Home") (setf pos 0))
 			 ((string-equal keysym-name "End") (setf pos (length result-string)))
 			 ((string-equal keysym-name "Backspace") (call-backspace modifiers))
-			 ((string-equal keysym-name "Delete") (call-delete modifiers)))
+			 ((string-equal keysym-name "Delete") (call-delete modifiers))
+			 ((and (string-equal keysym-name "k") (member :control modifiers))
+			  (call-delete-eof))
+			 ((and (characterp char) (standard-char-p char))
+			  (setf result-string (concatenate 'string
+							   (when (<= pos (length result-string))
+							     (subseq result-string 0 pos))
+							   (string char)
+							   (when (< pos (length result-string))
+							     (subseq result-string pos))))
+			  (incf pos)))
 		   (print-string)))
 	       (handle-query (&rest event-slots &key display event-key &allow-other-keys)
 		 (declare (ignore display))




More information about the clfswm-cvs mailing list