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 14:50:04 -0500
Christopher Roy Bratusek <zanghar freenet de> writes:
> First of all, I've commited your other patch (to revert non-working
> stuff + shut up compiler), I haven't yet tested your patch, but I'll
> do so the next days. Though comments from other people would be nice.
Sounds good. The difference in terms of functionality is minor -- just
that prompt histories are now separate. Before if you ran
prompt-for-file, entered a file, then ran prompt-for-command and hit
up-arrow you'd have the file you'd just entered. The main argument for
the patch is that it (I hope) will make it easier for folks to
understand and use the prompt system.
Here's a new version of the patch against the current master:
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..f21fbb0 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,37 +344,45 @@ 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 #!optional title predicate validator #!key 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)
@@ -385,14 +390,19 @@ displayed. See the `display-message' function for more details.")
(let ((value (symbol-value x)))
(or (functionp value)
(macrop value)
- (special-form-p value)))))))
+ (special-form-p value)))))
+ #:history function-history))
- (defun prompt-for-variable (#!optional title)
+ (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))
+ (prompt-for-symbol (or title "Enter name of variable:") boundp
+ #:history variable-history))
- (defun prompt-for-command (#!optional title)
- (prompt-for-symbol title commandp commandp))
+ (define command-history (prompt-make-history))
+ (define (prompt-for-command #!optional title)
+ (prompt-for-symbol title commandp 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]
