Eliminate macro DEFINE-NAMED-STRUCTURE.
authorChris Hanson <org/chris-hanson/cph>
Mon, 1 Nov 1999 03:40:23 +0000 (03:40 +0000)
committerChris Hanson <org/chris-hanson/cph>
Mon, 1 Nov 1999 03:40:23 +0000 (03:40 +0000)
v7/src/edwin/buffer.scm
v7/src/edwin/grpops.scm
v7/src/edwin/macros.scm
v7/src/edwin/struct.scm

index 779da478f948f362f9d7138ee2ea812c5e3fea72..70bcb4991c44be0c46bbe6d1cfa3e9129e9a7221 100644 (file)
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: buffer.scm,v 1.171 1999/01/02 06:11:34 cph Exp $
+;;; $Id: buffer.scm,v 1.172 1999/11/01 03:40:08 cph Exp $
 ;;;
 ;;; Copyright (c) 1986, 1989-1999 Massachusetts Institute of Technology
 ;;;
 
 (declare (usual-integrations))
 \f
-(define-named-structure "Buffer"
-  name
+(define-structure (buffer
+                  (constructor %make-buffer (%name %default-directory)))
+  %name
   group
   mark-ring
   modes
   comtabs
   windows
   display-start
-  default-directory
-  pathname
-  truename
+  %default-directory
+  %pathname
+  %truename
   alist
   local-bindings
   local-bindings-installed?
   auto-save-pathname
   auto-saved?
-  save-length
+  %save-length
   backed-up?
-  modification-time
-  )
-
-(unparser/set-tagged-vector-method!
- %buffer-tag
- (unparser/standard-method 'BUFFER
-   (lambda (state buffer)
-     (unparse-object state (buffer-name buffer)))))
+  modification-time)
+
+(let-syntax
+    ((rename
+      (macro (slot-name)
+       `(DEFINE-INTEGRABLE ,(symbol-append 'BUFFER- slot-name)
+          ,(symbol-append 'BUFFER-% slot-name)))))
+  (rename name)
+  (rename default-directory)
+  (rename pathname)
+  (rename truename)
+  (rename save-length))
 
 (define-variable buffer-creation-hook
   "An event distributor that is invoked when a new buffer is created.
@@ -56,17 +61,16 @@ The buffer is guaranteed to be deselected at that time."
   (make-event-distributor))
 
 (define (make-buffer name mode directory)
-  (let ((buffer (%make-buffer)))
+  (let ((buffer (%make-buffer name directory)))
     (let ((group (make-group buffer)))
-      (vector-set! buffer buffer-index:name name)
-      (vector-set! buffer buffer-index:group group)
+      (set-buffer-group! buffer group)
       (add-group-clip-daemon! group (buffer-clip-daemon buffer))
       (%buffer-reset! buffer)
-      (vector-set! buffer buffer-index:windows '())
-      (vector-set! buffer buffer-index:display-start #f)
-      (vector-set! buffer buffer-index:default-directory directory)
-      (vector-set! buffer buffer-index:local-bindings '())
-      (vector-set! buffer buffer-index:local-bindings-installed? #f)
+      (set-buffer-windows! buffer '())
+      (set-buffer-display-start! buffer #f)
+      (set-buffer-default-directory! buffer directory)
+      (set-buffer-local-bindings! buffer '())
+      (set-buffer-local-bindings-installed?! buffer #f)
       (%set-buffer-major-mode! buffer mode)
       (event-distributor/invoke!
        (variable-default-value (ref-variable-object buffer-creation-hook))
@@ -78,20 +82,19 @@ The buffer is guaranteed to be deselected at that time."
     (disable-group-undo! group)
     (if (not (minibuffer? buffer))
        (enable-group-undo! group)))
-  (vector-set!
+  (set-buffer-mark-ring!
    buffer
-   buffer-index:mark-ring
    (make-ring
     (variable-default-value (ref-variable-object mark-ring-maximum))))
   (ring-push! (buffer-mark-ring buffer) (buffer-start buffer))
-  (vector-set! buffer buffer-index:pathname #f)
-  (vector-set! buffer buffer-index:truename #f)
-  (vector-set! buffer buffer-index:auto-save-pathname #f)
-  (vector-set! buffer buffer-index:auto-saved? #f)
-  (vector-set! buffer buffer-index:save-length 0)
-  (vector-set! buffer buffer-index:backed-up? #f)
-  (vector-set! buffer buffer-index:modification-time #f)
-  (vector-set! buffer buffer-index:alist '()))
+  (set-buffer-%pathname! buffer #f)
+  (set-buffer-%truename! buffer #f)
+  (set-buffer-auto-save-pathname! buffer #f)
+  (set-buffer-auto-saved?! buffer #f)
+  (set-buffer-%save-length! buffer 0)
+  (set-buffer-backed-up?! buffer #f)
+  (set-buffer-modification-time! buffer #f)
+  (set-buffer-alist! buffer '()))
 \f
 (define (buffer-modeline-event! buffer type)
   (let loop ((windows (buffer-windows buffer)))
@@ -126,38 +129,24 @@ The buffer is guaranteed to be deselected at that time."
      (buffer-modeline-event! buffer 'BUFFER-RESET))))
 
 (define (set-buffer-name! buffer name)
-  (vector-set! buffer buffer-index:name name)
+  (set-buffer-%name! buffer name)
   (buffer-modeline-event! buffer 'BUFFER-NAME))
 
 (define (set-buffer-default-directory! buffer directory)
-  (vector-set! buffer
-              buffer-index:default-directory
-              (pathname-simplify directory)))
+  (set-buffer-%default-directory! buffer (pathname-simplify directory)))
 
 (define (set-buffer-pathname! buffer pathname)
-  (vector-set! buffer buffer-index:pathname pathname)
+  (set-buffer-%pathname! buffer pathname)
   (if pathname
       (set-buffer-default-directory! buffer (directory-pathname pathname)))
   (buffer-modeline-event! buffer 'BUFFER-PATHNAME))
 
 (define (set-buffer-truename! buffer truename)
-  (vector-set! buffer buffer-index:truename truename)
+  (set-buffer-%truename! buffer truename)
   (buffer-modeline-event! buffer 'BUFFER-TRUENAME))
 
-(define-integrable (set-buffer-auto-save-pathname! buffer pathname)
-  (vector-set! buffer buffer-index:auto-save-pathname pathname))
-
 (define-integrable (set-buffer-save-length! buffer)
-  (vector-set! buffer buffer-index:save-length (buffer-length buffer)))
-
-(define-integrable (set-buffer-backed-up?! buffer flag)
-  (vector-set! buffer buffer-index:backed-up? flag))
-
-(define-integrable (set-buffer-modification-time! buffer time)
-  (vector-set! buffer buffer-index:modification-time time))
-
-(define-integrable (set-buffer-comtabs! buffer comtabs)
-  (vector-set! buffer buffer-index:comtabs comtabs))
+  (set-buffer-%save-length! buffer (buffer-length buffer)))
 \f
 (define (buffer-point buffer)
   (cond ((current-buffer? buffer)
@@ -204,17 +193,10 @@ The buffer is guaranteed to be deselected at that time."
   (group-absolute-end (buffer-group buffer)))
 
 (define (add-buffer-window! buffer window)
-  (vector-set! buffer
-              buffer-index:windows
-              (cons window (vector-ref buffer buffer-index:windows))))
+  (set-buffer-windows! buffer (cons window (buffer-windows buffer))))
 
 (define (remove-buffer-window! buffer window)
-  (vector-set! buffer
-              buffer-index:windows
-              (delq! window (vector-ref buffer buffer-index:windows))))
-
-(define-integrable (set-buffer-display-start! buffer mark)
-  (vector-set! buffer buffer-index:display-start mark))
+  (set-buffer-windows! buffer (delq! window (buffer-windows buffer))))
 \f
 (define (buffer-visible? buffer)
   (there-exists? (buffer-windows buffer) window-visible?))
@@ -242,13 +224,12 @@ The buffer is guaranteed to be deselected at that time."
       (let ((entry (assq key (buffer-alist buffer))))
        (if entry
            (set-cdr! entry value)
-           (vector-set! buffer buffer-index:alist
-                        (cons (cons key value) (buffer-alist buffer)))))
+           (set-buffer-alist! buffer
+                              (cons (cons key value) (buffer-alist buffer)))))
       (buffer-remove! buffer key)))
 
 (define (buffer-remove! buffer key)
-  (vector-set! buffer buffer-index:alist
-              (del-assq! key (buffer-alist buffer))))
+  (set-buffer-alist! buffer (del-assq! key (buffer-alist buffer))))
 
 (define (remove-impermanent-bindings! alist)
   ((list-deletor!
@@ -275,7 +256,7 @@ The buffer is guaranteed to be deselected at that time."
           (begin
             (set-group-modified?! group #f)
             (buffer-modeline-event! buffer 'BUFFER-MODIFIED)
-            (vector-set! buffer buffer-index:auto-saved? #f)))))))
+            (set-buffer-auto-saved?! buffer #f)))))))
 
 (define (buffer-modified! buffer)
   (without-editor-interrupts
@@ -287,7 +268,7 @@ The buffer is guaranteed to be deselected at that time."
             (buffer-modeline-event! buffer 'BUFFER-MODIFIED)))))))
 
 (define (set-buffer-auto-saved! buffer)
-  (vector-set! buffer buffer-index:auto-saved? #t)
+  (set-buffer-auto-saved?! buffer #t)
   (set-group-modified?! (buffer-group buffer) 'AUTO-SAVED))
 
 (define-integrable (buffer-auto-save-modified? buffer)
@@ -333,10 +314,10 @@ The buffer is guaranteed to be deselected at that time."
        (let ((binding (search-local-bindings buffer variable)))
         (if binding
             (set-cdr! binding value)
-            (vector-set! buffer
-                         buffer-index:local-bindings
-                         (cons (cons variable value)
-                               (buffer-local-bindings buffer)))))
+            (set-buffer-local-bindings!
+             buffer
+             (cons (cons variable value)
+                   (buffer-local-bindings buffer)))))
        (if (buffer-local-bindings-installed? buffer)
           (set-variable-%value! variable value))
        (invoke-variable-assignment-daemons! buffer variable)))))
@@ -347,9 +328,9 @@ The buffer is guaranteed to be deselected at that time."
      (let ((binding (search-local-bindings buffer variable)))
        (if binding
           (begin
-            (vector-set! buffer
-                         buffer-index:local-bindings
-                         (delq! binding (buffer-local-bindings buffer)))
+            (set-buffer-local-bindings!
+             buffer
+             (delq! binding (buffer-local-bindings buffer)))
             (if (buffer-local-bindings-installed? buffer)
                 (set-variable-%value! variable
                                       (variable-default-value variable)))
@@ -409,8 +390,9 @@ The buffer is guaranteed to be deselected at that time."
            ((null? bindings))
          (set-variable-%value! (caar bindings)
                                (variable-default-value (caar bindings)))))
-    (vector-set! buffer buffer-index:local-bindings
-                (if all? '() (remove-impermanent-bindings! bindings)))
+    (set-buffer-local-bindings!
+     buffer
+     (if all? '() (remove-impermanent-bindings! bindings)))
     (do ((bindings bindings (cdr bindings)))
        ((null? bindings))
       (invoke-variable-assignment-daemons! buffer (caar bindings)))))
@@ -432,14 +414,14 @@ The buffer is guaranteed to be deselected at that time."
   (do ((bindings (buffer-local-bindings buffer) (cdr bindings)))
       ((null? bindings))
     (set-variable-%value! (caar bindings) (cdar bindings)))
-  (vector-set! buffer buffer-index:local-bindings-installed? #t))
+  (set-buffer-local-bindings-installed?! buffer #t))
 
 (define (uninstall-buffer-local-bindings! buffer)
   (do ((bindings (buffer-local-bindings buffer) (cdr bindings)))
       ((null? bindings))
     (set-variable-%value! (caar bindings)
                          (variable-default-value (caar bindings))))
-  (vector-set! buffer buffer-index:local-bindings-installed? #f))
+  (set-buffer-local-bindings-installed?! buffer #f))
 
 (define (set-variable-value! variable value)
   (if within-editor?
@@ -486,8 +468,8 @@ The buffer is guaranteed to be deselected at that time."
 
 
 (define (%set-buffer-major-mode! buffer mode)
-  (vector-set! buffer buffer-index:modes (list mode))
-  (vector-set! buffer buffer-index:comtabs (mode-comtabs mode))
+  (set-buffer-modes! buffer (list mode))
+  (set-buffer-comtabs! buffer (mode-comtabs mode))
   (set-variable-local-value! buffer
                             (ref-variable-object mode-name)
                             (mode-display-name mode))
index dfea9607ebb605f4c1dfdb1f923ced2895559b8c..6099c93975cccd7d726f0da9622c54da8e426010 100644 (file)
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: grpops.scm,v 1.24 1999/01/02 06:11:34 cph Exp $
+;;; $Id: grpops.scm,v 1.25 1999/11/01 03:40:17 cph Exp $
 ;;;
 ;;; Copyright (c) 1986, 1989-1999 Massachusetts Institute of Technology
 ;;;
                             (group-gap-start group)
                             (group-text group)
                             new-end)
-          (vector-set! group group-index:gap-start new-start)
-          (vector-set! group group-index:gap-end new-end)))
+          (set-group-gap-start! group new-start)
+          (set-group-gap-end! group new-end)))
        ((fix:> new-start (group-gap-start group))
         (let ((new-end (fix:+ new-start (group-gap-length group))))
           (%substring-move! (group-text group)
                             new-end
                             (group-text group)
                             (group-gap-start group))
-          (vector-set! group group-index:gap-start new-start)
-          (vector-set! group group-index:gap-end new-end)))))
+          (set-group-gap-start! group new-start)
+          (set-group-gap-end! group new-end)))))
 
 (define (finish-group-insert! group index n)
-  (vector-set! group group-index:gap-start (fix:+ index n))
-  (vector-set! group group-index:gap-length (fix:- (group-gap-length group) n))
+  (set-group-gap-start! group (fix:+ index n))
+  (set-group-gap-length! group (fix:- (group-gap-length group) n))
   (if (group-start-changes-index group)
       (begin
        (if (fix:< index (group-start-changes-index group))
                      (mark-left-inserting? (system-pair-car marks)))))
        (set-mark-index! (system-pair-car marks)
                         (fix:+ (mark-index (system-pair-car marks)) n))))
-  (vector-set! group group-index:modified-tick
-              (fix:+ (group-modified-tick group) 1))
+  (set-group-modified-tick! group (fix:+ (group-modified-tick group) 1))
   (undo-record-insertion! group index (fix:+ index n))
   ;; The MODIFIED? bit must be set *after* the undo recording.
   (set-group-modified?! group true)
          ;; The undo recording must occur *before* the deletion.
          (undo-record-deletion! group start end)
          (let ((gap-end (fix:+ end gap-length)))
-           (vector-set! group group-index:gap-start start)
-           (vector-set! group group-index:gap-end gap-end)
-           (vector-set! group group-index:gap-length (fix:- gap-end start))
+           (set-group-gap-start! group start)
+           (set-group-gap-end! group gap-end)
+           (set-group-gap-length! group (fix:- gap-end start))
            (if (and (group-shrink-length group)
                     (fix:<= (fix:- (string-length text)
                                    (fix:- gap-end start))
                   (set-mark-index!
                    (system-pair-car marks)
                    (fix:- (mark-index (system-pair-car marks)) n))))))
-       (vector-set! group group-index:modified-tick
-                    (fix:+ (group-modified-tick group) 1))
+       (set-group-modified-tick! group (fix:+ (group-modified-tick group) 1))
        ;; The MODIFIED? bit must be set *after* the undo recording.
        (set-group-modified?! group true)
        (if (group-text-properties group)
   (let ((text (group-text group))
        (gap-start (group-gap-start group))
        (gap-end (group-gap-end group))
-       (reallocation-factor (group-reallocation-factor group)))
+       (realloc-factor (group-reallocation-factor group)))
     (let ((text-length (string-length text))
          (gap-delta (- new-gap-start gap-start)))
       (let ((n-chars (- text-length (group-gap-length group))))
        (let ((new-text-length
               (let ((minimum-text-length (+ n-chars n)))
                 (let loop ((length (if (= text-length 0) 1 text-length)))
-                  (let ((length (ceiling (* length reallocation-factor))))
+                  (let ((length (ceiling (* length realloc-factor))))
                     (if (< length minimum-text-length)
                         (loop length)
                         length))))))
                       (%substring-move! text gap-end ngsp new-text gap-start)
                       (%substring-move! text ngsp text-length
                                         new-text new-gap-end))))
-             (vector-set! group group-index:text new-text)
-             (vector-set! group group-index:gap-start new-gap-start)
-             (vector-set! group group-index:gap-end new-gap-end)
-             (vector-set! group group-index:gap-length new-gap-length))))))
-    (memoize-shrink-length! group reallocation-factor)))
+             (set-group-text! group new-text)
+             (set-group-gap-start! group new-gap-start)
+             (set-group-gap-end! group new-gap-end)
+             (set-group-gap-length! group new-gap-length))))))
+    (memoize-shrink-length! group realloc-factor)))
 
 (define (shrink-group! group)
   (let ((text (group-text group))
        (gap-length (group-gap-length group))
-       (reallocation-factor (group-reallocation-factor group)))
+       (realloc-factor (group-reallocation-factor group)))
     (let ((text-length (string-length text)))
       (let ((n-chars (- text-length gap-length)))
        (let ((new-text-length
               (if (= n-chars 0)
                   0
                   (let loop ((length text-length))
-                    (let ((length (floor (/ length reallocation-factor))))
+                    (let ((length (floor (/ length realloc-factor))))
                       (let ((sl
-                             (compute-shrink-length length
-                                                    reallocation-factor)))
+                             (compute-shrink-length length realloc-factor)))
                         (if (< sl n-chars)
                             length
                             (loop length)))))))
          (let ((delta (- text-length new-text-length)))
            (let ((new-gap-end (- gap-end delta)))
              (%substring-move! text gap-end text-length text new-gap-end)
-             (vector-set! group group-index:gap-end new-gap-end)
-             (vector-set! group group-index:gap-length (- gap-length delta))))
+             (set-group-gap-end! group new-gap-end)
+             (set-group-gap-length! group (- gap-length delta))))
          (set-string-maximum-length! text new-text-length))))
-    (memoize-shrink-length! group reallocation-factor)))
+    (memoize-shrink-length! group realloc-factor)))
 
-(define (memoize-shrink-length! group reallocation-factor)
-  (vector-set! group group-index:shrink-length
-              (compute-shrink-length (string-length (group-text group))
-                                     reallocation-factor)))
+(define (memoize-shrink-length! group realloc-factor)
+  (set-group-shrink-length!
+   group
+   (compute-shrink-length (string-length (group-text group)) realloc-factor)))
 
-(define (compute-shrink-length length reallocation-factor)
-  (floor (/ (floor (/ length reallocation-factor)) reallocation-factor)))
+(define (compute-shrink-length length realloc-factor)
+  (floor (/ (floor (/ length realloc-factor)) realloc-factor)))
 
 (define (group-reallocation-factor group)
   ;; We assume the result satisfies (LAMBDA (G) (AND (REAL? G) (> G 1)))
index 4820090ccc846725c4c9c0af8b8c6804d82aa18b..32648f08e7334fbfcb095f9a57168eea36d0ba95 100644 (file)
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: macros.scm,v 1.64 1999/01/28 03:54:36 cph Exp $
+;;; $Id: macros.scm,v 1.65 1999/11/01 03:40:23 cph Exp $
 ;;;
 ;;; Copyright (c) 1986, 1989-1999 Massachusetts Institute of Technology
 ;;;
 (define edwin-syntax-table
   (make-syntax-table syntax-table/system-internal))
 
-;;; DEFINE-NAMED-STRUCTURE is a simple alternative to DEFSTRUCT,
-;;; which defines a vector-based tagged data structure.  The first
-;;; argument is a string, which will be stored in the structure's 0th
-;;; slot.  The remaining arguments are symbols, which should be the
-;;; names of the slots.  Do not use the slot names %TAG or %SIZE.
-
-(syntax-table-define edwin-syntax-table 'DEFINE-NAMED-STRUCTURE
-  (lambda (name . slots)
-    (let ((name (if (symbol? name) name (intern name)))
-         (indexes
-          (let loop ((slots slots) (index 1))
-            (if (null? slots)
-                '()
-                (cons index (loop (cdr slots) (+ index 1)))))))
-      (let ((tag-name (symbol-append '% name '-TAG)))
-       `(BEGIN
-          (DEFINE ,tag-name
-            (MAKE-DEFINE-STRUCTURE-TYPE 'VECTOR
-                                        ',name
-                                        ',slots
-                                        ',indexes
-                                        (UNPARSER/STANDARD-METHOD ',name)))
-          (DEFINE (,(symbol-append '%MAKE- name))
-            (LET ((,name (MAKE-VECTOR ,(+ (length slots) 1) '())))
-              (VECTOR-SET! ,name 0 ,tag-name)
-              ,name))
-          (DEFINE (,(symbol-append name '?) OBJECT)
-            (AND (VECTOR? OBJECT)
-                 (NOT (ZERO? (VECTOR-LENGTH OBJECT)))
-                 (EQ? ,tag-name (VECTOR-REF OBJECT 0))))
-          ,@(append-map
-             (lambda (slot index)
-               `((DEFINE-INTEGRABLE (,(symbol-append name '- slot) ,name)
-                   (VECTOR-REF ,name ,index))
-                 (DEFINE-INTEGRABLE ,(symbol-append name '-INDEX: slot)
-                   ,index)))
-             slots
-             indexes))))))
-\f
 (syntax-table-define edwin-syntax-table 'DEFINE-COMMAND
   (lambda (name description interactive procedure)
     (let ((name (canonicalize-name name)))
index 9b1534381069fab6025434e0b41b5928104f8fe9..1d38424793c12cc3511f378b2ebe7be9ef94de98 100644 (file)
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: struct.scm,v 1.91 1999/01/02 06:11:34 cph Exp $
+;;; $Id: struct.scm,v 1.92 1999/11/01 03:40:13 cph Exp $
 ;;;
 ;;; Copyright (c) 1985, 1989-1999 Massachusetts Institute of Technology
 ;;;
 \f
 ;;;; Groups
 
-(define-named-structure "Group"
-  ;; The microcode file "edwin.h" depends on the fields TEXT,
-  ;; GAP-START, GAP-LENGTH, GAP-END, START-MARK, and END-MARK.
-  text
-  gap-start
-  gap-length
-  gap-end
-  marks
+(define-structure (group
+                  (type vector)
+                  (named)
+                  (constructor %make-group (buffer)))
+  ;; The microcode file "edwin.h" depends on this structure being a
+  ;; named vector, and knows the indexes of the fields TEXT,
+  ;; GAP-START, GAP-LENGTH, GAP-END, START-MARK, END-MARK, and
+  ;; MODIFIED?.
+  (text (string-allocate 0))
+  (gap-start 0)
+  (gap-length 0)
+  (gap-end 0)
+  (marks '())
   start-mark
   end-mark
-  writable?
+  (writable? #t)
   display-start
   display-end
-  start-changes-index
-  end-changes-index
-  modified-tick
-  clip-daemons
-  undo-data
-  modified?
-  point
+  (start-changes-index #f)
+  (end-changes-index #f)
+  (modified-tick 0)
+  (clip-daemons '())
+  (undo-data #f)
+  (modified? #f)
+  %point
   buffer
-  shrink-length
-  text-properties
-  %hash-number)
+  (shrink-length 0)
+  (text-properties #f)
+  (%hash-number #f))
 
-(define-integrable (set-group-marks! group marks)
-  (vector-set! group group-index:marks marks))
-
-(define-integrable (set-group-start-mark! group start)
-  (vector-set! group group-index:start-mark start))
-
-(define-integrable (set-group-end-mark! group end)
-  (vector-set! group group-index:end-mark end))
-
-(define-integrable (set-group-writable?! group writable?)
-  (vector-set! group group-index:writable? writable?))
-
-(define-integrable (set-group-display-start! group start)
-  (vector-set! group group-index:display-start start))
-
-(define-integrable (set-group-display-end! group end)
-  (vector-set! group group-index:display-end end))
-
-(define-integrable (set-group-start-changes-index! group start)
-  (vector-set! group group-index:start-changes-index start))
-
-(define-integrable (set-group-end-changes-index! group end)
-  (vector-set! group group-index:end-changes-index end))
-
-(define-integrable (set-group-modified-tick! group tick)
-  (vector-set! group group-index:modified-tick tick))
-
-(define-integrable (set-group-undo-data! group undo-data)
-  (vector-set! group group-index:undo-data undo-data))
-
-(define-integrable (set-group-modified?! group sense)
-  (vector-set! group group-index:modified? sense))
-
-(define-integrable (set-group-text-properties! group properties)
-  (vector-set! group group-index:text-properties properties))
-
-(define-integrable (set-group-%hash-number! group n)
-  (vector-set! group group-index:%hash-number n))
+(define-integrable group-point group-%point)
 \f
 (define (make-group buffer)
-  (let ((group (%make-group)))
-    (vector-set! group group-index:text (string-allocate 0))
-    (vector-set! group group-index:gap-start 0)
-    (vector-set! group group-index:gap-length 0)
-    (vector-set! group group-index:gap-end 0)
-    (vector-set! group group-index:marks '())
-    (let ((start (make-permanent-mark group 0 false)))
-      (vector-set! group group-index:start-mark start)
-      (vector-set! group group-index:display-start start))
-    (let ((end (make-permanent-mark group 0 true)))
-      (vector-set! group group-index:end-mark end)
-      (vector-set! group group-index:display-end end))
-    (vector-set! group group-index:writable? #t)
-    (vector-set! group group-index:start-changes-index false)
-    (vector-set! group group-index:end-changes-index false)
-    (vector-set! group group-index:modified-tick 0)
-    (vector-set! group group-index:clip-daemons '())
-    (vector-set! group group-index:undo-data false)
-    (vector-set! group group-index:modified? false)
-    (vector-set! group group-index:point (make-permanent-mark group 0 true))
-    (vector-set! group group-index:buffer buffer)
-    (vector-set! group group-index:shrink-length 0)
-    (vector-set! group group-index:text-properties false)
-    (vector-set! group group-index:%hash-number #f)
+  (let ((group (%make-group buffer)))
+    (let ((start (make-permanent-mark group 0 #f)))
+      (set-group-start-mark! group start)
+      (set-group-display-start! group start))
+    (let ((end (make-permanent-mark group 0 #t)))
+      (set-group-end-mark! group end)
+      (set-group-display-end! group end))
+    (set-group-%point! group (make-permanent-mark group 0 #t))
     group))
 
 (define (group-length group)
         (group-gap-start group))))
 
 (define-integrable (set-group-point! group point)
-  (vector-set! group group-index:point (mark-left-inserting-copy point)))
+  (set-group-%point! group (mark-left-inserting-copy point)))
 
 (define (group-absolute-start group)
-  (make-temporary-mark group 0 false))
+  (make-temporary-mark group 0 #f))
 
 (define (group-absolute-end group)
-  (make-temporary-mark group (group-length group) true))
+  (make-temporary-mark group (group-length group) #t))
 
 (define (group-hash-number group)
   (or (group-%hash-number group)
 (define (with-group-text-clipped! group start end thunk)
   (let ((old-text-start)
        (old-text-end)
-       (new-text-start (make-permanent-mark group start false))
-       (new-text-end (make-permanent-mark group end true)))
+       (new-text-start (make-permanent-mark group start #f))
+       (new-text-end (make-permanent-mark group end #t)))
     (unwind-protect (lambda ()
                      (set! old-text-start (group-start-mark group))
                      (set! old-text-end (group-end-mark group))
-                     (vector-set! group group-index:start-mark new-text-start)
-                     (vector-set! group group-index:end-mark new-text-end))
+                     (set-group-start-mark! group new-text-start)
+                     (set-group-end-mark! group new-text-end))
                    thunk
                    (lambda ()
                      (set! new-text-start (group-start-mark group))
                      (set! new-text-end (group-end-mark group))
-                     (vector-set! group group-index:start-mark old-text-start)
-                     (vector-set! group group-index:end-mark old-text-end)))))
+                     (set-group-start-mark! group old-text-start)
+                     (set-group-end-mark! group old-text-end)))))
 
 (define (group-text-clip group start end)
-  (let ((start (make-permanent-mark group start false))
-       (end (make-permanent-mark group end true)))
-    (vector-set! group group-index:start-mark start)
-    (vector-set! group group-index:end-mark end)))
+  (let ((start (make-permanent-mark group start #f))
+       (end (make-permanent-mark group end #t)))
+    (set-group-start-mark! group start)
+    (set-group-end-mark! group end)))
 \f
 (define (record-clipping! group start end)
   (let ((buffer (group-buffer group)))
                    (let ((display-start (mark-index display-start)))
                      (or (fix:< display-start start)
                          (fix:> display-start end))))))
-       (set-buffer-display-start! buffer false)))
+       (set-buffer-display-start! buffer #f)))
   (invoke-group-daemons! (group-clip-daemons group) group start end))
 
 (define (invoke-group-daemons! daemons group start end)
          (loop (cdr daemons))))))
 
 (define (add-group-clip-daemon! group daemon)
-  (vector-set! group
-              group-index:clip-daemons
-              (cons daemon (vector-ref group group-index:clip-daemons))))
+  (set-group-clip-daemons! group (cons daemon (group-clip-daemons group))))
 
 (define (remove-group-clip-daemon! group daemon)
-  (vector-set! group
-              group-index:clip-daemons
-              (delq! daemon (vector-ref group group-index:clip-daemons))))
+  (set-group-clip-daemons! group (delq! daemon (group-clip-daemons group))))
 
 (define (group-local-ref group variable)
   (variable-local-value (let ((buffer (group-buffer group)))
                                            " right"))))))
   ;; The microcode file "edwin.h" depends on the definition of this
   ;; structure.
-  (group false read-only true)
-  (index false)
-  (left-inserting? false read-only true))
+  (group #f read-only #t)
+  (index #f)
+  (left-inserting? #f read-only #t))
 
 (define (guarantee-mark mark)
   (if (not (mark? mark)) (error "not a mark" mark))
   mark)
 
 (define-integrable (make-mark group index)
-  (make-temporary-mark group index true))
+  (make-temporary-mark group index #t))
 
 (define (move-mark-to! mark target)
   (set-mark-index! mark (mark-index target)))
 
 (define (mark-right-inserting mark)
   (if (mark-left-inserting? mark)
-      (make-permanent-mark (mark-group mark) (mark-index mark) false)
+      (make-permanent-mark (mark-group mark) (mark-index mark) #f)
       (mark-permanent! mark)))
 
 (define (mark-right-inserting-copy mark)
-  (make-permanent-mark (mark-group mark) (mark-index mark) false))
+  (make-permanent-mark (mark-group mark) (mark-index mark) #f))
 
 (define (mark-left-inserting mark)
   (if (mark-left-inserting? mark)
       (mark-permanent! mark)
-      (make-permanent-mark (mark-group mark) (mark-index mark) true)))
+      (make-permanent-mark (mark-group mark) (mark-index mark) #t)))
 
 (define (mark-left-inserting-copy mark)
-  (make-permanent-mark (mark-group mark) (mark-index mark) true))
+  (make-permanent-mark (mark-group mark) (mark-index mark) #t))
 
 (define (make-permanent-mark group index left-inserting?)
   (let ((mark (make-temporary-mark group index left-inserting?)))
     (if (null? marks)
        (begin
          (set-group-marks! group '())
-         false)
+         #f)
        (let ((mark (system-pair-car marks)))
          (cond ((not mark)
                 (scan-head (system-pair-cdr marks)))
     (if (null? marks)
        (begin
          (system-pair-set-cdr! previous '())
-         false)
+         #f)
        (let ((mark (system-pair-car marks)))
          (if (not mark)
              (skip-nulls previous (system-pair-cdr marks))