[sawfish/prompt] sawfish.wm.util.prompt now requires that helper functions be passed explicitly.

From: Jeremy Hankins <jjhankins src gnome org>
To: commits-list gnome org
Cc:
Subject: [sawfish/prompt] sawfish.wm.util.prompt now requires that helper functions be passed explicitly.
Date: Sun, 6 Jun 2010 01:42:00 +0000 (UTC)
commit 49672b617d9ccb4e61341cd6687c3bc0407498bc
Author: Jeremy Hankins <nowan nowan org>
Date:   Sat Jun 5 20:33:02 2010 -0500

    sawfish.wm.util.prompt now requires that helper functions be passed explicitly.

 ChangeLog                             |    8 ++
 lisp/sawfish/wm/util/prompt-extras.jl |   91 +++++++++------
 lisp/sawfish/wm/util/prompt-wm.jl     |   10 +-
 lisp/sawfish/wm/util/prompt.jl        |  209 +++++++++++++++++----------------
 man/news.texi                         |    7 +
 5 files changed, 185 insertions(+), 140 deletions(-)
---
diff --git a/ChangeLog b/ChangeLog
index cb28800..322ba78 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,11 @@
+2010-05-23  Jeremy Hankins <nowan nowan org>
+	* lisp/sawfish/wm/util/prompt-extras.jl
+	* lisp/sawfish/wm/util/prompt-wm.jl
+	* lisp/sawfish/wm/util/prompt.jl: Changed the way prompt is called:
+		helper functions are now passed directly instead of implicitly
+		via let statements.  Also reverts the previous compilation error
+		fix, since it's no longer necessary.
+
 2010-05-28  Jeremy Hankins <nowan nowan org>
 	* lisp/sawfish/wm/util/prompt.jl: Fix compilation error
 	                 -- [Harald van Dijk]
diff --git a/lisp/sawfish/wm/util/prompt-extras.jl b/lisp/sawfish/wm/util/prompt-extras.jl
index 1d1fe05..1b5b8b4 100644
--- a/lisp/sawfish/wm/util/prompt-extras.jl
+++ b/lisp/sawfish/wm/util/prompt-extras.jl
@@ -24,6 +24,13 @@
 
 (require 'rep.io.files)
 
+(defvar prompt-list-fold-case nil
+  "Whether prompt-from-list should ignore case.")
+
+(defvar prompt-file-exclude '"\\.(o|jlc|x)$|~$|^#.*#$|^\\.\\.?$"
+  "A regexp, if it matches the file being considered for completion, the file
+is rejected.")
+
 ;;; completion/validation functions
 
 (define (prompt-complete-filename word)
@@ -64,24 +71,27 @@
 	 (file-name-nondirectory (directory-file-name name)))
       abbrev)))
 
-(define (prompt-complete-from-list word)
-  (let (out)
-    (mapc (lambda (x)
-	    (when (string-match (concat ?^ (quote-regexp word))
-				x nil prompt-list-fold-case)
-	      (setq out (cons x out)))) prompt-list)
-    out))
-
-(define (prompt-validate-from-list name)
-  (if (null prompt-list-fold-case)
-      (and (member name prompt-list) name)
-    (catch 'exit
+(define (prompt-list-completor prompt-list)
+  (lambda (word)
+    (let (out)
       (mapc (lambda (x)
-	      (when (string-match (concat ?^ (quote-regexp name) ?$) x nil t)
-		(throw 'exit name))) prompt-list))))
+              (when (string-match (concat ?^ (quote-regexp word))
+                                  x nil prompt-list-fold-case)
+                (setq out (cons x out)))) prompt-list)
+      out)))
+
+(define (prompt-list-validator prompt-list)
+  (lambda (name)
+    (if (null prompt-list-fold-case)
+        (and (member name prompt-list) name)
+      (catch 'exit
+        (mapc (lambda (x)
+                (when (string-match (concat ?^ (quote-regexp name) ?$) x nil t)
+                  (throw 'exit name))) prompt-list)))))
 
 ;;; entry points
 
+(define filename-history (prompt-make-history))
 (define (prompt-for-file #!optional title existing start default)
   "Prompt for a file, if EXISTING is t only files which exist are
 allowed to be entered."
@@ -90,14 +100,17 @@ 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)))
+  (let ((str (prompt #:title title
+                     #:start start
+                     #:completion-fun prompt-complete-filename
+                     #:validation-fun (and existing prompt-validate-filename)
+                     #:abbrev-fun prompt-abbreviate-filename
+                     #:history filename-history)))
     (when (and (string= str "") default)
       (setq str default))
     str))
 
+(define directory-name-history (prompt-make-history))
 (define (prompt-for-directory #!optional title existing start default)
   "Prompt for a directory, if EXISTING is t only files which exist are
 allowed to be entered."
@@ -105,10 +118,12 @@ 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)))
+  (let ((str (prompt #:title title
+                     #:start start
+                     #:completion-fun prompt-complete-directory
+                     #:validation-fun (and existing prompt-validate-directory)
+                     #:abbrev-fun prompt-abbreviate-filename
+                     #:history directory-name-history)))
     (when (and (string= str "") default)
       (setq str default))
     str))
@@ -117,26 +132,30 @@ allowed to be entered."
   "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)))
+  (prompt #:title title
+          #:start start
+          #:completion-fun (prompt-list-completor options)
+          #:validation-fun (if dont-validate
+                               nil
+                             (prompt-list-validator options))))
 
 (define (prompt-for-string #!optional title start)
-  (let ((prompt-completion-fun prompt-complete-filename)
-	(prompt-validation-fun nil))
-    (prompt (or title "Enter string: ") start)))
+  (prompt #:title (or title "Enter string: ")
+          #:start start
+          ;; XXX: Why is this completing on files???
+          #:completion-fun prompt-complete-filename))
 
 (define (prompt-for-number #!optional title)
   (let (num)
     (while (not (numberp num))
-      (setq num (read-from-string (prompt (or title "Enter number: ")))))
+      (setq num (read-from-string (prompt
+                                   #:title (or title "Enter number: ")))))
     num))
 
 (define (pwd-prompt title)
-  (let ((prompt-display-fun (lambda (string)
-                              (make-string (length string) ?*)))
-	(prompt-history nil))
-    (prompt-for-string title)))
+  "Prompt for a string, hiding the string behind asterisks (e.g., for
+a password)."
+  (prompt #:title title
+          #:history (make-fluid) ; Disable history
+          #:display-fun (lambda (string)
+                          (make-string (length string) ?*))))
diff --git a/lisp/sawfish/wm/util/prompt-wm.jl b/lisp/sawfish/wm/util/prompt-wm.jl
index 7d9e746..45f6096 100644
--- a/lisp/sawfish/wm/util/prompt-wm.jl
+++ b/lisp/sawfish/wm/util/prompt-wm.jl
@@ -43,11 +43,12 @@
                 (if (string-match re (car names))
                     (cons (car names) (names-matching re (cdr names)))
                   (names-matching re (cdr names))))))
-           (prompt-completion-fun
+           (complete-windows
             (lambda (text)
               (names-matching (format nil "^%s" text)
                               (sort (window-names (managed-windows)))))))
-    (let ((window-title (prompt (or title (_ "Window:")))))
+    (let ((window-title (prompt #:title (or title (_ "Window:"))
+                                #:completion-fun complete-windows)))
       (unless (zerop (length window-title))
         (cdr (assoc window-title (mapcar (lambda (w)
 					   (cons (window-name w) w))
@@ -70,10 +71,11 @@
                 (if (string-match re (car names))
                     (cons (car names) (names-matching re (cdr names)))
                   (names-matching re (cdr names))))))
-           (prompt-completion-fun
+           (complete-workspaces
             (lambda (text)
               (names-matching (format nil "^%s" text) (workspaces)))))
-    (let ((ws-title (prompt (or title (_ "Workspace:"))))
+    (let ((ws-title (prompt #:title (or title (_ "Workspace:"))
+                            #:completion-fun complete-workspaces))
           (wsl (workspaces)))
       (unless (zerop (length ws-title))
         (let ((where (member ws-title wsl)))
diff --git a/lisp/sawfish/wm/util/prompt.jl b/lisp/sawfish/wm/util/prompt.jl
index ccbbe85..50e6366 100644
--- a/lisp/sawfish/wm/util/prompt.jl
+++ b/lisp/sawfish/wm/util/prompt.jl
@@ -19,6 +19,7 @@
 	    prompt-for-function
 	    prompt-for-variable
 	    prompt-for-command
+            prompt-make-history
 
 	    ;; motion / editing commands
 	    prompt-backward-character
@@ -85,51 +86,31 @@
     "Regexp that determines which characters are to be considered part
 of a word when moving.")
 
-  (defvar prompt-file-exclude '"\\.(o|jlc|x)$|~$|^#.*#$|^\\.\\.?$"
-    "A regexp, if it matches the file being considered for completion,
-the file is rejected.")
-
-  (defvar prompt-list nil
-    "List of possible entries for prompt-from-list.")
-
-  (defvar prompt-list-fold-case nil
-    "Whether prompt-from-list should ignore case.")
-
-  (defvar prompt-history (make-ring 16)
-    "Ring buffer containing strings most-recently entered through the `prompt'
-function.")
-
   (defvar prompt-window-position
     (cons (- (quotient (screen-width) 2) 200) -200)
     "A cons cell defining the screen position at which the `prompt' window is
 displayed. See the `display-message' function for more details.")
 
-  (defvar prompt-result nil)
-  (defvar prompt-prompt nil)
-  (defvar prompt-completion-fun nil)
-  (defvar prompt-validation-fun nil)
-  (defvar prompt-abbrev-fun nil)
-  (defvar prompt-display-fun nil)
-  (defvar prompt-position 0)
-  (defvar prompt-completion-position nil)
-  (defvar prompt-completions nil)
-  (defvar prompt-completions-outdated nil)
-  (defvar prompt-history-pos nil)
-  (defvar prompt-saved nil)
-  (defvar prompt-attr nil)
-
-  ;; Compilation hack: ensure that the compiler doesn't complain when
-  ;; these are treated like functions and passed values.
-  (eval-when-compile
-    (progn
-      (defvar prompt-completion-fun nil)
-      (defvar prompt-validation-fun nil)
-      (defvar prompt-abbrev-fun nil)
-      (defvar prompt-display-fun nil)
-      (setq prompt-completion-fun (lambda (#!rest) nil)
-            prompt-validation-fun (lambda (#!rest) nil)
-            prompt-abbrev-fun (lambda (#!rest) nil)
-            prompt-display-fun (lambda (#!rest) nil))))
+  (define (prompt-make-history)
+    "Make a receptacle for prompt history."
+    (make-fluid (make-ring 16)))
+
+  ;; Internal variables:
+  (define prompt-history-default (prompt-make-history))
+  (define prompt-history nil)
+  (define prompt-result nil)
+  (define prompt-prompt nil)
+  (define prompt-completion-fun nil)
+  (define prompt-validation-fun nil)
+  (define prompt-abbrev-fun nil)
+  (define prompt-display-fun nil)
+  (define prompt-position 0)
+  (define prompt-completion-position nil)
+  (define prompt-completions nil)
+  (define prompt-completions-outdated nil)
+  (define prompt-history-pos nil)
+  (define prompt-saved nil)
+  (define prompt-attr nil)
 
 
   ;; From merlin
@@ -149,11 +130,11 @@ displayed. See the `display-message' function for more details.")
         (assq key alist)
       (cons key default)))
 
-  (defun prompt-exit ()
+  (define (prompt-exit)
     "Cancel string input."
     (throw 'prompt-exit nil))
 
-  (defun prompt-accept ()
+  (define (prompt-accept)
     "End input and accept current string."
     (let ((result (if (not prompt-validation-fun)
 		      prompt-result
@@ -166,7 +147,7 @@ displayed. See the `display-message' function for more details.")
 	    (throw 'prompt-exit result))
 	(beep))))
 
-  (defun prompt-next (count)
+  (define (prompt-next count)
     (interactive "p")
     (when prompt-history
       (setq count (- prompt-history-pos count))
@@ -185,21 +166,21 @@ displayed. See the `display-message' function for more details.")
       (prompt-end-of-line)
       (prompt-update-display)))
 
-  (defun prompt-previous (count)
+  (define (prompt-previous count)
     (interactive "p")
     (prompt-next (- count)))
 
-  (defun prompt-changed ()
+  (define (prompt-changed)
     (setq prompt-completions-outdated t))
 
-  (defun prompt-clear ()
+  (define (prompt-clear)
     "Clear input buffer."
     (setq prompt-result "")
     (setq prompt-position 0)
     (prompt-changed)
     (prompt-update-display))
 
-  (defun prompt-backspace ()
+  (define (prompt-backspace)
     "Remove previous character from buffer."
     (when (> prompt-position 0)
       (let ((cutoff (max (- prompt-position 1) 0)))
@@ -210,20 +191,20 @@ displayed. See the `display-message' function for more details.")
 	(prompt-changed)
 	(prompt-update-display))))
 
-  (defun prompt-kill-line ()
+  (define (prompt-kill-line)
     "Delete rest of line."
     (setq prompt-result (substring prompt-result 0 prompt-position))
     (prompt-changed)
     (prompt-update-display))
 
-  (defun prompt-move (num)
+  (define (prompt-move num)
     "Move NUM characters forward or backward."
     (let ((new-pos (+ prompt-position num)))
       (and (>= new-pos 0) (<= new-pos (length prompt-result))
 	   (setq prompt-position new-pos)
 	   (prompt-update-display))))
 
-  (defun prompt-forward-word ()
+  (define (prompt-forward-word)
     "Move to next non-word character."
     (setq prompt-position (1+ prompt-position))
     (while (and (< prompt-position (length prompt-result))
@@ -234,7 +215,7 @@ displayed. See the `display-message' function for more details.")
 			       (length prompt-result)))
     (prompt-update-display))
 
-  (defun prompt-backward-word ()
+  (define (prompt-backward-word)
     "Move to previous non-word character."
     (setq prompt-position (1- prompt-position))
     (while (and (> prompt-position 0)
@@ -244,25 +225,25 @@ displayed. See the `display-message' function for more details.")
     (setq prompt-position (max prompt-position 0))
     (prompt-update-display))
 
-  (defun prompt-forward-character ()
+  (define (prompt-forward-character)
     "Move forward one character."
     (prompt-move 1))
 
-  (defun prompt-backward-character ()
+  (define (prompt-backward-character)
     "Move backward one character."
     (prompt-move -1))
 
-  (defun prompt-beginning-of-line ()
+  (define (prompt-beginning-of-line)
     "Move to beginning of line."
     (setq prompt-position 0)
     (prompt-update-display))
 
-  (defun prompt-end-of-line ()
+  (define (prompt-end-of-line)
     "Move to end of line."
     (setq prompt-position (length prompt-result))
     (prompt-update-display))
 
-  (defun prompt-complete ()
+  (define (prompt-complete)
     (if (and (not prompt-completions-outdated) prompt-completion-position)
 	(let
 	    ((new (min (max 0 (- (length prompt-completions)
@@ -290,7 +271,7 @@ displayed. See the `display-message' function for more details.")
 	      (setq prompt-completion-position 0))))))
     (prompt-update-display))
 
-  (defun prompt-format-completions ()
+  (define (prompt-format-completions)
     (when (numberp prompt-completion-position)
       (let ((compl (nthcdr prompt-completion-position prompt-completions))
 	    (continued nil))
@@ -307,7 +288,7 @@ displayed. See the `display-message' function for more details.")
 				      compl))
 		continued))))
 
-  (defun prompt-update-display ()
+  (define (prompt-update-display)
     (let ((result (if prompt-display-fun
 		      (prompt-display-fun prompt-result)
                     prompt-result))
@@ -334,7 +315,7 @@ displayed. See the `display-message' function for more details.")
            )))))
 
   ;; Insert all unbound keys to result.
-  (defun prompt-unbound-callback ()
+  (define (prompt-unbound-callback)
     (let ((key (current-event-string)))
       (setq prompt-result
 	    (concat (substring prompt-result 0 prompt-position)
@@ -345,8 +326,20 @@ displayed. See the `display-message' function for more details.")
       (prompt-update-display)
       t))
 
-  (defun prompt (#!optional title start attributes)
-    "Prompt the user for a string."
+  (define (prompt #!key title start attributes completion-fun
+                  validation-fun abbrev-fun display-fun history)
+    "Prompt the user for a string.  All of the keyword options are
+optional and have reasonable defaults.
+
+ - `title' is the message displayed to prompt the user.
+ - `start' is an initial string automatically entered into the prompt.
+ - `attributes' can be used to set text attributes.
+ - `completion-fun' is a function used for tab completion.
+ - `validation-fun' is a function that checks input for validity.
+ - `abbrev-fun' is used to abbreviate possible completions for display.
+ - `display-fun' can be used to change the way entered text is displayed.
+ - `history' contains history.  Use `prompt-make-history' to generate
+   an appropriate value."
     (unless (stringp title)
       (setq title "Enter string:"))
     (unless (string-match " $" title)
@@ -354,52 +347,68 @@ displayed. See the `display-message' function for more details.")
     (call-with-keyboard-grabbed
      (lambda ()
        (unwind-protect
-	   (let* ((override-keymap prompt-keymap)
-		  (prompt-result (or start ""))
-		  (prompt-prompt title)
-		  (prompt-position (length prompt-result))
-		  (prompt-history-pos 0)
-		  (prompt-saved nil)
-		  (prompt-attr attributes)
-		  (prompt-completion-position nil)
-		  (prompt-completions nil)
-		  (prompt-completions-outdated t)
-		  (unbound-key-hook (list prompt-unbound-callback)))
+           (let ((override-keymap prompt-keymap)
+                 (unbound-key-hook (list prompt-unbound-callback)))
+             (setq prompt-history (fluid (or history
+                                             prompt-history-default))
+                   prompt-completion-fun completion-fun
+                   prompt-validation-fun validation-fun
+                   prompt-abbrev-fun abbrev-fun
+                   prompt-display-fun display-fun
+                   prompt-result (or start "")
+                   prompt-prompt title
+                   prompt-position (length prompt-result)
+                   prompt-history-pos 0
+                   prompt-saved nil
+                   prompt-attr attributes
+                   prompt-completion-position nil
+                   prompt-completions nil
+                   prompt-completions-outdated t)
 	     (prompt-update-display)
 	     (catch 'prompt-exit
 	       (recursive-edit)))
 	 (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)))
-
-  (defun prompt-for-function (#!optional title)
+  (define symbol-history (prompt-make-history))
+  (define (prompt-for-symbol #!key title predicate validator history)
+    (prompt #:title title
+            #:completion-fun (lambda (x)
+                               (mapcar symbol-name
+                                       (apropos (concat ?^ (quote-regexp x))
+                                                predicate)))
+            #:validation-fun (lambda (x)
+                               (let
+                                   ((symbol (intern x)))
+                                 (if validator
+                                     (and (validator symbol) symbol)
+                                   symbol)))
+            #:history (or history symbol-history)))
+
+  (define function-history (prompt-make-history))
+  (define (prompt-for-function #!optional title)
     "Prompt for a function."
-    (prompt-for-symbol (or title "Enter name of function:")
-		       (lambda (x)
-			 (and (boundp x)
-			      (let ((value (symbol-value x)))
-				(or (functionp value)
-				    (macrop value)
-				    (special-form-p value)))))))
-
-  (defun prompt-for-variable (#!optional title)
+    (prompt-for-symbol #:title (or title "Enter name of function:")
+                       #:predicate (lambda (x)
+                                     (and (boundp x)
+                                          (let ((value (symbol-value x)))
+                                            (or (functionp value)
+                                                (macrop value)
+                                                (special-form-p value)))))
+                       #:history function-history))
+
+  (define variable-history (prompt-make-history))
+  (define (prompt-for-variable #!optional title)
     "Prompt for a variable."
-    (prompt-for-symbol (or title "Enter name of variable:") boundp))
-
-  (defun prompt-for-command (#!optional title)
-    (prompt-for-symbol title commandp commandp))
+    (prompt-for-symbol #:title (or title "Enter name of variable:")
+                       #:predicate boundp
+                       #:history variable-history))
+
+  (define command-history (prompt-make-history))
+  (define (prompt-for-command #!optional title)
+    (prompt-for-symbol #:title title
+                       #:predicate commandp
+                       #:validator commandp
+                       #:history command-history))
 
 
 ;;; autoloads
diff --git a/man/news.texi b/man/news.texi
index 01a7a25..35d767d 100644
--- a/man/news.texi
+++ b/man/news.texi
@@ -13,6 +13,13 @@ they occurred between. For more detailed information see the
 
 @itemize @bullet
 
+ item Bugfixes
+ itemize @minus
+ item The sawfish.wm.util.prompt no longer makes all of its internals
+available globally, so helper functions must be passed explicitly rather
+than implicitly via let statements.
+ end itemize
+
 @item New Features
 @itemize @minus
 @item Added border_with and border_color frame-part attributes
[Date Prev][Date Next] [Thread Prev][Thread Next] [Thread Index] [Date Index] [Author Index]