blob: a4cc100bdaa25b6d56d5a0185b4cca622c5f9220 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
|
(in-package #:monparser)
(defstruct cursor
(start 0 :type (unsigned-byte 44))
(end 0 :type (unsigned-byte 44))
(data "" :type simple-string))
(declaim (ftype (function (cursor) boolean) cursor-has-data?))
(defun cursor-has-data? (cursor)
(< (cursor-end cursor) (length (cursor-data cursor))))
(declaim (ftype (function (cursor) boolean) cursor-at-start?))
(defun cursor-at-start? (cursor)
(= (cursor-start cursor) (cursor-end cursor)))
(declaim (ftype (function (cursor) standard-char) cursor-peek))
(defun cursor-peek (cursor)
(char (cursor-data cursor)
(cursor-end cursor)))
(declaim (ftype (function (cursor) cursor) cursor-advance))
(defun cursor-advance (cursor)
(make-cursor :data (cursor-data cursor)
:start (cursor-start cursor)
:end (+ (cursor-end cursor) 1)))
(declaim (ftype (function (cursor) cursor) cursor-rebase))
(defun cursor-rebase (cursor)
(make-cursor :data (cursor-data cursor)
:start (cursor-end cursor)
:end (cursor-end cursor)))
(declaim (ftype (function (cursor cursor) cursor) cursor-merge))
(defun cursor-merge (prev next)
(assert (eq (cursor-data prev) (cursor-data next)))
(make-cursor :data (cursor-data next)
:start (cursor-start prev)
:end (cursor-end next)))
(declaim (ftype (function (cursor cursor) fixnum) distance))
(defun distance (from to)
(assert (eq (cursor-data from) (cursor-data to)))
(- (cursor-end to)
(cursor-end from)))
(declaim (ftype (function (cursor &key (:side-length fixnum)) t) context-window))
(defun context-window (cursor &key (side-length 20))
(let ((begin (max (- (cursor-start cursor) side-length) 0))
(end (min (+ (cursor-end cursor) side-length) (length (cursor-data cursor))))
(result '()))
(push (subseq (cursor-data cursor) (cursor-end cursor) end) result)
(push (subseq (cursor-data cursor) (cursor-start cursor) (cursor-end cursor)) result)
(push (subseq (cursor-data cursor) begin (cursor-start cursor)) result)
result))
(declaim (ftype (function (cursor) (cons fixnum fixnum)) line-and-column))
(defun line-and-column (cursor)
(let ((line 1) (column 1))
(dotimes (i (cursor-end cursor))
(let ((c (char (cursor-data cursor) i)))
(case c
(#\Newline
(incf line)
(setf column 1))
(t (incf column)))))
(cons line column)))
(defmethod print-object ((obj cursor) stream)
(print-unreadable-object (obj stream :type t)
(let ((str (if (cursor-has-data? obj)
(format nil "~{~a[4;33m~a[m~a~}"
(context-window obj :side-length 10))
"END OF DATA")))
(format stream "~s" (substitute #\~ #\Newline str)))))
|
