From 8444730ebb0842a07c9979a01e9b3dd1c433d3c4 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 10 Aug 1993 23:28:12 +0000
Subject: [PATCH] Eliminate instances of DEFINE-NAMED-STRUCTURE.
---
v7/src/edwin/buffer.scm | 33 ++++++++--------
v7/src/edwin/bufset.scm | 53 ++++++++++++--------------
v7/src/edwin/comman.scm | 84 +++++++++++++++++++++--------------------
3 files changed, 84 insertions(+), 86 deletions(-)
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
--
2.25.1