From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 30 Oct 2001 19:25:15 +0000 (+0000)
Subject: Implement PROMPT-OPTIONS-DEFAULT-STRING to determine whether a set of
X-Git-Tag: 20090517-FFI~2483
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=ab528c39fd02a0807daf8ea8aa9d158b0aafde0a;p=mit-scheme.git

Implement PROMPT-OPTIONS-DEFAULT-STRING to determine whether a set of
options specifies a default prompt string.
---

diff --git a/v7/src/edwin/edwin.pkg b/v7/src/edwin/edwin.pkg
index 15c27b17d..d81e3a889 100644
--- a/v7/src/edwin/edwin.pkg
+++ b/v7/src/edwin/edwin.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: edwin.pkg,v 1.274 2001/09/21 02:56:15 cph Exp $
+$Id: edwin.pkg,v 1.275 2001/10/30 19:25:15 cph Exp $
 
 Copyright (c) 1989-2001 Massachusetts Institute of Technology
 
@@ -469,6 +469,7 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
 	  edwin-mode$minibuffer-local-yes-or-no
 	  edwin-variable$enable-recursive-minibuffers
 	  edwin-variable$completion-auto-help
+	  lookup-prompt-option
 	  pop-up-completions-list
 	  pop-up-generated-completions
 	  prompt-for-alist-value
@@ -486,6 +487,7 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
 	  prompt-for-variable
 	  prompt-for-yes-or-no?
 	  prompt-history-strings
+	  prompt-options-default-string
 	  set-prompt-history-strings!
 	  standard-completion
 	  temporary-typein-message
diff --git a/v7/src/edwin/prompt.scm b/v7/src/edwin/prompt.scm
index 2f75517c7..1e92ffec5 100644
--- a/v7/src/edwin/prompt.scm
+++ b/v7/src/edwin/prompt.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: prompt.scm,v 1.197 2001/09/25 12:57:26 cph Exp $
+;;; $Id: prompt.scm,v 1.198 2001/10/30 19:25:08 cph Exp $
 ;;;
 ;;; Copyright (c) 1986, 1989-2001 Massachusetts Institute of Technology
 ;;;
@@ -359,6 +359,22 @@
 	  (else
 	   (error "Illegal options tail:" options)))))
 
+(define (lookup-prompt-option options keyword default)
+  ;; If there are multiple instances of KEYWORD, return the last.
+  (let loop ((options options) (winner #f))
+    (if (pair? options)
+	(begin
+	  (if (not (pair? (cdr options)))
+	      (error "Options list has odd length:" options))
+	  (loop (cddr options)
+		(if (eq? keyword (car options)) options winner)))
+	(begin
+	  (if (not (null? options))
+	      (error "Illegal options tail:" options))
+	  (if winner
+	      (cadr winner)
+	      default)))))
+
 (define prompt-options-table
   '())
 
@@ -463,6 +479,18 @@
 	       (and (> length 0)
 		    (< index length))))
 	(set-options/default-string! options (list-ref (cdr history) index)))))
+
+(define (prompt-options-default-string options)
+  (or (lookup-prompt-option options 'DEFAULT-STRING #f)
+      (let ((index (lookup-prompt-option options 'HISTORY-INDEX #f)))
+	(and index
+	     (<= 0 index)
+	     (let ((strings
+		    (cdr
+		     (name->history
+		      (lookup-prompt-option options 'HISTORY #f)))))
+	       (and (< index (length strings))
+		    (list-ref strings index)))))))
 
 ;;;; String Prompt Modes