From: Chris Hanson <org/chris-hanson/cph>
Date: Thu, 15 Jun 2000 00:25:44 +0000 (+0000)
Subject: Allow description of a command, variable, or mode to be a thunk that
X-Git-Tag: 20090517-FFI~3540
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=bdd062a33f056490d157828081fd30afe08d5758;p=mit-scheme.git

Allow description of a command, variable, or mode to be a thunk that
evaluates to a string.
---

diff --git a/v7/src/edwin/hlpcom.scm b/v7/src/edwin/hlpcom.scm
index b59765153..82a0d8308 100644
--- a/v7/src/edwin/hlpcom.scm
+++ b/v7/src/edwin/hlpcom.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: hlpcom.scm,v 1.116 2000/06/05 19:22:36 cph Exp $
+;;; $Id: hlpcom.scm,v 1.117 2000/06/15 00:25:39 cph Exp $
 ;;;
 ;;; Copyright (c) 1986, 1989-2000 Massachusetts Institute of Technology
 ;;;
@@ -333,18 +333,30 @@ If you want VALUE to be a string, you must surround it with doublequotes."
       (begin
 	(write-string prefix)
 	(write-string ": ")))
-  (write-description (string-first-line description))
+  (write-description (description-first-line description))
   (newline))
 
-(define (string-first-line string)
+(define (description-first-line description)
+  (let ((string (description->string description)))
     (let ((index (string-find-next-char string #\newline)))
       (if index
 	  (substring string 0 index)
-	  string)))
+	  string))))
+
+(define (description->string description)
+  (cond ((string? description) description)
+	((procedure? description) (description))
+	(else
+	 (error:wrong-type-argument description "description"
+				    'DESCRIPTION->STRING))))
+
+(define (description-append . descriptions)
+  (lambda () (apply string-append (map description->string descriptions))))
 
-(define (substitute-command-keys string #!optional buffer)
-  (let ((buffer (if (default-object? buffer) (current-buffer) buffer))
-	(end (string-length string)))
+(define (substitute-command-keys description #!optional buffer)
+  (let* ((string (description->string description))
+	 (buffer (if (default-object? buffer) (current-buffer) buffer))
+	 (end (string-length string)))
     (letrec
 	((find-escape
 	  (lambda (start* comtabs)
diff --git a/v7/src/edwin/prompt.scm b/v7/src/edwin/prompt.scm
index 970b32792..32dff8733 100644
--- a/v7/src/edwin/prompt.scm
+++ b/v7/src/edwin/prompt.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: prompt.scm,v 1.185 2000/05/23 02:09:15 cph Exp $
+;;; $Id: prompt.scm,v 1.186 2000/06/15 00:25:44 cph Exp $
 ;;;
 ;;; Copyright (c) 1986, 1989-2000 Massachusetts Institute of Technology
 ;;;
@@ -472,8 +472,8 @@ The following commands are special to this mode:
 (define-key 'minibuffer-local #\M-p 'previous-prompt-history-item)
 
 (define-major-mode minibuffer-local-completion minibuffer-local #f
-  (string-append (mode-description (ref-mode-object minibuffer-local))
-		 "
+  (description-append (mode-description (ref-mode-object minibuffer-local))
+		      "
 \\[minibuffer-complete] completes as much of the input as possible.
 \\[minibuffer-complete-word] completes the next word of the input.
 \\[minibuffer-completion-help] displays possible completions of the input."))