From e6c2828bd14909ba66216b4edb657a5ab3395efe Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Mon, 1 Nov 1999 03:40:23 +0000 Subject: [PATCH] Eliminate macro DEFINE-NAMED-STRUCTURE. --- v7/src/edwin/buffer.scm | 142 +++++++++++++++------------------ v7/src/edwin/grpops.scm | 65 ++++++++------- v7/src/edwin/macros.scm | 41 +--------- v7/src/edwin/struct.scm | 172 ++++++++++++++-------------------------- 4 files changed, 154 insertions(+), 266 deletions(-) diff --git a/v7/src/edwin/buffer.scm b/v7/src/edwin/buffer.scm index 779da478f..70bcb4991 100644 --- a/v7/src/edwin/buffer.scm +++ b/v7/src/edwin/buffer.scm @@ -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 ;;; @@ -22,32 +22,37 @@ (declare (usual-integrations)) -(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 '())) (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))) (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)))) (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)) diff --git a/v7/src/edwin/grpops.scm b/v7/src/edwin/grpops.scm index dfea9607e..6099c9397 100644 --- a/v7/src/edwin/grpops.scm +++ b/v7/src/edwin/grpops.scm @@ -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 ;;; @@ -129,8 +129,8 @@ (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) @@ -138,12 +138,12 @@ 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)) @@ -164,8 +164,7 @@ (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) @@ -208,9 +207,9 @@ ;; 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)) @@ -240,8 +239,7 @@ (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) @@ -255,14 +253,14 @@ (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)))))) @@ -285,26 +283,25 @@ (%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))))))) @@ -312,18 +309,18 @@ (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))) diff --git a/v7/src/edwin/macros.scm b/v7/src/edwin/macros.scm index 4820090cc..32648f08e 100644 --- a/v7/src/edwin/macros.scm +++ b/v7/src/edwin/macros.scm @@ -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 ;;; @@ -25,45 +25,6 @@ (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)))))) - (syntax-table-define edwin-syntax-table 'DEFINE-COMMAND (lambda (name description interactive procedure) (let ((name (canonicalize-name name))) diff --git a/v7/src/edwin/struct.scm b/v7/src/edwin/struct.scm index 9b1534381..1d3842479 100644 --- a/v7/src/edwin/struct.scm +++ b/v7/src/edwin/struct.scm @@ -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 ;;; @@ -62,95 +62,47 @@ ;;;; 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) (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) @@ -218,13 +170,13 @@ (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) @@ -253,25 +205,25 @@ (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))) (define (record-clipping! group start end) (let ((buffer (group-buffer group))) @@ -281,7 +233,7 @@ (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) @@ -292,14 +244,10 @@ (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))) @@ -339,16 +287,16 @@ " 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))) @@ -363,19 +311,19 @@ (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?))) @@ -547,7 +495,7 @@ (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))) @@ -577,7 +525,7 @@ (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)) -- 2.25.1