From: Chris Hanson <org/chris-hanson/cph>
Date: Wed, 23 Feb 2000 19:20:42 +0000 (+0000)
Subject: Add means to look up modes and commands without necessarily interning
X-Git-Tag: 20090517-FFI~4250
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=8b67a8ce8afb30362132dd7df6e83cf1fdde39f3;p=mit-scheme.git

Add means to look up modes and commands without necessarily interning
new ones.
---

diff --git a/v7/src/edwin/comman.scm b/v7/src/edwin/comman.scm
index 30a295d73..937631bc9 100644
--- a/v7/src/edwin/comman.scm
+++ b/v7/src/edwin/comman.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: comman.scm,v 1.81 1999/11/01 01:05:36 cph Exp $
+$Id: comman.scm,v 1.82 2000/02/23 19:20:42 cph Exp $
 
-Copyright (c) 1986, 1989-1999 Massachusetts Institute of Technology
+Copyright (c) 1986, 1989-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
@@ -69,18 +69,23 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 (define editor-commands
   (make-string-table 500))
 
-(define (name->command name)
+(define (name->command name #!optional error?)
   (let ((name (canonicalize-name name)))
     (or (string-table-get editor-commands (symbol->string name))
-	(letrec ((command
-		  (make-command
-		   name
-		   "undefined command"
-		   '()
-		   (lambda ()
-		     (editor-error "Undefined command: "
-				   (command-name-string command))))))
-	  command))))
+	(case (if (default-object? error?) 'INTERN error?)
+	  ((#F) #f)
+	  ((INTERN)
+	   (letrec ((command
+		     (make-command
+		      name
+		      "undefined command"
+		      '()
+		      (lambda ()
+			(editor-error "Undefined command: "
+				      (command-name-string command))))))
+	     command))
+	  (else
+	   (error "Undefined command:" (command-name-string command)))))))
 
 (define (->command object)
   (if (command? object)
diff --git a/v7/src/edwin/modes.scm b/v7/src/edwin/modes.scm
index ae599e845..6add53573 100644
--- a/v7/src/edwin/modes.scm
+++ b/v7/src/edwin/modes.scm
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: modes.scm,v 1.30 1999/11/01 03:38:10 cph Exp $
+;;; $Id: modes.scm,v 1.31 2000/02/23 19:20:33 cph Exp $
 ;;;
-;;; Copyright (c) 1986, 1989-1999 Massachusetts Institute of Technology
+;;; Copyright (c) 1986, 1989-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
@@ -73,14 +73,22 @@
 (define editor-modes
   (make-string-table))
 
+(define (name->mode object #!optional error?)
+  (let ((name (canonicalize-name object)))
+    (let ((sname (symbol->string name)))
+      (or (string-table-get editor-modes sname)
+	  (case (if (default-object? error?) 'INTERN error?)
+	    ((#F) #f)
+	    ((INTERN)
+	     (make-mode name #t sname #f ""
+			(lambda () (error "Undefined mode:" name))))
+	    (else
+	     (error "Undefined mode:" name)))))))
+
 (define (->mode object)
   (if (mode? object)
       object
-      (let ((name (canonicalize-name object)))
-	(let ((sname (symbol->string name)))
-	  (or (string-table-get editor-modes sname)
-	      (make-mode name #t sname #f ""
-			 (lambda () (error "Undefined mode:" name))))))))
+      (name->mode object)))
 
 (define (major-mode? object)
   (and (mode? object)