Allow description of a command, variable, or mode to be a thunk that
authorChris Hanson <org/chris-hanson/cph>
Thu, 15 Jun 2000 00:25:44 +0000 (00:25 +0000)
committerChris Hanson <org/chris-hanson/cph>
Thu, 15 Jun 2000 00:25:44 +0000 (00:25 +0000)
evaluates to a string.

v7/src/edwin/hlpcom.scm
v7/src/edwin/prompt.scm

index b597651539c16a7183936a0509e33597b0ac15cc..82a0d83081e365f4c68c88a00d5c0e50e00315ed 100644 (file)
@@ -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))))
 \f
-(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)
index 970b327922f9b9fc5d855f433446bd25ddd7bc90..32dff87335718a8a43ffb556c73644fb5b580160 100644 (file)
@@ -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."))