437 lines
14 KiB
Scheme
437 lines
14 KiB
Scheme
;;;
|
||
;;; Copyright (c) 1985 Massachusetts Institute of Technology
|
||
;;;
|
||
;;; This material was developed by the Scheme project at the
|
||
;;; Massachusetts Institute of Technology, Department of
|
||
;;; Electrical Engineering and Computer Science. Permission to
|
||
;;; copy this software, to redistribute it, and to use it for any
|
||
;;; purpose is granted, subject to the following restrictions and
|
||
;;; understandings.
|
||
;;;
|
||
;;; 1. Any copy made of this software must include this copyright
|
||
;;; notice in full.
|
||
;;;
|
||
;;; 2. Users of this software agree to make their best efforts (a)
|
||
;;; to return to the MIT Scheme project any improvements or
|
||
;;; extensions that they make, so that these may be included in
|
||
;;; future releases; and (b) to inform MIT of noteworthy uses of
|
||
;;; this software.
|
||
;;;
|
||
;;; 3. All materials developed as a consequence of the use of
|
||
;;; this software shall duly acknowledge such use, in accordance
|
||
;;; with the usual standards of acknowledging credit in academic
|
||
;;; research.
|
||
;;;
|
||
;;; 4. MIT has made no warrantee or representation that the
|
||
;;; operation of this software will be error-free, and MIT is
|
||
;;; under no obligation to provide any services, by way of
|
||
;;; maintenance, update, or otherwise.
|
||
;;;
|
||
;;; 5. In conjunction with products arising from the use of this
|
||
;;; material, there shall be no use of the name of the
|
||
;;; Massachusetts Institute of Technology nor of any adaptation
|
||
;;; thereof in any advertising, promotional, or sales literature
|
||
;;; without prior written consent from MIT in each case.
|
||
;;;
|
||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
;;;
|
||
;;; Modified by Texas Instruments Inc 8/15/85
|
||
;;;
|
||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
|
||
(begin
|
||
(define-integrable %make-region
|
||
(lambda (start end)
|
||
(cons start end)))
|
||
|
||
(define-integrable region-start
|
||
(lambda (region)
|
||
(car region)))
|
||
|
||
(define-integrable region-end
|
||
(lambda (region)
|
||
(cdr region)))
|
||
|
||
(define-integrable region-group
|
||
(lambda (region)
|
||
(mark-group (region-start region))))
|
||
|
||
(define-integrable components->region
|
||
(lambda (start-line start-pos end-line end-pos)
|
||
(%make-region (mark-permanent! (%make-mark start-line start-pos #!FALSE))
|
||
(mark-permanent! (%make-mark end-line end-pos #!TRUE)))))
|
||
|
||
(define-integrable make-mark
|
||
(lambda (line position)
|
||
(%make-mark line position #!TRUE)))
|
||
|
||
(define-integrable %make-mark
|
||
(lambda (line position left-inserting?)
|
||
(let ((mark (make-vector 3)))
|
||
(vector-set! mark 0 line)
|
||
(vector-set! mark 1 position)
|
||
(vector-set! mark 2 left-inserting?)
|
||
mark)))
|
||
|
||
(define-integrable mark-line
|
||
(lambda (mark)
|
||
(vector-ref mark 0)))
|
||
|
||
(define-integrable %set-mark-line!
|
||
(lambda (mark line)
|
||
(vector-set! mark 0 line)))
|
||
|
||
(define-integrable mark-position
|
||
(lambda (mark)
|
||
(vector-ref mark 1)))
|
||
|
||
(define-integrable set-mark-position!
|
||
(lambda (mark position)
|
||
(vector-set! mark 1 position)))
|
||
|
||
(define-integrable mark-left-inserting?
|
||
(lambda (mark)
|
||
(vector-ref mark 2)))
|
||
|
||
(define-integrable mark-group
|
||
(lambda (mark)
|
||
(line-group (mark-line mark))))
|
||
|
||
(define-integrable line-tag 'line)
|
||
|
||
(define-integrable make-line
|
||
(lambda (string)
|
||
(let ((line (make-vector 8)))
|
||
(vector-set! line 3 line-tag)
|
||
(vector-set! line 1 string)
|
||
line)))
|
||
|
||
(define-integrable line-string
|
||
(lambda (line)
|
||
(vector-ref line 1)))
|
||
|
||
(define-integrable line-previous
|
||
(lambda (line)
|
||
(vector-ref line 2)))
|
||
|
||
(define-integrable line-next
|
||
(lambda (line)
|
||
(vector-ref line 0)))
|
||
|
||
(define-integrable line-marks
|
||
(lambda (line)
|
||
(vector-ref line 4)))
|
||
|
||
(define-integrable set-line-marks!
|
||
(lambda (line marks)
|
||
(vector-set! line 4 marks)))
|
||
|
||
(define-integrable line-group
|
||
(lambda (line)
|
||
(vector-ref line 5)))
|
||
|
||
(define-integrable set-line-group!
|
||
(lambda (line group)
|
||
(vector-set! line 5 group)))
|
||
|
||
(define-integrable line-number
|
||
(lambda (line)
|
||
(vector-ref line 6)))
|
||
|
||
(define-integrable set-line-number!
|
||
(lambda (line number)
|
||
(vector-set! line 6 number)))
|
||
|
||
(define-integrable line-alist
|
||
(lambda (line)
|
||
(vector-ref line 7)))
|
||
|
||
(define-integrable set-line-alist!
|
||
(lambda (line alist)
|
||
(vector-set! line 7 alist)))
|
||
)
|
||
;;;; Text Data Structures
|
||
|
||
;;; This file describes the data structures used to represent and
|
||
;;; manipulate text within the editor.
|
||
|
||
;;; The basic unit of text is the GROUP, which is essentially a type
|
||
;;; of character string with some special operations. Normally a
|
||
;;; group is modified by side effect; unlike character strings, groups
|
||
;;; will grow and shrink appropriately under such operations. Also,
|
||
;;; it is possible to have pointers into a group, called MARKs, which
|
||
;;; continue to point to the "same place" under these operations; this
|
||
;;; would not be true of a string, elements of which are pointed at by
|
||
;;; indices.
|
||
|
||
;;; As is stressed in the EMACS manual, marks point between characters
|
||
;;; rather than directly at them. This perhaps counter-intuitive
|
||
;;; concept may aid understanding.
|
||
|
||
;;; Besides acting as pointers into a group, marks may be compared.
|
||
;;; All of the marks within a group are totally ordered, and the
|
||
;;; standard order predicates are supplied for them. In addition,
|
||
;;; marks in different groups are unordered with respect to one
|
||
;;; another. The standard predicates have been extended to be false
|
||
;;; in this case, and another predicate, which indicates whether they
|
||
;;; are related, is supplied.
|
||
|
||
;;; Marks may be paired into units called REGIONs. Each region has a
|
||
;;; START mark and an END mark, and it must be the case that START is
|
||
;;; less than or equal to END in the mark ordering. While in one
|
||
;;; sense this pairing of marks is trivial, it can also be used to
|
||
;;; reduce overhead in the implementation since a region guarantees
|
||
;;; that its marks satisfy this very basic relation.
|
||
|
||
;;; As in most other editors of this type, there is a distinction
|
||
;;; between "temporary" and "permanent" marks. The purpose for this
|
||
;;; distinction is that temporary marks require less overhead to
|
||
;;; create. Conversely, temporary marks do not remain valid when
|
||
;;; their group is modified. They are intended for local use when it
|
||
;;; is known that the group will remain unchanged.
|
||
|
||
;;; The implementation of marks is different from previous
|
||
;;; implementations. In particular, it is not possible to tell
|
||
;;; whether a mark is temporary or permanent. Instead, a "caller
|
||
;;; saves"-like convention is used. Whenever any given mark needs to
|
||
;;; be permanent, one merely calls a procedure which "permanentizes"
|
||
;;; it. All marks are created temporary by default.
|
||
|
||
;;; Internally, groups are represented as an ordered set of objects,
|
||
;;; called LINEs, which are doubly linked to form a linear chain.
|
||
;;; Each line represents a string of characters without newlines, and
|
||
;;; two adjacent lines are separated by a "virtual newline". Thus
|
||
;;; this data structure directly corresponds to our intuitive concept
|
||
;;; of "line".
|
||
|
||
;;; In some sense the choice of lines are the unit of text is quite
|
||
;;; arbitrary; there are no real technical benefits to be gained from
|
||
;;; the choice. The decision to structure things this way was based
|
||
;;; on the fact that most current editors are built that way, and
|
||
;;; expediency demands that we not innovate too much.
|
||
|
||
;;; With that said, it is important to restate that lines are an
|
||
;;; INTERNAL data representation. Since the choice is arbitrary, they
|
||
;;; are not supported by any public operations.
|
||
|
||
;;;; Groups
|
||
|
||
;;; Every line belongs to a unique group, and every line belonging to
|
||
;;; the same group is related. That is, the lines in a group are
|
||
;;; totally ordered. Lines in different groups have no relation.
|
||
|
||
;;; There is no sharing of lines between groups. When lines are
|
||
;;; copied out of a group, they form a new group. When they are
|
||
;;; inserted into a group, they become part of that group.
|
||
|
||
(define make-group)
|
||
(let ()
|
||
|
||
(define group-tag 'group)
|
||
|
||
(set! make-group
|
||
(named-lambda (make-group region)
|
||
(let ((group (make-vector 6)))
|
||
(vector-set! group 2 group-tag)
|
||
(vector-set! group 1 region)
|
||
(vector-set! group 0 region)
|
||
(vector-set! group 5 #!FALSE)
|
||
group)))
|
||
|
||
)
|
||
(begin
|
||
(define-integrable group-index:total-region 1)
|
||
(define-integrable group-index:region 0)
|
||
(define-integrable group-index:delete-daemons 3)
|
||
(define-integrable group-index:insert-daemons 4)
|
||
(define-integrable group-index:read-only-flag 5)
|
||
|
||
(define-integrable group-region
|
||
(lambda (group)
|
||
(vector-ref group group-index:region)))
|
||
|
||
(define (%set-group-region! group region)
|
||
(vector-set! group group-index:total-region region)
|
||
(vector-set! group group-index:region region))
|
||
|
||
(define-integrable %group-start
|
||
(lambda (group)
|
||
(region-start (group-region group))))
|
||
|
||
(define-integrable %group-end
|
||
(lambda (group)
|
||
(region-end (group-region group))))
|
||
)
|
||
|
||
(define (group-read-only? group)
|
||
(vector-ref group group-index:read-only-flag))
|
||
|
||
(define (set-group-read-only! group)
|
||
(vector-set! group group-index:read-only-flag #!TRUE))
|
||
|
||
(define (set-group-writeable! group)
|
||
(vector-set! group group-index:read-only-flag #!FALSE))
|
||
|
||
|
||
;;;; Group Modification Daemons
|
||
|
||
(define (group-delete-daemons group)
|
||
(vector-ref group group-index:delete-daemons))
|
||
|
||
(define (add-group-delete-daemon! group daemon)
|
||
(vector-set! group group-index:delete-daemons
|
||
(cons daemon (vector-ref group group-index:delete-daemons))))
|
||
|
||
(define (region-delete-starting! region)
|
||
(if (group-read-only? (region-group region))
|
||
(editor-error "Trying to modify read only text."))
|
||
(region-modification-starting! (group-delete-daemons (region-group region))
|
||
region))
|
||
|
||
(define (group-insert-daemons group)
|
||
(vector-ref group group-index:insert-daemons))
|
||
|
||
(define (add-group-insert-daemon! group daemon)
|
||
(vector-set! group group-index:insert-daemons
|
||
(cons daemon (vector-ref group group-index:insert-daemons))))
|
||
|
||
(define (region-insert-starting! mark)
|
||
(if (group-read-only? (mark-group mark))
|
||
(editor-error "Trying to modified read only text."))
|
||
(region-modification-starting! (group-insert-daemons (mark-group mark))
|
||
mark))
|
||
|
||
(define (region-modification-starting! all-daemons argument)
|
||
(define (loop daemons)
|
||
(if (null? daemons)
|
||
'()
|
||
(let ((sync ((car daemons) argument)))
|
||
(if sync
|
||
(cons sync (loop (cdr daemons)))
|
||
(loop (cdr daemons))))))
|
||
(sync-daemons (loop all-daemons)))
|
||
|
||
(define ((sync-daemons daemons) region)
|
||
(define (loop daemons)
|
||
(if (not (null? daemons))
|
||
(begin ((car daemons) region)
|
||
(loop (cdr daemons)))))
|
||
(loop daemons))
|
||
|
||
;;;; Regions
|
||
|
||
(define (make-region start end)
|
||
(cond ((mark<= start end) (%make-region start end))
|
||
((mark<= end start) (%make-region end start))
|
||
(else (error "Marks not related" start end))))
|
||
|
||
(define (lines->region start-line end-line)
|
||
(let ((region (components->region start-line 0
|
||
end-line (line-length end-line))))
|
||
(set-line-group! start-line (make-group region))
|
||
(number-lines! start-line end-line)
|
||
region))
|
||
|
||
(define (region-components region receiver)
|
||
(receiver (mark-line (region-start region))
|
||
(mark-position (region-start region))
|
||
(mark-line (region-end region))
|
||
(mark-position (region-end region))))
|
||
|
||
;;;; Marks
|
||
|
||
(define (mark-components mark receiver)
|
||
(receiver (mark-line mark)
|
||
(mark-position mark)))
|
||
|
||
(define (mark-right-inserting mark)
|
||
(mark-permanent!
|
||
(if (mark-left-inserting? mark)
|
||
(%make-mark (mark-line mark) (mark-position mark) #!FALSE)
|
||
mark)))
|
||
|
||
(define (mark-left-inserting mark)
|
||
(mark-permanent!
|
||
(if (mark-left-inserting? mark)
|
||
mark
|
||
(%make-mark (mark-line mark) (mark-position mark) #!TRUE))))
|
||
|
||
|
||
;;;; Lines
|
||
|
||
;;; Instead of using VECTOR, MAKE-LINE is coded in a strange way to
|
||
;;; make it maximally fast. Both LIST->VECTOR and CONS are
|
||
;;; primitives. Also, VECTOR would cons a list, then vectorize it,
|
||
;;; creating a bunch of garbage, while this only makes one cons.
|
||
|
||
(define (set-line-string! line string)
|
||
(vector-set! line 1 string)
|
||
(set-line-alist! line '()))
|
||
|
||
(define (connect-lines! previous next)
|
||
(if (not (null? previous)) (vector-set! previous 0 next))
|
||
(if (not (null? next)) (vector-set! next 2 previous)))
|
||
|
||
(define (disconnect-lines! start end)
|
||
(vector-set! start 2 '())
|
||
(vector-set! end 0 '()))
|
||
|
||
|
||
;;; line-length clashes with a scheme-primitive. we have defined
|
||
;;; a macro line-length which will replace all occurrences of line-length
|
||
;;; to line-string-length. Maybe, we will change it all ove the source
|
||
;;; someday. The macro will be present only while compiling Edwin
|
||
;;; sources.
|
||
|
||
;;; (define-integrable (line-length line)
|
||
;;; (string-length (line-string line)))
|
||
|
||
;;;; Line Numbering
|
||
|
||
(define line-number-increment 256)
|
||
|
||
(define (number-lines! start-line end-line)
|
||
(define (number-upward group base increment)
|
||
(define (loop line number)
|
||
(set-line-group! line group)
|
||
(set-line-number! line number)
|
||
(if (not (eq? line end-line))
|
||
(loop (line-next line) (+ number increment))))
|
||
(loop start-line (+ base increment)))
|
||
|
||
(define (number-downward group base increment)
|
||
(define (loop line number)
|
||
(set-line-group! line group)
|
||
(set-line-number! line number)
|
||
(if (not (eq? line start-line))
|
||
(loop (line-previous line) (- number increment))))
|
||
(loop end-line (- base increment)))
|
||
|
||
(define (count-lines)
|
||
(define (loop line n)
|
||
(if (eq? line end-line)
|
||
n
|
||
(loop (line-next line) (1+ n))))
|
||
(loop start-line 1))
|
||
|
||
(let ((lower-limit (line-previous start-line))
|
||
(upper-limit (line-next end-line)))
|
||
(if (null? lower-limit)
|
||
(if (null? upper-limit)
|
||
;; Numbering entire group. The first line
|
||
;; had better be initialized correctly.
|
||
(number-upward (line-group start-line)
|
||
0
|
||
line-number-increment)
|
||
(number-downward (line-group upper-limit)
|
||
(line-number upper-limit)
|
||
line-number-increment))
|
||
(if (null? upper-limit)
|
||
(number-upward (line-group lower-limit)
|
||
(line-number lower-limit)
|
||
line-number-increment)
|
||
(number-upward (line-group lower-limit)
|
||
(line-number lower-limit)
|
||
(/ (- (line-number upper-limit)
|
||
(line-number lower-limit))
|
||
(1+ (count-lines)))))))) |