From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 10 Aug 1993 23:28:12 +0000 (+0000)
Subject: Eliminate instances of DEFINE-NAMED-STRUCTURE.
X-Git-Tag: 20090517-FFI~8095
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=8444730ebb0842a07c9979a01e9b3dd1c433d3c4;p=mit-scheme.git

Eliminate instances of DEFINE-NAMED-STRUCTURE.
---

diff --git a/v7/src/edwin/buffer.scm b/v7/src/edwin/buffer.scm
index 904322c9a..d2e5f9fae 100644
--- a/v7/src/edwin/buffer.scm
+++ b/v7/src/edwin/buffer.scm
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Id: buffer.scm,v 1.161 1993/01/09 09:38:53 cph Exp $
+;;;	$Id: buffer.scm,v 1.162 1993/08/10 23:28:12 cph Exp $
 ;;;
-;;;	Copyright (c) 1986, 1989-92 Massachusetts Institute of Technology
+;;;	Copyright (c) 1986, 1989-93 Massachusetts Institute of Technology
 ;;;
 ;;;	This material was developed by the Scheme project at the
 ;;;	Massachusetts Institute of Technology, Department of
@@ -330,7 +330,7 @@ The buffer is guaranteed to be deselected at that time."
 			(cons (cons variable value)
 			      (buffer-local-bindings buffer)))))
      (if (buffer-local-bindings-installed? buffer)
-	 (vector-set! variable variable-index:value value))
+	 (set-variable-%value! variable value))
      (invoke-variable-assignment-daemons! buffer variable))))
 
 (define (undefine-variable-local-value! buffer variable)
@@ -343,9 +343,8 @@ The buffer is guaranteed to be deselected at that time."
 			  buffer-index:local-bindings
 			  (delq! binding (buffer-local-bindings buffer)))
 	     (if (buffer-local-bindings-installed? buffer)
-		 (vector-set! variable
-			      variable-index:value
-			      (variable-default-value variable)))
+		 (set-variable-%value! variable
+				       (variable-default-value variable)))
 	     (invoke-variable-assignment-daemons! buffer variable)))))))
 
 (define (variable-local-value buffer variable)
@@ -365,7 +364,7 @@ The buffer is guaranteed to be deselected at that time."
 	    (lambda ()
 	      (set-cdr! binding value)
 	      (if (buffer-local-bindings-installed? buffer)
-		  (vector-set! variable variable-index:value value))
+		  (set-variable-%value! variable value))
 	      (invoke-variable-assignment-daemons! buffer variable)))))
 	(else
 	 (set-variable-default-value! variable value))))
@@ -374,9 +373,9 @@ The buffer is guaranteed to be deselected at that time."
   (check-variable-value-validity! variable value)
   (without-interrupts
    (lambda ()
-     (vector-set! variable variable-index:default-value value)
+     (set-variable-%default-value! variable value)
      (if (not (search-local-bindings (current-buffer) variable))
-	 (vector-set! variable variable-index:value value))
+	 (set-variable-%value! variable value))
      (invoke-variable-assignment-daemons! false variable))))
 
 (define-integrable (search-local-bindings buffer variable)
@@ -392,9 +391,8 @@ The buffer is guaranteed to be deselected at that time."
     (if (buffer-local-bindings-installed? buffer)
 	(do ((bindings bindings (cdr bindings)))
 	    ((null? bindings))
-	  (vector-set! (caar bindings)
-		       variable-index:value
-		       (variable-default-value (caar bindings)))))
+	  (set-variable-%value! (caar bindings)
+				(variable-default-value (caar bindings)))))
     (vector-set! buffer buffer-index:local-bindings '())
     (do ((bindings bindings (cdr bindings)))
 	((null? bindings))
@@ -416,15 +414,14 @@ The buffer is guaranteed to be deselected at that time."
 (define (install-buffer-local-bindings! buffer)
   (do ((bindings (buffer-local-bindings buffer) (cdr bindings)))
       ((null? bindings))
-    (vector-set! (caar bindings) variable-index:value (cdar bindings)))
+    (set-variable-%value! (caar bindings) (cdar bindings)))
   (vector-set! buffer buffer-index:local-bindings-installed? true))
 
 (define (uninstall-buffer-local-bindings! buffer)
   (do ((bindings (buffer-local-bindings buffer) (cdr bindings)))
       ((null? bindings))
-    (vector-set! (caar bindings)
-		 variable-index:value
-		 (variable-default-value (caar bindings))))
+    (set-variable-%value! (caar bindings)
+			  (variable-default-value (caar bindings))))
   (vector-set! buffer buffer-index:local-bindings-installed? false))
 
 (define (set-variable-value! variable value)
@@ -434,8 +431,8 @@ The buffer is guaranteed to be deselected at that time."
 	(check-variable-value-validity! variable value)
 	(without-interrupts
 	 (lambda ()
-	   (vector-set! variable variable-index:default-value value)
-	   (vector-set! variable variable-index:value value)
+	   (set-variable-%default-value! variable value)
+	   (set-variable-%value! variable value)
 	   (invoke-variable-assignment-daemons! false variable))))))
 
 (define (with-variable-value! variable new-value thunk)
diff --git a/v7/src/edwin/bufset.scm b/v7/src/edwin/bufset.scm
index 889d10211..14b62100d 100644
--- a/v7/src/edwin/bufset.scm
+++ b/v7/src/edwin/bufset.scm
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/bufset.scm,v 1.10 1992/04/07 08:39:01 cph Exp $
+;;;	$Id: bufset.scm,v 1.11 1993/08/10 23:27:48 cph Exp $
 ;;;
-;;;	Copyright (c) 1986, 1989-92 Massachusetts Institute of Technology
+;;;	Copyright (c) 1986, 1989-93 Massachusetts Institute of Technology
 ;;;
 ;;;	This material was developed by the Scheme project at the
 ;;;	Massachusetts Institute of Technology, Department of
@@ -46,32 +46,31 @@
 
 (declare (usual-integrations))
 
-(define-named-structure "Bufferset"
+(define-structure (bufferset (constructor %make-bufferset))
   buffer-list
-  names)
+  (names #f read-only #t))
 
 (define (make-bufferset initial-buffer)
-  (let ((bufferset (%make-bufferset))
-	(names (make-string-table 16 false)))
-    (string-table-put! names (buffer-name initial-buffer) initial-buffer)
-    (vector-set! bufferset bufferset-index:buffer-list (list initial-buffer))
-    (vector-set! bufferset bufferset-index:names names)
-    bufferset))
+  (%make-bufferset (list initial-buffer)
+		   (let ((names (make-string-table 16 false)))
+		     (string-table-put! names
+					(buffer-name initial-buffer)
+					initial-buffer)
+		     names)))
 
 (define (bufferset-select-buffer! bufferset buffer)
   (if (memq buffer (bufferset-buffer-list bufferset))
-      (vector-set! bufferset
-		   bufferset-index:buffer-list
-		   (cons buffer
-			 (delq! buffer (bufferset-buffer-list bufferset)))))
+      (set-bufferset-buffer-list!
+       bufferset
+       (cons buffer (delq! buffer (bufferset-buffer-list bufferset)))))
   unspecific)
 
 (define (bufferset-bury-buffer! bufferset buffer)
   (if (memq buffer (bufferset-buffer-list bufferset))
-      (vector-set! bufferset
-		   bufferset-index:buffer-list
-		   (append! (delq! buffer (bufferset-buffer-list bufferset))
-			    (list buffer))))
+      (set-bufferset-buffer-list!
+       bufferset
+       (append! (delq! buffer (bufferset-buffer-list bufferset))
+		(list buffer))))
   unspecific)
 
 (define (bufferset-guarantee-buffer! bufferset buffer)
@@ -80,10 +79,9 @@
 	(string-table-put! (bufferset-names bufferset)
 			   (buffer-name buffer)
 			   buffer)
-	(vector-set! bufferset
-		     bufferset-index:buffer-list
-		     (append! (bufferset-buffer-list bufferset)
-			      (list buffer)))))
+	(set-bufferset-buffer-list! bufferset
+				    (append! (bufferset-buffer-list bufferset)
+					     (list buffer)))))
   unspecific)
 
 (define (bufferset-find-buffer bufferset name)
@@ -99,9 +97,9 @@
 			  (buffer-default-directory (current-buffer))
 			  (working-directory-pathname)))))
     (string-table-put! (bufferset-names bufferset) name buffer)
-    (vector-set! bufferset
-		 bufferset-index:buffer-list
-		 (append! (bufferset-buffer-list bufferset) (list buffer)))
+    (set-bufferset-buffer-list!
+     bufferset
+     (append! (bufferset-buffer-list bufferset) (list buffer)))
     buffer))
 
 (define (bufferset-find-or-create-buffer bufferset name)
@@ -111,9 +109,8 @@
 (define (bufferset-kill-buffer! bufferset buffer)
   (if (not (memq buffer (bufferset-buffer-list bufferset)))
       (error "Attempt to kill unknown buffer" buffer))
-  (vector-set! bufferset
-	       bufferset-index:buffer-list
-	       (delq! buffer (bufferset-buffer-list bufferset)))
+  (set-bufferset-buffer-list! bufferset
+			      (delq! buffer (bufferset-buffer-list bufferset)))
   (string-table-remove! (bufferset-names bufferset) (buffer-name buffer)))
 
 (define (bufferset-rename-buffer bufferset buffer new-name)
diff --git a/v7/src/edwin/comman.scm b/v7/src/edwin/comman.scm
index 0a98aa9bc..e0b1a43f6 100644
--- a/v7/src/edwin/comman.scm
+++ b/v7/src/edwin/comman.scm
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/comman.scm,v 1.69 1992/04/07 09:35:32 cph Exp $
+;;;	$Id: comman.scm,v 1.70 1993/08/10 23:27:57 cph Exp $
 ;;;
-;;;	Copyright (c) 1986, 1989-92 Massachusetts Institute of Technology
+;;;	Copyright (c) 1986, 1989-93 Massachusetts Institute of Technology
 ;;;
 ;;;	This material was developed by the Scheme project at the
 ;;;	Massachusetts Institute of Technology, Department of
@@ -46,18 +46,17 @@
 
 (declare (usual-integrations))
 
-(define-named-structure "Command"
+(define-structure (command
+		   (constructor %make-command ())
+		   (print-procedure
+		    (unparser/standard-method 'COMMAND
+		      (lambda (state command)
+			(unparse-object state (command-name command))))))
   name
   description
   interactive-specification
   procedure)
 
-(unparser/set-tagged-vector-method!
- %command-tag
- (unparser/standard-method 'COMMAND
-   (lambda (state command)
-     (unparse-object state (command-name command)))))
-
 (define (command-name-string command)
   (editor-name/internal->external (symbol->string (command-name command))))
 
@@ -74,13 +73,14 @@
 	       (let ((command (%make-command)))
 		 (string-table-put! editor-commands name command)
 		 command)))))
-    (vector-set! command command-index:name name)
-    (vector-set! command command-index:description description)
-    (vector-set! command command-index:interactive-specification specification)
-    (vector-set! command command-index:procedure procedure)
+    (set-command-name! command name)
+    (set-command-description! command description)
+    (set-command-interactive-specification! command specification)
+    (set-command-procedure! command procedure)
     command))
 
-(define editor-commands (make-string-table 500))
+(define editor-commands
+  (make-string-table 500))
 
 (define (name->command name)
   (let ((name (canonicalize-name name)))
@@ -96,23 +96,29 @@
 	  command))))
 
 (define (->command object)
-  (if (command? object) object (name->command object)))
+  (if (command? object)
+      object
+      (name->command object)))
 
-(define-named-structure "Variable"
+(define-structure (variable
+		   (constructor %make-variable ())
+		   (print-procedure
+		    (unparser/standard-method 'VARIABLE
+		      (lambda (state variable)
+			(unparse-object state (variable-name variable))))))
   name
   description
-  value
+  %value
   buffer-local?
   initial-value
-  default-value
+  %default-value
   assignment-daemons
   value-validity-test)
 
-(unparser/set-tagged-vector-method!
- %variable-tag
- (unparser/standard-method 'VARIABLE
-   (lambda (state variable)
-     (unparse-object state (variable-name variable)))))
+(define-integrable variable-value variable-%value)
+(define-integrable variable-default-value variable-%default-value)
+(define-integrable define-variable-value-validity-test
+  set-variable-value-validity-test!)
 
 (define (variable-name-string variable)
   (editor-name/internal->external (symbol->string (variable-name variable))))
@@ -124,21 +130,18 @@
 	       (let ((variable (%make-variable)))
 		 (string-table-put! editor-variables name variable)
 		 variable)))))
-    (vector-set! variable variable-index:name name)
-    (vector-set! variable variable-index:description description)
-    (vector-set! variable variable-index:value value)
-    (vector-set! variable variable-index:buffer-local? buffer-local?)
-    (vector-set! variable variable-index:initial-value value)
-    (vector-set! variable variable-index:default-value value)
-    (vector-set! variable variable-index:assignment-daemons '())
-    (vector-set! variable variable-index:value-validity-test false)
+    (set-variable-name! variable name)
+    (set-variable-description! variable description)
+    (set-variable-%value! variable value)
+    (set-variable-buffer-local?! variable buffer-local?)
+    (set-variable-initial-value! variable value)
+    (set-variable-%default-value! variable value)
+    (set-variable-assignment-daemons! variable '())
+    (set-variable-value-validity-test! variable false)
     variable))
 
 (define-integrable (make-variable-buffer-local! variable)
-  (vector-set! variable variable-index:buffer-local? true))
-
-(define (define-variable-value-validity-test variable test)
-  (vector-set! variable variable-index:value-validity-test test))
+  (set-variable-buffer-local?! variable #t))
 
 (define (check-variable-value-validity! variable value)
   (if (not (variable-value-valid? variable value))
@@ -152,16 +155,15 @@
 (define (add-variable-assignment-daemon! variable daemon)
   (let ((daemons (variable-assignment-daemons variable)))
     (if (not (memq daemon daemons))
-	(vector-set! variable
-		     variable-index:assignment-daemons
-		     (cons daemon daemons)))))
+	(set-variable-assignment-daemons! variable (cons daemon daemons)))))
 
 (define (invoke-variable-assignment-daemons! buffer variable)
   (do ((daemons (variable-assignment-daemons variable) (cdr daemons)))
       ((null? daemons))
     ((car daemons) buffer variable)))
 
-(define editor-variables (make-string-table 50))
+(define editor-variables
+  (make-string-table 50))
 
 (define (name->variable name)
   (let ((name (canonicalize-name name)))
@@ -169,4 +171,6 @@
 	(make-variable name "" false false))))
 
 (define (->variable object)
-  (if (variable? object) object (name->variable object)))
\ No newline at end of file
+  (if (variable? object)
+      object
+      (name->variable object)))
\ No newline at end of file