Eliminate instances of DEFINE-NAMED-STRUCTURE.

diff --git a/v7/src/edwin/buffer.scm b/v7/src/edwin/buffer.scm
index 904322c9aa90398d2a023f4f70f093f17b49b113..d2e5f9fae723de9e70802de9f725a3cd012e3507 100644 (file)
--- 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 889d102115afec1fd8bd741f7993a7406e671789..14b62100d5e734741b5cecddde28854c1544d327 100644 (file)
--- 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))
 \f
-(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 0a98aa9bce692e3a7908fe70c21de367b3cfbb4f..e0b1a43f6b44f81531ead5b089e9c946a571773c 100644 (file)
--- 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))
 \f
-(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)))
 \f
-(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