Allow description of a command, variable, or mode to be a thunk that

evaluates to a string.

diff --git a/v7/src/edwin/comman.scm b/v7/src/edwin/comman.scm
index cd1375e3b69c2e686c06536d6fb0c294a2c456c9..4bdea0a3ab36aeceb843e3b3e39f990c247d5cb2 100644 (file)
--- a/v7/src/edwin/comman.scm
+++ b/v7/src/edwin/comman.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: comman.scm,v 1.83 2000/02/25 20:24:15 cph Exp $
+$Id: comman.scm,v 1.84 2000/06/15 00:43:40 cph Exp $
 
 Copyright (c) 1986, 1989-2000 Massachusetts Institute of Technology
 
@@ -36,10 +36,10 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 
 (define (command-description command)
   (let ((desc (command-%description command)))
-    (if (string? desc)
+    (if (description? desc)
        desc
-       (let ((new (->doc-string (symbol->string (command-name command))
-                                desc)))
+       (let ((new
+              (->doc-string (symbol->string (command-name command)) desc)))
          (if new
              (set-command-%description! command new))
          new))))
@@ -115,10 +115,10 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 
 (define (variable-description variable)
   (let ((desc (variable-%description variable)))
-    (if (string? desc)
+    (if (description? desc)
        desc
-       (let ((new (->doc-string (symbol->string (variable-name variable))
-                                desc)))
+       (let ((new
+              (->doc-string (symbol->string (variable-name variable)) desc)))
          (if new
              (set-variable-%description! variable new))
          new))))

diff --git a/v7/src/edwin/docstr.scm b/v7/src/edwin/docstr.scm
index 594a032d99167cb4c9a2940298b3d03bf8cf29fa..04bdd8618852fb0a81b5a4f781198aea6d125345 100644 (file)
--- a/v7/src/edwin/docstr.scm
+++ b/v7/src/edwin/docstr.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: docstr.scm,v 1.3 1999/01/02 06:11:34 cph Exp $
+$Id: docstr.scm,v 1.4 2000/06/15 00:43:26 cph Exp $
 
-Copyright (c) 1993-1999 Massachusetts Institute of Technology
+Copyright (c) 1993-2000 Massachusetts Institute of Technology
 
 This program is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
@@ -23,16 +23,15 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 
 (declare (usual-integrations))
 \f
-(define *external-doc-strings?* true)
-(define *external-doc-strings-file* false)
-(define *doc-strings* false)
+(define *external-doc-strings?* #t)
+(define *external-doc-strings-file* #f)
+(define *doc-strings* #f)
 (define *doc-string-posn* 0)
-(define *doc-string-channel* false)
-(define *doc-string-buffer* false)
+(define *doc-string-channel* #f)
+(define *doc-string-buffer* #f)
 
 (define (doc-string->posn name str)
-  (if (not *external-doc-strings?*)
-      str
+  (if (and *external-doc-strings?* (string? str))
       (let ((nlen (string-length name))
            (dslen (string-length str))
            (slen (if (not *doc-strings*)
@@ -62,7 +61,8 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
            (string-set! doc-strings (fix:- end 2) #\Newline)
            (string-set! doc-strings (fix:- end 1) #\Newline)
            (set! *doc-string-posn* end)
-           posn)))))
+           posn)))
+      str))
 \f
 (define-integrable doc-string-buffer-length 512)
 
@@ -142,9 +142,9 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
    output
    (lambda (port)
      (output-port/write-string port *doc-strings*)))
-  (set! *external-doc-strings?* false)
+  (set! *external-doc-strings?* #f)
   (set! *doc-string-posn* 0)
-  (set! *doc-strings* false)
+  (set! *doc-strings* #f)
   unspecific)
 
 (define (guarantee-doc-string-state)
@@ -171,5 +171,4 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
                 unspecific))))))
 
 (add-event-receiver! event:after-restart
-                    (lambda ()
-                      (set! *doc-string-channel* false)))
\ No newline at end of file
+                    (lambda () (set! *doc-string-channel* #f)))
\ No newline at end of file

diff --git a/v7/src/edwin/hlpcom.scm b/v7/src/edwin/hlpcom.scm
index 6edae27beb1dc6f301c2866e66ef3603c047c1c2..8b4cd8d169f7c3c68c1045cbd92f5a23c470a228 100644 (file)
--- a/v7/src/edwin/hlpcom.scm
+++ b/v7/src/edwin/hlpcom.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: hlpcom.scm,v 1.118 2000/06/15 00:34:27 cph Exp $
+;;; $Id: hlpcom.scm,v 1.119 2000/06/15 00:44:08 cph Exp $
 ;;;
 ;;; Copyright (c) 1986, 1989-2000 Massachusetts Institute of Technology
 ;;;
@@ -346,6 +346,11 @@ If you want VALUE to be a string, you must surround it with doublequotes."
          (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))

diff --git a/v7/src/edwin/modes.scm b/v7/src/edwin/modes.scm
index 7e1ea03fabf9235fb100d4392b414773072b8fc1..cd782cec6a6c194999e0c43e862d2ea4c3390853 100644 (file)
--- a/v7/src/edwin/modes.scm
+++ b/v7/src/edwin/modes.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: modes.scm,v 1.32 2000/02/25 20:24:19 cph Exp $
+;;; $Id: modes.scm,v 1.33 2000/06/15 00:43:51 cph Exp $
 ;;;
 ;;; Copyright (c) 1986, 1989-2000 Massachusetts Institute of Technology
 ;;;
@@ -105,7 +105,7 @@
 
 (define (mode-description mode)
   (let ((desc (mode-%description mode)))
-    (if (string? desc)
+    (if (description? desc)
        desc
        (let ((new (->doc-string (symbol->string (mode-name mode)) desc)))
          (if new