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

Contents of /climacs/text-syntax.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (hide annotations)
Fri Jan 14 13:07:39 2005 UTC (9 years, 3 months ago) by rstrandh
Branch: MAIN
First attempt at a syntax for ordinary text.
1 rstrandh 1.1 ;;; -*- Mode: Lisp; Package: COMMON-LISP-USER -*-
2    
3     ;;; (c) copyright 2005 by
4     ;;; Robert Strandh (strandh@labri.fr)
5    
6     ;;; This library is free software; you can redistribute it and/or
7     ;;; modify it under the terms of the GNU Library General Public
8     ;;; License as published by the Free Software Foundation; either
9     ;;; version 2 of the License, or (at your option) any later version.
10     ;;;
11     ;;; This library is distributed in the hope that it will be useful,
12     ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13     ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
14     ;;; Library General Public License for more details.
15     ;;;
16     ;;; You should have received a copy of the GNU Library General Public
17     ;;; License along with this library; if not, write to the
18     ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19     ;;; Boston, MA 02111-1307 USA.
20    
21     ;;; Syntax for analysing ordinary text.
22    
23     ;;; Invariants after a complete syntax analysis:
24     ;;;
25     ;;; There is exactly one left-sticky mark at every offset followed by
26     ;;; character other than a newline and preceded either by nothing
27     ;;; (beginning of the buffer), by a newline character at the beginning
28     ;;; of the buffer, or by two newline characters.
29     ;;;
30     ;;; There is exactly one right-sticky mark at every offset preceded by
31     ;;; a character other than a newline and followed either by nothing
32     ;;; (end of the buffer), by a newline character at the end of the
33     ;;; buffer, or by two newline characters.
34     ;;;
35     ;;; It follows that:
36     ;;; * there can never be two marks in the same place,
37     ;;; * there are as many left-sticky marks as right-sticky marks,
38     ;;; * left-sticky and right-sticky marks alternate, starting with a
39     ;;; left-sticky mark
40     ;;;
41     ;;; N.B.: These invariants only hold AFTER a complete syntax analysis.
42     ;;; we do now know what might have happened during the editing
43     ;;; phase between to invocations of the analysis.
44    
45     (in-package :climacs-syntax) ;;; Put this in a separate package once it works
46    
47     (define-syntax text-syntax ("Text" (basic-syntax))
48     ((paragraphs :initform (make-instance 'standard-flexichain))))
49    
50     (defmethod redisplay-with-syntax :before (pane (syntax text-syntax))
51     (let* ((buffer (buffer pane))
52     (high-offset (min (+ (offset (high-mark buffer)) 3) (size buffer)))
53     (low-offset (max (- (offset (low-mark buffer)) 3) 0)))
54     (with-slots (paragraphs) syntax
55     (let* ((nb-paragraphs (nb-elements paragraphs))
56     (pos2 nb-paragraphs)
57     (pos1 0))
58     ;; start by deleting all syntax marks that are between the low and
59     ;; the high marks
60     (loop until (= pos1 pos2)
61     do (cond ((mark< (element* paragraphs (floor (+ pos1 pos2) 2))
62     low-offset)
63     (setf pos1 (floor (+ pos1 1 pos2) 2)))
64     (t
65     (setf pos2 (floor (+ pos1 pos2) 2)))))
66     (loop repeat (- nb-paragraphs pos1)
67     while (mark<= (element* paragraphs pos1) high-offset)
68     do (delete* paragraphs pos1))
69     ;; check the zone between low-offset and high-offset for
70     ;; paragraph delimiters
71     (loop with buffer-size = (size buffer)
72     for offset from low-offset to high-offset
73     do (cond ((and (< offset buffer-size)
74     (not (eql (buffer-object buffer offset) #\Newline))
75     (or (zerop offset)
76     (and (eql (buffer-object buffer (1- offset)) #\Newline)
77     (or (= offset 1)
78     (eql (buffer-object buffer (- offset 2)) #\Newline)))))
79     (insert* paragraphs pos1
80     (make-instance 'standard-left-sticky-mark
81     :buffer buffer :offset offset))
82     (incf pos1))
83     ((and (plusp offset)
84     (not (eql (buffer-object buffer (1- offset)) #\Newline))
85     (or (= offset buffer-size)
86     (and (eql (buffer-object buffer offset) #\Newline)
87     (or (= offset (1- buffer-size))
88     (eql (buffer-object buffer (1+ offset)) #\Newline)))))
89     (insert* paragraphs pos1
90     (make-instance 'standard-right-sticky-mark
91     :buffer buffer :offset offset))
92     (incf pos1))
93     (t nil)))))))

  ViewVC Help
Powered by ViewVC 1.1.5