/[climacs]/climacs/text-syntax.lisp
ViewVC logotype

Contents of /climacs/text-syntax.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.6 - (show annotations)
Sun Mar 13 20:51:48 2005 UTC (9 years, 1 month ago) by abakic
Branch: MAIN
Changes since 1.5: +6 -6 lines
Line-oriented persistent buffer (binseq2). Warning: Need to fix minor
bugs (related to number-of-lines-in-region, I believe).

base.lisp: Added faster methods on previous-line, next-line,
buffer-number-of-lines-in-region.

pane.lisp, cl-syntax.lisp, html-syntax.lisp, text-syntax.lisp:
Replaced some calls to make-instance to calls to clone-mark and (setf
offset), in order to avoid passing climacs-buffer to marks. This also
made possible to get rid of delegating methods on syntax.

climacs.asd: Added Persistent/binseq2.

packages.lisp: Added binseq2-related symbols.

Persistent/binseq.lisp, Persistent/obinseq.lisp: Cleanup.

Persistent/persistent-buffer.lisp: Added code for binseq2-buffer and
related marks. Also some minor fixes.
1 ;;; -*- Mode: Lisp; Package: COMMON-LISP-USER -*-
2
3 ;;; (c) copyright 2005 by
4 ;;; Robert Strandh (strandh@labri.fr)
5 ;;; (c) copyright 2005 by
6 ;;; Matthieu Villeneuve (matthieu.villeneuve@free.fr)
7
8 ;;; This library is free software; you can redistribute it and/or
9 ;;; modify it under the terms of the GNU Library General Public
10 ;;; License as published by the Free Software Foundation; either
11 ;;; version 2 of the License, or (at your option) any later version.
12 ;;;
13 ;;; This library is distributed in the hope that it will be useful,
14 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
15 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
16 ;;; Library General Public License for more details.
17 ;;;
18 ;;; You should have received a copy of the GNU Library General Public
19 ;;; License along with this library; if not, write to the
20 ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
21 ;;; Boston, MA 02111-1307 USA.
22
23 ;;; Syntax for analysing ordinary text.
24
25 ;;; Invariants after a complete syntax analysis:
26 ;;;
27 ;;; There is exactly one left-sticky mark at every offset followed by
28 ;;; character other than a newline and preceded either by nothing
29 ;;; (beginning of the buffer), by a newline character at the beginning
30 ;;; of the buffer, or by two newline characters.
31 ;;;
32 ;;; There is exactly one right-sticky mark at every offset preceded by
33 ;;; a character other than a newline and followed either by nothing
34 ;;; (end of the buffer), by a newline character at the end of the
35 ;;; buffer, or by two newline characters.
36 ;;;
37 ;;; It follows that:
38 ;;; * there can never be two marks in the same place,
39 ;;; * there are as many left-sticky marks as right-sticky marks,
40 ;;; * left-sticky and right-sticky marks alternate, starting with a
41 ;;; left-sticky mark
42 ;;;
43 ;;; N.B.: These invariants only hold AFTER a complete syntax analysis.
44 ;;; we do now know what might have happened during the editing
45 ;;; phase between to invocations of the analysis.
46
47 (in-package :climacs-syntax) ;;; Put this in a separate package once it works
48
49 (defun index-of-mark-after-offset (flexichain offset)
50 "Searches for the mark after `offset' in the marks stored in `flexichain'."
51 (loop with low-position = 0
52 with high-position = (nb-elements flexichain)
53 for middle-position = (floor (+ low-position high-position) 2)
54 until (= low-position high-position)
55 do (if (mark>= (element* flexichain middle-position) offset)
56 (setf high-position middle-position)
57 (setf low-position (floor (+ low-position 1 high-position) 2)))
58 finally (return low-position)))
59
60 (define-syntax text-syntax ("Text" (basic-syntax))
61 ((paragraphs :initform (make-instance 'standard-flexichain))))
62
63 (defmethod update-syntax (buffer (syntax text-syntax))
64 (let* ((high-offset (min (+ (offset (high-mark buffer)) 3) (size buffer)))
65 (low-offset (max (- (offset (low-mark buffer)) 3) 0)))
66 (with-slots (paragraphs) syntax
67 (let ((pos1 (index-of-mark-after-offset paragraphs low-offset)))
68 ;; start by deleting all syntax marks that are between the low and
69 ;; the high marks
70 (loop repeat (- (nb-elements paragraphs) pos1)
71 while (mark<= (element* paragraphs pos1) high-offset)
72 do (delete* paragraphs pos1))
73 ;; check the zone between low-offset and high-offset for
74 ;; paragraph delimiters
75 (loop with buffer-size = (size buffer)
76 for offset from low-offset to high-offset
77 do (cond ((and (< offset buffer-size)
78 (not (eql (buffer-object buffer offset) #\Newline))
79 (or (zerop offset)
80 (and (eql (buffer-object buffer (1- offset)) #\Newline)
81 (or (= offset 1)
82 (eql (buffer-object buffer (- offset 2)) #\Newline)))))
83 (let ((m (clone-mark (low-mark buffer) :left)))
84 (setf (offset m) offset)
85 (insert* paragraphs pos1 m))
86 (incf pos1))
87 ((and (plusp offset)
88 (not (eql (buffer-object buffer (1- offset)) #\Newline))
89 (or (= offset buffer-size)
90 (and (eql (buffer-object buffer offset) #\Newline)
91 (or (= offset (1- buffer-size))
92 (eql (buffer-object buffer (1+ offset)) #\Newline)))))
93 (let ((m (clone-mark (low-mark buffer) :right)))
94 (setf (offset m) offset)
95 (insert* paragraphs pos1 m))
96 (incf pos1))
97 (t nil)))))))
98
99 (defgeneric beginning-of-paragraph (mark text-syntax))
100
101 (defmethod beginning-of-paragraph (mark (syntax text-syntax))
102 (with-slots (paragraphs) syntax
103 (let ((pos1 (index-of-mark-after-offset paragraphs (offset mark))))
104 (when (> pos1 0)
105 (setf (offset mark)
106 (if (typep (element* paragraphs (1- pos1)) 'right-sticky-mark)
107 (offset (element* paragraphs (- pos1 2)))
108 (offset (element* paragraphs (1- pos1)))))))))
109
110 (defgeneric end-of-paragraph (mark text-syntax))
111
112 (defmethod end-of-paragraph (mark (syntax text-syntax))
113 (with-slots (paragraphs) syntax
114 (let ((pos1 (index-of-mark-after-offset
115 paragraphs
116 ;; if mark is at paragraph-end, jump to end of next
117 ;; paragraph
118 (1+ (offset mark)))))
119 (when (< pos1 (nb-elements paragraphs))
120 (setf (offset mark)
121 (if (typep (element* paragraphs pos1) 'left-sticky-mark)
122 (offset (element* paragraphs (1+ pos1)))
123 (offset (element* paragraphs pos1))))))))
124
125 (defmethod syntax-line-indentation (mark tab-width (syntax text-syntax))
126 (loop with indentation = 0
127 with mark2 = (clone-mark mark)
128 until (beginning-of-buffer-p mark2)
129 do (previous-line mark2)
130 (setf indentation (line-indentation mark2 tab-width))
131 while (empty-line-p mark2)
132 finally (return indentation)))

  ViewVC Help
Powered by ViewVC 1.1.5