edward

An extensible POSIX-compatible implementation of the ed(1) text editor

git clone https://git.8pit.net/edward.git

  1;;>| Address Constructors
  2;;>
  3;;> Procedures which create single address and range values.
  4
  5;;> Create a single address with an optional offset.
  6
  7(define make-addr
  8  (case-lambda
  9    ((addr) (list addr '()))
 10    ((addr off) (list addr off))))
 11
 12;;> Create an address range consisting of two addresses.
 13
 14(define make-range
 15  (case-lambda
 16    (() (make-range (make-addr '(current-line))))
 17    ((addr) (list addr #\, addr))
 18    ((start end) (list start #\, end))
 19    ((start sep end) (list start sep end))))
 20
 21;;> Predicate which returns true if the parsed address is a range.
 22
 23(define (range? obj)
 24  (and (list? obj)
 25       (eqv? (length obj) 3)))
 26
 27;;> Convert the given address to a range.
 28
 29(define (addr->range addr)
 30  (if (range? addr)
 31    addr
 32    (make-range addr)))
 33
 34;;> Convert the given range to an address.
 35
 36(define (range->addr addr)
 37  (if (range? addr)
 38    (last addr)
 39    addr))
 40
 41;;> Predicate which returns true if the given `obj` constitutes an address separator.
 42
 43(define (address-separator? obj)
 44  (or
 45    (eq? obj #\,)
 46    (eq? obj #\;)))
 47
 48;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 49
 50;;>| Parser Combinators
 51;;>
 52;;> Edward [parser combinators][edward parse] for parsing ed addresses.
 53;;>
 54;;> [edward parse]: edward.parse.html
 55
 56;; From POSIX.1-2008:
 57;;
 58;;   The <period> character ('.') shall address the current line.
 59
 60(define parse-current
 61  (parse-map
 62    (parse-char #\.)
 63    (lambda (ch)
 64      (cons 'current-line '()))))
 65
 66;; From POSIX.1-2008:
 67;;
 68;;   The <dollar-sign> character ('$') shall address the last line of
 69;;   the edit buffer.
 70
 71(define parse-last
 72  (parse-map
 73    (parse-char #\$)
 74    (lambda (ch)
 75      (cons 'last-line '()))))
 76
 77;; From POSIX.1-2008:
 78;;
 79;;   The positive decimal number n shall address the nth line of the
 80;;   edit buffer.
 81
 82(define parse-nth
 83  (parse-map
 84    parse-digits
 85    (lambda (num)
 86      (cons 'nth-line num))))
 87
 88;; From POSIX.1-2008:
 89;;
 90;;   The <apostrophe>-x character pair ("'x") shall address the line
 91;;   marked with the mark name character x, which shall be a lowercase
 92;;   letter from the portable character set.
 93
 94(define parse-mark
 95  (parse-map
 96    (parse-seq
 97      (parse-commit
 98        (parse-char #\')
 99        "invalid mark")
100      parse-lowercase)
101    (lambda (lst)
102      (cons 'marked-line (cadr lst)))))
103
104;; From POSIX.1-2008:
105;;
106;;   A BRE enclosed by <slash> characters ('/') shall address the first
107;;   line found by searching forwards from the line following the
108;;   current line toward the end of the edit buffer. The second <slash>
109;;   can be omitted at the end of a command line. Within the BRE, a
110;;   <backslash>-<slash> pair ("\/") shall represent a literal <slash>
111;;   instead of the BRE delimiter.
112
113(define parse-forward-bre
114  (parse-map
115    (parse-regex-lit* #\/)
116    (lambda (str)
117      (cons 'regex-forward str))))
118
119;; From POSIX-1.2008:
120;;
121;;   A BRE enclosed by <question-mark> characters ('?') shall address
122;;   the first line found by searching backwards from the line preceding
123;;   the current line toward the beginning of the edit buffer. The
124;;   second <question-mark> can be omitted at the end of a command line.
125;;   Within the BRE, a <backslash>-<question-mark> pair ("\?") shall
126;;   represent a literal <question-mark> instead of the BRE delimiter.
127
128(define parse-backward-bre
129  (parse-map
130    (parse-regex-lit* #\?)
131    (lambda (str)
132      (cons 'regex-backward str))))
133
134;; From POSIX.1-2008:
135;;
136;;   A <plus-sign> ('+') or <hyphen-minus> character ('-') followed by a
137;;   decimal number shall address the current line plus or minus the
138;;   number. A <plus-sign> or <hyphen-minus> character not followed by a
139;;   decimal number shall address the current line plus or minus 1.
140
141(define parse-offset
142  (parse-map
143    (parse-seq
144      (parse-or
145        (parse-char #\+)
146        (parse-char #\-))
147      (parse-optional parse-digits))
148    (lambda (lst)
149      (let* ((fst (car lst))
150             (snd (cadr lst))
151             (num (if snd snd 1)))
152        (if (eqv? fst #\-)
153          (- 0 num) num)))))
154
155(define parse-relative
156  (parse-map
157    parse-offset
158    (lambda (num)
159      (cons 'relative num))))
160
161;;> Utility procedure for parsing addresses without offset.
162
163(define parse-addr
164  (parse-or
165    parse-current
166    parse-last
167    parse-nth
168    parse-mark
169    parse-forward-bre
170    parse-backward-bre
171    parse-relative))
172
173(define %parse-addr-with-off
174  (parse-repeat
175    (parse-map
176      (parse-seq
177        (parse-ignore parse-blanks)
178        (parse-or
179          parse-offset
180          parse-digits))
181      car)))
182
183;;> Addresses can be followed by zero or more address offsets, optionally
184;;> separated by blanks. Offsets are a decimal number optionally prefixed by
185;;> `+` or `-` character. A `+` or `-` character not followed by a
186;;> decimal number shall be interpreted as `+1`/`-1`. This procedure is
187;;> responsible for parsing an address with an optional offset.
188
189(define parse-addr-with-off
190  (parse-or
191    (parse-atomic
192      (parse-seq
193        parse-addr
194        %parse-addr-with-off))
195    (parse-fail "unknown address format")))
196
197;; From POSIX-1.2008:
198;;
199;;   Addresses shall be separated from each other by a <comma> (',') or
200;;   <semicolon> character (';').
201;;
202;; POSIX also mandates a table with rules in case addresses are omitted
203;; on either side of the separation character. Consult the standard for
204;; more information.
205
206(define parse-separator
207  (parse-char address-separator?))
208
209;;> This procedure expands a given parsed address according to the
210;;> [omission rules][ed addresses] mandated by the POSIX standard. The
211;;> procedure receives an address parsed by [parse-addrs][parse-addrs]
212;;> as an input value and returns an [address-range][make-addr].
213;;>
214;;> [parse-addrs]: #parse-addrs
215;;> [make-addr]: #make-addr
216;;> [ed addresses]: https://pubs.opengroup.org/onlinepubs/9699919799/utilities/ed.html#tag_20_38_13_02
217
218(define expand-addr
219  (match-lambda
220    ((#\,)
221     (make-range (make-addr '(nth-line . 1))
222                 #\,
223                 (make-addr '(last-line))))
224    ((#\, addr)
225     (make-range (make-addr '(nth-line . 1)) #\, addr))
226    ((addr #\,)
227     (make-range addr #\, addr))
228    ((#\;)
229     (make-range (make-addr '(current-line)) #\; (make-addr '(last-line))))
230    ((#\; addr)
231     (make-range (make-addr '(current-line)) #\; addr))
232    ((addr #\;)
233     (make-range addr #\; addr))
234    ((addr1 sep addr2)
235     (make-range addr1 sep addr2))))
236
237(define %parse-addrs
238  (parse-or
239    (parse-repeat+
240      (parse-memoize "address parser"
241        (parse-seq
242          (parse-or
243            parse-addr-with-off
244            (parse-ignore parse-beginning-of-line))
245          (parse-ignore parse-blanks)
246          parse-separator
247          (parse-ignore parse-blanks)
248          (parse-or
249            parse-addr-with-off
250            (parse-ignore parse-epsilon)))))
251    (parse-map
252      parse-addr-with-off
253      (lambda (addr)
254        (list (make-range addr))))))
255
256;;> Parse an address chain consisting of multiple addresses separated by
257;;> `,` or `;`. Returns an address list which can be converted to a line
258;;> pair using the [addrlst->lpair][addrlst->lpair] procedure.
259;;>
260;;> [addrlst->lpair]: edward.ed.editor.html#addrlst->lpair
261
262(define parse-addrs
263  (parse-map
264    %parse-addrs
265    concatenate))