Re: [patch] sawfish.wm.util.prompt
- From: Jeremy Hankins <nowan nowan org>
- To: General discussion about sawfish wm <sawfish-list gnome org>
- Subject: Re: [patch] sawfish.wm.util.prompt
- Date: Mon, 21 Sep 2009 15:02:51 -0500
Jeremy Hankins <nowan nowan org> writes:
> Here's a new version of the patch against the current master:
Woops, let's try that again. I noticed a bug I hadn't caught testing as
I was looking over the patch; here's the fixed version:
diff --git a/lisp/sawfish/wm/util/prompt-extras.jl b/lisp/sawfish/wm/util/prompt-extras.jl
index 88c519d..a810fc8 100644
--- a/lisp/sawfish/wm/util/prompt-extras.jl
+++ b/lisp/sawfish/wm/util/prompt-extras.jl
@@ -25,6 +25,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)
@@ -65,24 +72,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."
@@ -91,14 +101,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."
@@ -106,10 +119,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))
@@ -118,26 +133,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 45067d1..45f6096 100644
--- a/lisp/sawfish/wm/util/prompt-wm.jl
+++ b/lisp/sawfish/wm/util/prompt-wm.jl
@@ -1,5 +1,4 @@
;; prompt-wm.jl -- prompt variants for windows/workspaces
-;; $Id: prompt-wm.jl,v 1.6 2000/09/11 07:44:42 john Exp $
;; Contributed by Dave Pearson <davep davep org>
@@ -44,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))
@@ -71,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 23d2e86..8110998 100644
--- a/lisp/sawfish/wm/util/prompt.jl
+++ b/lisp/sawfish/wm/util/prompt.jl
@@ -1,5 +1,4 @@
;; prompt.jl -- read line from user
-;; Time-stamp: <Fri Sep 18 12:09:45 CDT 2009>
;;
;; Copyright (C) 2008 Sergey I. Sharybin <sharybin nm ru>
;; Copyright (C) 2000 Topi Paavola <tjp iki fi>
@@ -20,6 +19,7 @@
prompt-for-function
prompt-for-variable
prompt-for-command
+ prompt-make-history
;; motion / editing commands
prompt-backward-character
@@ -86,46 +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
- (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
@@ -145,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
@@ -162,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))
@@ -181,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)))
@@ -206,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))
@@ -230,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)
@@ -240,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)
@@ -286,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))
@@ -303,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))
@@ -327,7 +312,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)
@@ -338,8 +323,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)
@@ -347,52 +344,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
--
Jeremy Hankins <nowan nowan org>
PGP fingerprint: 748F 4D16 538E 75D6 8333 9E10 D212 B5ED 37D0 0A03
[
Date Prev][
Date Next] [
Thread Prev][
Thread Next]
[
Thread Index]
[
Date Index]
[
Author Index]
