;;; -*-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.
(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))
(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)))
(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)
(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?))
(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!
(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
(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)
(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)))))
(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)))
((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)))))
(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?
(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))
;;; -*-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)))
;;; -*-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)))
;;; -*-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))