/[cmucl]/src/hemlock/line.lisp
ViewVC logotype

Contents of /src/hemlock/line.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.4 - (hide annotations)
Tue Mar 13 15:49:54 2001 UTC (13 years, 1 month ago) by pw
Branch: MAIN
CVS Tags: sparc-tramp-assem-base, double-double-array-base, post-merge-intl-branch, release-19b-pre1, release-19b-pre2, merged-unicode-utf16-extfmt-2009-06-11, double-double-init-sparc-2, unicode-utf16-extfmt-2009-03-27, double-double-base, snapshot-2007-09, snapshot-2007-08, snapshot-2008-08, snapshot-2008-09, ppc_gencgc_snap_2006-01-06, sse2-packed-2008-11-12, snapshot-2008-05, snapshot-2008-06, snapshot-2008-07, snapshot-2007-05, snapshot-2008-01, snapshot-2008-02, snapshot-2008-03, intl-branch-working-2010-02-19-1000, snapshot-2006-11, snapshot-2006-10, double-double-init-sparc, snapshot-2006-12, unicode-string-buffer-impl-base, sse2-base, release-20b-pre1, release-20b-pre2, unicode-string-buffer-base, sse2-packed-base, sparc-tramp-assem-2010-07-19, amd64-dd-start, snapshot-2003-10, snapshot-2004-10, release-18e-base, release-19f-pre1, snapshot-2008-12, snapshot-2008-11, intl-2-branch-base, snapshot-2004-08, snapshot-2004-09, remove_negative_zero_not_zero, snapshot-2007-01, snapshot-2007-02, snapshot-2004-05, snapshot-2004-06, snapshot-2004-07, release-19e, release-19d, GIT-CONVERSION, double-double-init-ppc, release-19c, dynamic-extent-base, unicode-utf16-sync-2008-12, LINKAGE_TABLE, release-19c-base, cross-sol-x86-merged, label-2009-03-16, release-19f-base, PRE_LINKAGE_TABLE, merge-sse2-packed, mod-arith-base, sparc_gencgc_merge, merge-with-19f, snapshot-2004-12, snapshot-2004-11, intl-branch-working-2010-02-11-1000, unicode-snapshot-2009-05, unicode-snapshot-2009-06, amd64-merge-start, ppc_gencgc_snap_2005-12-17, double-double-init-%make-sparc, unicode-utf16-sync-2008-07, release-18e-pre2, unicode-utf16-sync-2008-09, unicode-utf16-extfmts-sync-2008-12, prm-before-macosx-merge-tag, cold-pcl-base, RELEASE_20b, snapshot-2008-04, snapshot-2003-11, snapshot-2005-07, unicode-utf16-sync-label-2009-03-16, RELEASE_19f, snapshot-2007-03, release-20a-base, cross-sol-x86-base, unicode-utf16-char-support-2009-03-26, unicode-utf16-char-support-2009-03-25, release-19a-base, unicode-utf16-extfmts-pre-sync-2008-11, snapshot-2008-10, sparc_gencgc, snapshot-2007-04, snapshot-2010-12, snapshot-2010-11, unicode-utf16-sync-2008-11, snapshot-2007-07, snapshot-2011-09, snapshot-2011-06, snapshot-2011-07, snapshot-2011-04, snapshot-2007-06, snapshot-2011-02, snapshot-2011-03, snapshot-2011-01, snapshot-2003-12, release-19a-pre1, release-19a-pre3, release-19a-pre2, pre-merge-intl-branch, release-19a, UNICODE-BASE, double-double-array-checkpoint, double-double-reader-checkpoint-1, release-19d-base, release-19e-pre1, double-double-irrat-end, release-19e-pre2, snapshot-2010-05, snapshot-2010-04, snapshot-2010-07, snapshot-2010-06, snapshot-2010-01, snapshot-2010-03, snapshot-2010-02, release-19d-pre2, release-19d-pre1, snapshot-2010-08, release-18e, double-double-init-checkpoint-1, double-double-reader-base, label-2009-03-25, snapshot-2005-03, release-19b-base, cross-sol-x86-2010-12-20, double-double-init-x86, sse2-checkpoint-2008-10-01, intl-branch-2010-03-18-1300, snapshot-2005-11, double-double-sparc-checkpoint-1, snapshot-2004-04, sse2-merge-with-2008-11, sse2-merge-with-2008-10, snapshot-2005-10, RELEASE_20a, snapshot-2005-12, release-20a-pre1, snapshot-2005-01, snapshot-2009-11, snapshot-2009-12, unicode-utf16-extfmt-2009-06-11, portable-clx-import-2009-06-16, unicode-utf16-string-support, release-19c-pre1, cross-sparc-branch-base, release-19e-base, intl-branch-base, double-double-irrat-start, snapshot-2005-06, snapshot-2005-05, snapshot-2005-04, ppc_gencgc_snap_2005-05-14, snapshot-2005-02, unicode-utf16-base, portable-clx-base, snapshot-2005-09, snapshot-2005-08, lisp-executable-base, snapshot-2009-08, snapshot-2007-12, snapshot-2007-10, snapshot-2007-11, snapshot-2009-02, snapshot-2009-01, snapshot-2009-07, snapshot-2009-05, snapshot-2009-04, snapshot-2006-02, snapshot-2006-03, release-18e-pre1, snapshot-2006-01, snapshot-2006-06, snapshot-2006-07, snapshot-2006-04, snapshot-2006-05, pre-telent-clx, snapshot-2006-08, snapshot-2006-09, HEAD
Branch point for: release-19b-branch, double-double-reader-branch, double-double-array-branch, mod-arith-branch, RELEASE-19F-BRANCH, portable-clx-branch, sparc_gencgc_branch, cross-sparc-branch, RELEASE-20B-BRANCH, unicode-string-buffer-branch, sparc-tramp-assem-branch, dynamic-extent, UNICODE-BRANCH, release-19d-branch, ppc_gencgc_branch, sse2-packed-branch, lisp-executable, RELEASE-20A-BRANCH, amd64-dd-branch, double-double-branch, unicode-string-buffer-impl-branch, intl-branch, release-18e-branch, cold-pcl, unicode-utf16-branch, cross-sol-x86-branch, release-19e-branch, sse2-branch, release-19a-branch, release-19c-branch, intl-2-branch, unicode-utf16-extfmt-branch
Changes since 1.3: +3 -3 lines
Change toplevel PROCLAIMs to DECLAIMs.
1 ram 1.1 ;;; -*- Log: hemlock.log; Package: Hemlock-Internals -*-
2     ;;;
3     ;;; **********************************************************************
4 ram 1.2 ;;; This code was written as part of the CMU Common Lisp project at
5     ;;; Carnegie Mellon University, and has been placed in the public domain.
6     ;;;
7     (ext:file-comment
8 pw 1.4 "$Header: /tiger/var/lib/cvsroots/cmucl/src/hemlock/line.lisp,v 1.4 2001/03/13 15:49:54 pw Rel $")
9 ram 1.2 ;;;
10 ram 1.1 ;;; **********************************************************************
11     ;;;
12     ;;; This file contains definitions for the Line structure, and some
13     ;;; functions and macros to manipulate them.
14     ;;;
15     ;;; This stuff was allowed to become implementation dependant because
16     ;;; you make thousands of lines, so speed is real important. In some
17     ;;; implementations (the Perq for example) it may be desirable to
18     ;;; not actually cons the strings in the line objects until someone
19     ;;; touches them, and just keep a pointer in the line to where the file
20     ;;; is mapped in memory. Such lines are called "buffered". This stuff
21     ;;; links up with the file-reading stuff and the line-image building stuff.
22     ;;;
23 ram 1.2 (in-package "HEMLOCK-INTERNALS")
24 ram 1.1 (export '(line linep line-previous line-next line-plist line-signature))
25    
26     (setf (documentation 'linep 'function)
27     "Returns true if its argument is a Hemlock line object, Nil otherwise.")
28     (setf (documentation 'line-previous 'function)
29     "Return the Hemlock line that precedes this one, or Nil if there is no
30     previous line.")
31     (setf (documentation 'line-next 'function)
32     "Return the Hemlock line that follows this one, or Nil if there is no
33     next line.")
34     (setf (documentation 'line-plist 'function)
35     "Return a line's property list. This may be manipulated with Setf and Getf.")
36    
37    
38     ;;;; The line object:
39    
40 pw 1.4 (declaim (inline %make-line))
41 ram 1.1 (defstruct (line (:print-function %print-hline)
42 ram 1.2 (:constructor %make-line)
43     (:predicate linep))
44 ram 1.1 "A Hemlock line object. See Hemlock design document for details."
45     ;;
46     ;; Something that represents the contents of the line. This is
47     ;; guaranteed to change (as compared by EQL) whenver the contents of the
48     ;; line changes, but might at arbitarary other times. There are
49     ;; currently about three different cases:
50     ;;
51     ;; Normal:
52     ;; A simple string holding the contents of the line.
53     ;;
54     ;; A cached line:
55     ;; The line is eq to Open-Line, and the actual contents are in the
56     ;; line cache. The %Chars may be either the original contents or a
57     ;; negative fixnum.
58     ;;
59     ;; A buffered line:
60     ;; The line hasn't been touched since it was read from a file, and the
61     ;; actual contents are in some system I/O area. This is indicated by
62     ;; the Line-Buffered-P slot being true. In buffered lines on the RT,
63     ;; the %Chars slot contains the system-area-pointer to the beginning
64     ;; of the characters.
65     (%chars "")
66     ;;
67     ;; Pointers to the next and previous lines in the doubly linked list of
68     ;; line structures.
69     previous
70     next
71     ;;
72     ;; A list of all the permanent marks pointing into this line.
73     (marks ())
74     ;;
75     ;; The buffer to which this line belongs, or a *disembodied-buffer-count*
76     ;; if the line is not in any buffer.
77     %buffer
78     ;;
79     ;; A non-negative integer (fixnum) that represents the ordering of lines
80     ;; within continguous range of lines (a buffer or disembuffered region).
81     ;; The number of the Line-Next is guaranteed to be strictly greater than
82     ;; our number, and the Line-Previous is guaranteed to be strictly less.
83     (number 0)
84     ;;
85     ;; The line property list, used by user code to annotate the text.
86     plist
87     ;;
88     ;; A slot that indicates whether this line is a buffered line, and if so
89     ;; contains information about how the text is stored. On the RT, this is
90     ;; the length of the text pointed to by the Line-%Chars.
91     #+Buffered-Lines
92     (buffered-p ()))
93    
94     ;;; Make Line-Chars the same as Line-%Chars on implementations without
95     ;;; buffered lines.
96     ;;;
97     #-Buffered-Lines
98     (defmacro line-chars (x)
99     `(line-%chars ,x))
100    
101    
102     ;;; If buffered lines are supported, then we create the string
103     ;;; representation for the characters when someone uses Line-Chars. People
104     ;;; who are prepared to handle buffered lines or who just want a signature
105     ;;; for the contents can use Line-%chars directly.
106     ;;;
107     #+Buffered-Lines
108     (defmacro line-chars (line)
109     `(the simple-string (if (line-buffered-p ,line)
110     (read-buffered-line ,line)
111     (line-%chars ,line))))
112     ;;;
113     #+Buffered-Lines
114     (defsetf line-chars %set-line-chars)
115     ;;;
116     #+Buffered-Lines
117     (defmacro %set-line-chars (line chars)
118     `(setf (line-%chars ,line) ,chars))
119    
120    
121     ;;; Line-Signature -- Public
122     ;;;
123     ;;; We can just return the Line-%Chars.
124     ;;;
125 pw 1.4 (declaim (inline line-signature))
126 ram 1.1 (defun line-signature (line)
127     "This function returns an object which serves as a signature for a line's
128     contents. It is guaranteed that any modification of text on the line will
129     result in the signature changing so that it is not EQL to any previous value.
130     Note that the signature may change even when the text hasn't been modified, but
131     this probably won't happen often."
132     (line-%chars line))
133    
134    
135     ;;; Return a copy of Line in buffer Buffer with the same chars. We use
136     ;;; this macro where we want to copy a line because it takes care of
137     ;;; the case where the line is buffered.
138     ;;;
139     (defmacro %copy-line (line &key previous number %buffer)
140     `(make-line :chars (line-%chars ,line)
141     :previous ,previous
142     :number ,number
143     :%buffer ,%buffer
144     #+Buffered-Lines :buffered-p
145     #+Buffered-Lines (line-buffered-p ,line)))
146 ram 1.2
147     ;;; Hide the fact that the slot isn't really called CHARS.
148     ;;;
149     (defmacro make-line (&rest keys)
150     `(%make-line ,@(substitute :%chars :chars keys)))
151 ram 1.1
152     (defmacro line-length* (line)
153     "Returns the number of characters on the line, but it's a macro!"
154     `(cond ((eq ,line open-line)
155     (+ left-open-pos (- line-cache-length right-open-pos)))
156     ((line-buffered-p ,line))
157     (t
158     (length (the simple-string (line-%chars ,line))))))

  ViewVC Help
Powered by ViewVC 1.1.5