Re: [patch] sawfish.wm.util.prompt

[Matthew Love <matth love gmail com>]

Jeremy Hankins <nowan nowan org> writes:

> First, it looks like prompt-for-file and prompt-for-directory need to be
> updated too -- if `existing' is false then `prompt-validation-fun' is
> nil.
>
> But I also have a concern about the original patch.  If I understand
> what's going on, instead of testing to see if there is, e.g., a
> validation/completion/whatever function provided, it actually calls it
> to see if it returns non-nil.  But there are times when calling the
> function may be expensive.  A common example might be accessing the
> filesystem, though caching may handle that case adequately, I don't
> know.  But I also have stuff that completes on menu entries, which could
> conceivably involve calling multiple other functions to expand submenus
> -- some of which (if I ever get it working right) may even involve
> communicating with other apps to fill in the menu.  Is there a way to
> silence the compiler warnings that doesn't involve extra calls to the
> prompt-*-fun functions?
>
> Sorry I didn't say something when the patch first passed through the
> list.

I think I may have found a solution, let me know what you all think of
this.

Instead of defining the orignal variable as a defvar or as a null
function, it seems the best route is to define it as a fluid variable, 
as that seems to be the best variable type for this kind of usage.

Attached are patches for the 3 files, prompt, prompt-extras and
prompt-wm, which impliment the prompt-*-fun's as fluid variables.

diff --git a/lisp/sawfish/wm/util/prompt.jl b/lisp/sawfish/wm/util/prompt.jl
index 845a90b..8e336ee 100644
--- a/lisp/sawfish/wm/util/prompt.jl
+++ b/lisp/sawfish/wm/util/prompt.jl
@@ -60,6 +60,7 @@
 	  sawfish.wm.commands
 	  sawfish.wm.fonts)
 
+
   (defgroup messages "Messages" :group misc)
 
   (defcustom prompt-font default-font
@@ -107,10 +108,10 @@ displayed. See the `display-message' function for more details.")
 
   (defvar prompt-result nil)
   (defvar prompt-prompt nil)
-  (defvar prompt-completion-fun (lambda (#!rest) nil))
-  (defvar prompt-validation-fun (lambda (#!rest) nil))
-  (defvar prompt-abbrev-fun (lambda (#!rest) nil))
-  (defvar prompt-display-fun (lambda (#!rest) nil))
+  (define prompt-completion-fun (make-fluid))
+  (define prompt-validation-fun (make-fluid))
+  (define prompt-abbrev-fun (make-fluid))
+  (define prompt-display-fun (make-fluid))
   (defvar prompt-position 0)
   (defvar prompt-completion-position nil)
   (defvar prompt-completions nil)
@@ -142,9 +143,9 @@ displayed. See the `display-message' function for more details.")
 
   (defun prompt-accept ()
     "End input and accept current string."
-    (let ((result (if (not (prompt-validation-fun prompt-result))
+    (let ((result (if (not (fluid prompt-validation-fun))
 		      prompt-result
-		    (prompt-validation-fun prompt-result))))
+		    ((fluid prompt-validation-fun) prompt-result))))
       (if result
 	  (progn
 	    (unless (or (null prompt-history)
@@ -259,10 +260,10 @@ displayed. See the `display-message' function for more details.")
 		(if (= new prompt-completion-position)
 		    0
 		  new)))
-      (when (prompt-completion-fun prompt-result)
+      (when (fluid prompt-completion-fun)
 	(let
 	    (compl)
-	  (setq prompt-completions (prompt-completion-fun prompt-result))
+	  (setq prompt-completions ((fluid prompt-completion-fun) prompt-result))
 	  (setq compl (complete-string prompt-result prompt-completions))
 	  (when compl
 	    (when (string= compl prompt-result)
@@ -288,15 +289,15 @@ displayed. See the `display-message' function for more details.")
 	(concat (and (/= prompt-completion-position 0) "[...]\n")
 		(apply concat (mapcar (lambda (x)
 					(format nil "%s\n"
-						(if (prompt-abbrev-fun x)
-						    (prompt-abbrev-fun x)
+						(if (fluid prompt-abbrev-fun)
+						    ((fluid prompt-abbrev-fun) x)
 						  x)))
 				      compl))
 		continued))))
 
   (defun prompt-update-display ()
-    (let ((result (if (prompt-display-fun prompt-result)
-		      (prompt-display-fun prompt-result)
+    (let ((result (if (fluid prompt-display-fun)
+		      ((fluid prompt-display-fun) prompt-result)
 		   prompt-result))
 	 (completions (prompt-format-completions)))
      (let
@@ -355,18 +356,18 @@ displayed. See the `display-message' function for more details.")
 	 (display-message nil)))))
 
   (defun prompt-for-symbol (#!optional title predicate validator)
-    (let ((prompt-completion-fun
-	      (lambda (x)
-		(mapcar symbol-name
-			(apropos (concat ?^ (quote-regexp x)) predicate))))
-	     (prompt-validation-fun
-	      (lambda (x)
-		(let
-		    ((symbol (intern x)))
-		  (if validator
-		      (and (validator symbol) symbol)
-		    symbol)))))
-      (prompt title)))
+    (let-fluids ((prompt-completion-fun
+		  (lambda (x)
+		    (mapcar symbol-name
+			    (apropos (concat ?^ (quote-regexp x)) predicate))))
+		 (prompt-validation-fun
+		  (lambda (x)
+		    (let
+			((symbol (intern x)))
+		      (if validator
+			  (and (validator symbol) symbol)
+			symbol)))))
+		(prompt title)))
 
   (defun prompt-for-function (#!optional title)
     "Prompt for a function."

diff --git a/lisp/sawfish/wm/util/prompt-extras.jl b/lisp/sawfish/wm/util/prompt-extras.jl
index 88c519d..3a89d72 100644
--- a/lisp/sawfish/wm/util/prompt-extras.jl
+++ b/lisp/sawfish/wm/util/prompt-extras.jl
@@ -91,13 +91,15 @@ allowed to be entered."
   (setq start (if (stringp start)
 		  (expand-file-name start)
 		(file-name-as-directory default-directory)))
-  (let* ((prompt-completion-fun prompt-complete-filename)
-	 (prompt-validation-fun (and existing prompt-validate-filename))
-	 (prompt-abbrev-fun prompt-abbreviate-filename)
-	 (str (prompt title start)))
-    (when (and (string= str "") default)
-      (setq str default))
-    str))
+  (let-fluids 
+   ((prompt-completion-fun prompt-complete-filename)
+    (prompt-validation-fun (and existing prompt-validate-filename))
+    (prompt-abbrev-fun prompt-abbreviate-filename))
+   (let* 
+       ((str (prompt title start)))
+     (when (and (string= str "") default)
+       (setq str default))
+     str)))
 
 (define (prompt-for-directory #!optional title existing start default)
   "Prompt for a directory, if EXISTING is t only files which exist are
@@ -106,29 +108,33 @@ allowed to be entered."
     (setq title "Enter filename:"))
   (unless (stringp start)
     (setq start (file-name-as-directory default-directory)))
-  (let* ((prompt-completion-fun prompt-complete-directory)
-	 (prompt-validation-fun (and existing prompt-validate-directory))
-	 (prompt-abbrev-fun prompt-abbreviate-filename)
-	 (str (prompt title start)))
-    (when (and (string= str "") default)
-      (setq str default))
-    str))
+  (let-fluids 
+   ((prompt-completion-fun prompt-complete-filename)
+    (prompt-validation-fun (and existing prompt-validate-filename))
+    (prompt-abbrev-fun prompt-abbreviate-filename))
+   (let*
+       ((str (prompt title start)))
+     (when (and (string= str "") default)
+       (setq str default))
+     str)))
 
 (define (prompt-from-list options title #!optional start dont-validate)
   "Return a selected choice from the list of options (strings) OPTIONS.
 PROMPT is the title displayed, START the starting choice.
 Unless DONT-VALIDATE is t, only a member of PROMPT-LIST will be returned."
-  (let ((prompt-list options)
-	(prompt-completion-fun prompt-complete-from-list)
-	(prompt-validation-fun (if dont-validate
-				   nil
-				 prompt-validate-from-list)))
-    (prompt title start)))
+  (let ((prompt-list options))
+    (let-fluids 
+     ((prompt-completion-fun prompt-complete-from-list)
+      (prompt-validation-fun (if dont-validate
+				 nil
+			       prompt-validate-from-list)))
+     (prompt title start))))
 
 (define (prompt-for-string #!optional title start)
-  (let ((prompt-completion-fun prompt-complete-filename)
-	(prompt-validation-fun nil))
-    (prompt (or title "Enter string: ") start)))
+  (let-fluids 
+   ((prompt-completion-fun prompt-complete-filename)
+    (prompt-validation-fun nil))
+   (prompt (or title "Enter string: ") start)))
 
 (define (prompt-for-number #!optional title)
   (let (num)
@@ -137,7 +143,9 @@ Unless DONT-VALIDATE is t, only a member of PROMPT-LIST will be returned."
     num))
 
 (define (pwd-prompt title)
-  (let ((prompt-display-fun (lambda (string)
-			     (make-string (length string) ?*)))
-	(prompt-history nil))
-    (prompt-for-string title)))
+  (let-fluids 
+   ((prompt-display-fun (lambda (string)
+			  (make-string (length string) ?*))))
+   (let
+       ((prompt-history nil))
+   (prompt-for-string title))))

diff --git a/lisp/sawfish/wm/util/prompt-wm.jl b/lisp/sawfish/wm/util/prompt-wm.jl
index 45067d1..882e902 100644
--- a/lisp/sawfish/wm/util/prompt-wm.jl
+++ b/lisp/sawfish/wm/util/prompt-wm.jl
@@ -43,16 +43,18 @@
               (when names
                 (if (string-match re (car names))
                     (cons (car names) (names-matching re (cdr names)))
-                  (names-matching re (cdr names))))))
-           (prompt-completion-fun
-            (lambda (text)
-              (names-matching (format nil "^%s" text)
-                              (sort (window-names (managed-windows)))))))
-    (let ((window-title (prompt (or title (_ "Window:")))))
-      (unless (zerop (length window-title))
-        (cdr (assoc window-title (mapcar (lambda (w)
-					   (cons (window-name w) w))
-					 (managed-windows))))))))
+                  (names-matching re (cdr names)))))))
+    (let-fluids
+     ((prompt-completion-fun
+       (lambda (text)
+	 (names-matching (format nil "^%s" text)
+			 (sort (window-names (managed-windows)))))))
+     (let 
+	 ((window-title (prompt (or title (_ "Window:")))))
+       (unless (zerop (length window-title))
+	 (cdr (assoc window-title (mapcar (lambda (w)
+					    (cons (window-name w) w))
+					  (managed-windows)))))))))
 
 (define (prompt-for-workspace #!optional title)
   "Prompt for a workspace title, return the workspace number."
@@ -70,13 +72,14 @@
               (when names
                 (if (string-match re (car names))
                     (cons (car names) (names-matching re (cdr names)))
-                  (names-matching re (cdr names))))))
-           (prompt-completion-fun
-            (lambda (text)
-              (names-matching (format nil "^%s" text) (workspaces)))))
-    (let ((ws-title (prompt (or title (_ "Workspace:"))))
-          (wsl (workspaces)))
-      (unless (zerop (length ws-title))
-        (let ((where (member ws-title wsl)))
-          (when where
-            (- (length wsl) (length where))))))))
+                  (names-matching re (cdr names)))))))
+    (let-fluids
+     ((prompt-completion-fun
+       (lambda (text)
+	 (names-matching (format nil "^%s" text) (workspaces)))))
+     (let ((ws-title (prompt (or title (_ "Workspace:"))))
+	   (wsl (workspaces)))
+       (unless (zerop (length ws-title))
+	 (let ((where (member ws-title wsl)))
+	   (when where
+	     (- (length wsl) (length where)))))))))


-- 
Matthew Love