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

[Philippe Brochard]

Author: pbrochard
Date: Sun Feb 27 17:13:46 2011
New Revision: 416

Log:
src/clfswm-util.lisp (query-yes-or-no): New function.

Modified:
   clfswm/ChangeLog
   clfswm/src/clfswm-configuration.lisp
   clfswm/src/clfswm-layout.lisp
   clfswm/src/clfswm-util.lisp

Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog	(original)
+++ clfswm/ChangeLog	Sun Feb 27 17:13:46 2011
@@ -1,5 +1,7 @@
 2011-02-27  Philippe Brochard  <pbrochard at common-lisp.net>
 
+	* src/clfswm-util.lisp (query-yes-or-no): New function.
+
 	* src/clfswm-configuration.lisp (reset-all-config-variables): New
 	function and menu entry.
 	(query-conf-value): Add the ability to leave the field blank to

Modified: clfswm/src/clfswm-configuration.lisp
==============================================================================
--- clfswm/src/clfswm-configuration.lisp	(original)
+++ clfswm/src/clfswm-configuration.lisp	Sun Feb 27 17:13:46 2011
@@ -137,20 +137,13 @@
   (labels ((warn-wrong-type (result original)
 	     (if (equal (simple-type-of result) (simple-type-of original))
 		 result
-		 (if (string-equal
-		      (query-string
-		       (format nil "~S and ~S are not of the same type (~A and ~A). Do you really want to use this value?"
-			       result original (type-of result) (type-of original))
-		       "" '("yes" "no"))
-		      "yes")
+		 (if (query-yes-or-no "~S and ~S are not of the same type (~A and ~A). Do you really want to use this value?"
+				      result original (type-of result) (type-of original))
 		     result
 		     original)))
 	   (ask-set-default-value (original-val)
 	     (let ((default (extract-config-default-value var)))
-	       (if (string-equal
-		    (query-string (format nil "Reset ~A from ~A to ~A?" var original default)
-				  "" '("yes" "no"))
-		    "yes")
+	       (if (query-yes-or-no "Reset ~A from ~A to ~A?" var original default)
 		   (get-config-value default)
 		   original-val))))
     (multiple-value-bind (result return)
@@ -239,11 +232,7 @@
 
 (defun reset-all-config-variables ()
   "Reset all configuration variables to there default values"
-  (when (string-equal
-	 (query-string
-	  "Do you really want to reset all values to there default?"
-	  "" '("yes" "no"))
-	 "yes")
+  (when (query-yes-or-no "Do you really want to reset all values to there default?")
     (with-all-internal-symbols (symbol :clfswm)
       (when (is-config-p symbol)
 	(reset-config-to-default-value symbol))))

Modified: clfswm/src/clfswm-layout.lisp
==============================================================================
--- clfswm/src/clfswm-layout.lisp	(original)
+++ clfswm/src/clfswm-layout.lisp	Sun Feb 27 17:13:46 2011
@@ -188,12 +188,9 @@
 ;;; Tile layout
 (defun tile-layout-ask-keep-position ()
   (when (frame-p *current-child*)
-    (let ((keep-position (query-string "Keep frame children positions?" "" '("yes" "no"))))
-      (if (or (string= keep-position "")
-	      (char= (char keep-position 0) #\y)
-	      (char= (char keep-position 0) #\Y))
-	  (setf (frame-data-slot *current-child* :tile-layout-keep-positiion) :yes)
-	  (remove-frame-data-slot *current-child* :tile-layout-keep-positiion)))))
+    (if (query-yes-or-no "Keep frame children positions?")
+	(setf (frame-data-slot *current-child* :tile-layout-keep-positiion) :yes)
+	(remove-frame-data-slot *current-child* :tile-layout-keep-positiion))))
 
 
 (defun set-layout-managed-children ()

Modified: clfswm/src/clfswm-util.lisp
==============================================================================
--- clfswm/src/clfswm-util.lisp	(original)
+++ clfswm/src/clfswm-util.lisp	Sun Feb 27 17:13:46 2011
@@ -64,6 +64,14 @@
 
 
 
+(defun query-yes-or-no (formatter &rest args)
+  (let ((rep (query-string (apply #'format nil formatter args) "" '("yes" "no"))))
+    (or (string= rep "")
+	(char= (char rep 0) #\y)
+	(char= (char rep 0) #\Y))))
+
+
+
 
 (defun rename-current-child ()
   "Rename the current child"