From 2d7c2e4b651cb348964f012db2644e3708c98a01 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Thu, 15 Jun 2000 00:58:55 +0000
Subject: [PATCH] Allow description of a command, variable, or mode to be a
thunk that evaluates to a string.
---
v7/src/edwin/docstr.scm | 28 ++++++++++++++++++++++++++--
v7/src/edwin/edwin.ldr | 4 ++--
v7/src/edwin/hlpcom.scm | 33 ++++++---------------------------
3 files changed, 34 insertions(+), 31 deletions(-)
diff --git a/v7/src/edwin/docstr.scm b/v7/src/edwin/docstr.scm
index 04bdd8618..ddf9f735f 100644
--- a/v7/src/edwin/docstr.scm
+++ b/v7/src/edwin/docstr.scm
@@ -1,6 +1,6 @@
#| -*-Scheme-*-
-$Id: docstr.scm,v 1.4 2000/06/15 00:43:26 cph Exp $
+$Id: docstr.scm,v 1.5 2000/06/15 00:58:53 cph Exp $
Copyright (c) 1993-2000 Massachusetts Institute of Technology
@@ -171,4 +171,28 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
unspecific))))))
(add-event-receiver! event:after-restart
- (lambda () (set! *doc-string-channel* #f)))
\ No newline at end of file
+ (lambda () (set! *doc-string-channel* #f)))
+
+;;;; Abstraction of help descriptions
+
+(define (description? description)
+ (or (string? description)
+ (and (procedure? description)
+ (procedure-arity-valid? description 0))))
+
+(define (description->string description)
+ (cond ((string? description) description)
+ ((procedure? description) (description))
+ (else
+ (error:wrong-type-argument description "description"
+ 'DESCRIPTION->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))))
+
+(define (description-append . descriptions)
+ (lambda () (apply string-append (map description->string descriptions))))
\ No newline at end of file
diff --git a/v7/src/edwin/edwin.ldr b/v7/src/edwin/edwin.ldr
index d9dd4debe..4d8106907 100644
--- a/v7/src/edwin/edwin.ldr
+++ b/v7/src/edwin/edwin.ldr
@@ -1,6 +1,6 @@
#| -*-Scheme-*-
-$Id: edwin.ldr,v 1.71 2000/06/15 00:36:59 cph Exp $
+$Id: edwin.ldr,v 1.72 2000/06/15 00:58:55 cph Exp $
Copyright (c) 1989-2000 Massachusetts Institute of Technology
@@ -129,7 +129,6 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
(load "simple" environment)
(load "debuge" environment)
(load "modlin" (->environment '(EDWIN MODELINE-STRING)))
- (load "hlpcom" environment)
(load "input" (->environment '(EDWIN KEYBOARD)))
(load "prompt" (->environment '(EDWIN PROMPT)))
(load "comred" (->environment '(EDWIN COMMAND-READER)))
@@ -219,6 +218,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
(load "evlcom" environment)
(load "filcom" environment)
(load "fill" environment)
+ (load "hlpcom" environment)
(load "info" (->environment '(EDWIN INFO)))
(load "intmod" (->environment '(EDWIN INFERIOR-REPL)))
(load "keymap" (->environment '(EDWIN COMMAND-SUMMARY)))
diff --git a/v7/src/edwin/hlpcom.scm b/v7/src/edwin/hlpcom.scm
index 8b4cd8d16..eb1076bbe 100644
--- a/v7/src/edwin/hlpcom.scm
+++ b/v7/src/edwin/hlpcom.scm
@@ -1,6 +1,6 @@
;;; -*-Scheme-*-
;;;
-;;; $Id: hlpcom.scm,v 1.119 2000/06/15 00:44:08 cph Exp $
+;;; $Id: hlpcom.scm,v 1.120 2000/06/15 00:58:43 cph Exp $
;;;
;;; Copyright (c) 1986, 1989-2000 Massachusetts Institute of Technology
;;;
@@ -324,10 +324,11 @@ If you want VALUE to be a string, you must surround it with doublequotes."
", "
(loop (cdr xkeys))))))
-(define (print-variable-binding variable)
- (write-string " which is bound to: ")
- (write (variable-value variable))
- (newline))
+(define (print-variable-binding variable #!optional port)
+ (let ((port (if (default-object? port) (current-output-port) port)))
+ (write-string " which is bound to: " port)
+ (write (variable-value variable) port)
+ (newline port)))
(define (print-short-description prefix description #!optional port)
(let ((port (if (default-object? port) (current-output-port) port)))
@@ -338,28 +339,6 @@ If you want VALUE to be a string, you must surround it with doublequotes."
(write-string ": " port)))
(write-description (description-first-line description) port)
(newline port)))
-
-(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))))
-
-(define (description? description)
- (or (string? description)
- (and (procedure? description)
- (procedure-arity-valid? description 0))))
-
-(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 description #!optional buffer)
(let* ((string (description->string description))
--
2.25.1