Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 139 lines (125 sloc) 5.063 kB
82804f4 Committed initial code for Goatee emacs-alike editor. This is all co…
Timothy Moore authored
1 (in-package :goatee)
2
3 ;;; A mixin for buffers that can be displayed in editable areas
4 (defclass displayable-buffer ()
5 ((editable-areas :accessor editable-areas :initarg :editable-areas)))
6
7
8 (defclass editable-area ()
dcc203d Supply null handle-event for immediate-sheet-input-mixin. This should
Timothy Moore authored
9 ((buffer :reader buffer :initarg :buffer)
e225fc5 Multiline display now works in Goatee. The redisplay algorithm leaves
Timothy Moore authored
10 (frame-begin-mark :accessor frame-begin-mark) ;XXX obsolete
7b2a73f Remove reference to sb-pcl in sheet-adopt-child.
Timothy Moore authored
11 (last-tick :accessor last-tick :initarg :last-tick
12 :documentation "buffer tick")
82804f4 Committed initial code for Goatee emacs-alike editor. This is all co…
Timothy Moore authored
13 (lines :accessor lines :initarg :lines
e225fc5 Multiline display now works in Goatee. The redisplay algorithm leaves
Timothy Moore authored
14 :initform (make-instance 'dbl-list-head)
15 :documentation "Lines in the area, as opposed to the lines
16 in the buffer.")
17 (area-bp-start :accessor area-bp-start :initarg :area-bp-start
18 :documentation "buffer pointer to line in buffer
19 that's at the top of the area. The bp is not necessarily at the
20 beginning of the line.")
21 (area-bp-end :accessor area-bp-end :initarg :area-bp-end
22 :documentation "buffer pointer to line in buffer
23 that's at the bottom of the area. The bp is not necessarily at the
24 beginning of the line.")
0e42036 Luke Gorrie's (luke@bluetail.com) patches for implementing C-p and C-…
Timothy Moore authored
25 (last-line :accessor last-line :initarg :last-line :initform nil)
26 (last-command :accessor last-command :initform nil)
27 (goal-column :accessor goal-column :initform nil
28 :documentation "Goal column for next-line command when
29 moving over a short line"))
e0c0898 Uncommented menu-choose.lisp from the system definition. I'm using it
Timothy Moore authored
30 (:documentation "An abstract superclass for the on-screen area
31 devoted to Goatee editing. Roughly equivalent to a window in GNU Emacs."))
82804f4 Committed initial code for Goatee emacs-alike editor. This is all co…
Timothy Moore authored
32
9499c2d Editable text fields. Support for the OR presentation type. Added
Timothy Moore authored
33 (defmethod initialize-instance :after ((obj editable-area)
34 &key initial-contents)
35 (when initial-contents
36 (if (slot-boundp obj 'buffer)
37 (error "Only one of :buffer and :initial-contents may be supplied")
38 (setf (slot-value obj 'buffer)
39 (make-instance 'editable-buffer
40 :initial-contents initial-contents)))))
41
dcc203d Supply null handle-event for immediate-sheet-input-mixin. This should
Timothy Moore authored
42 (defgeneric area-first-line (area))
43
44 (defmethod area-first-line ((area editable-area))
45 (dbl-head (lines area)))
46
82804f4 Committed initial code for Goatee emacs-alike editor. This is all co…
Timothy Moore authored
47 #+nil(progn
48 (defmethod (setf buffer) ((new-buf displayable-buffer) (win editable-area))
49 (when (slot-boundp win 'buffer)
50 (remove-mark frame-begin-mark))
51 (setf (slot-value win 'buffer) new-buf)
52 (pushnew win (editable-areas new-buf))
53 (frame-window-to-point win)
54 (add-new-lines win)
55 new-buf)
56
57 (defconstant +point-frame-ratio+ 1/2)
58
59 (defgeneric frame-window-to-point (window))
60
61 ;;;XXX How to deal with line wrap?
62 (defmethod frame-window-to-point ((win window))
63 (with-accessors ((buffer buffer)
64 (frame-begin-mark frame-begin-mark))
65 win
66 (let* ((lines-to-start (floor (* (rows win) +point-frame-ratio+)))
67 (window-start (loop for lines from 0
68 for prev-eol = (point buffer)
69 then (position-backward buffer
70 #\newline
71 prev-eol )
72 while (and prev-eol
73 (<= lines lines-to-start))
74 finally (return (or prev-eol 0)))))
75 (if (and (slot-boundp win 'frame-begin-mark) frame-begin-mark)
76 (progn
77 (remove-mark frame-begin-mark)
78 (setf frame-begin-mark
79 (insert-mark buffer frame-begin-mark window-start)))
80 (setf frame-begin-mark (insert-mark-using-class buffer
81 'fixed-mark
82 window-start))))))
83
84 (defclass line-mark (fixed-mark)
85 ((last-update :accessor last-update :initarg :last-update)))
7b2a73f Remove reference to sb-pcl in sheet-adopt-child.
Timothy Moore authored
86 )
82804f4 Committed initial code for Goatee emacs-alike editor. This is all co…
Timothy Moore authored
87
88 (defclass editable-area-line (dbl-list)
89 ((buffer-line :accessor buffer-line :initarg :buffer-line)
7b2a73f Remove reference to sb-pcl in sheet-adopt-child.
Timothy Moore authored
90 (last-tick :accessor last-tick :initarg :last-tick)
91 (editable-area :accessor editable-area :initarg :editable-area
82804f4 Committed initial code for Goatee emacs-alike editor. This is all co…
Timothy Moore authored
92 :documentation "backpointer")))
93
7b2a73f Remove reference to sb-pcl in sheet-adopt-child.
Timothy Moore authored
94 ;;; XXX mostly garbage at the moment...
95 #+nil
82804f4 Committed initial code for Goatee emacs-alike editor. This is all co…
Timothy Moore authored
96 (defmethod add-new-lines ((win window))
97 (with-accessors ((buf buffer)
98 (line-marks line-marks)
99 (lines lines))
100 win
101 (setf (dbl-head line-marks) nil)
102 (setf (dbl-head lines) nil)
103 (let ((start-line-pos (at (frame-begin-mark win))))
104 (loop for line-count from 0 below (rows win)
105 for line-pos = start-line-pos then (position-forward
106 buffer
107 #\Newline
108 (1+ prev-line-pos))
109 for prev-line-pos = 0 then line-pos
110 while line-pos
111 for line-mark = (insert-mark-using-class
112 'line-mark
113 (1+ line-pos)
114 :last-update (update-counter win))
115 for prev-line-mark-dbl = line-marks then line-mark-dbl
116 for line-mark-dbl = (insert-obj-after line-mark prev-line-mark-dbl)
117 for line = (make-instance 'line
118 :mark line-mark
119 :last-update (update-counter win))
120 for prev-line-dbl = lines then line-dbl
121 for line-dbl = (insert-obj-after line prev-line-dbl)))
122 (loop for line-dbl = (dbl-head lines) then (next line-dbl)
123 while line-dbl
124 for line = (contents line-dbl)
125 do (let* ((start-line (at (mark line)))
126 (end-line (if (next line-dbl)
127 (1- (at (mark (contents (next line-dbl)))))
128 (position-forward buffer
129 #\Newline
130 (1+ start-line))))
131 (line-length (- start-line end-line))
132 (chars (make-array line-length
133 :element-type 'character
134 :adjustable t
135 :fill-pointer line-length)))
136 (buffer-string-into buffer chars
137 :start2 start-line :end2 end-line)
138 (setf (chars line) chars)))))
Something went wrong with that request. Please try again.