edward

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

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

  1;;;;
  2;;> Append command.
  3;;;;
  4
  5(define (exec-append editor line data)
  6  (editor-goto!
  7    editor
  8    (editor-append! editor line data)))
  9
 10(define-input-cmd (append exec-append (make-addr '(current-line)))
 11  (parse-cmd-char #\a))
 12
 13;;;;
 14;;> Change command.
 15;;;;
 16
 17;; The change command does not support a zero address see:.
 18;;
 19;;   * https://lists.gnu.org/archive/html/bug-ed/2016-04/msg00009.html
 20;;   * https://austingroupbugs.net/view.php?id=1130
 21
 22(define (exec-change editor lines data)
 23  (editor-goto!
 24    editor
 25    (editor-replace! editor lines data)))
 26
 27(define-input-cmd (change exec-change (make-range))
 28  (parse-cmd-char #\c))
 29
 30;;;;
 31;;> Read command.
 32;;;;
 33
 34(define (exec-read editor line filename)
 35  (let* ((f  (editor-filename editor filename))
 36         (in (read-from f)))
 37    (if (and
 38          (empty-string? (text-editor-filename editor))
 39          (not (filename-cmd? f)))
 40      (text-editor-filename-set! editor f))
 41
 42    (if in
 43      (begin
 44        (editor-append! editor line (car in))
 45        (editor-goto! editor (editor-lines editor))
 46
 47        ;; Print amount of bytes read (unless in silent mode).
 48        (editor-verbose editor (cdr in)))
 49      (editor-error editor "cannot open input file"))))
 50
 51(define-file-cmd (read exec-read (make-addr '(last-line)))
 52  (parse-file-cmd #\r))
 53
 54;;;;
 55;;> Substitute command.
 56;;;;
 57
 58(define (exec-subst editor lines triplet nth)
 59  (let* ((lst (editor-get-lines editor lines))
 60         (bre (editor-make-regex editor (first triplet)))
 61         (rep (editor-restr editor (second triplet)))
 62         (print? (third triplet))
 63
 64         ;; Replaces all lines in the selected range.
 65         ;; Returns line of last replaced line or zero if no line was replaced.
 66         (re (car
 67               ;; acc is a pair of last replaced line and lnum offset. The offset
 68               ;; accounts for prior substitions inserting multiple new file lines.
 69               (fold (lambda (line lnum acc)
 70                       (let*-values (((r modified) (regex-replace bre rep line nth))
 71                                     ((n) (string-split r "\n" #t))) ;; string → list
 72                         (if (not modified)
 73                           acc
 74                           (let* ((offset (cdr acc))
 75                                  (lnum (+ lnum offset)))
 76                             (cons
 77                               (editor-replace! editor (cons lnum lnum) n)
 78                               (+ offset (dec (length n))))))))
 79                     '(0 . 0) lst (editor-line-numbers lines)))))
 80    (if (zero? re)
 81      ((subst-nomatch-handler) "no match")
 82      (editor-goto! editor re))
 83
 84    ;; Special case handling of omitted regex delimiter in substitute
 85    ;; command. For the substitute command only the delimiter of the
 86    ;; replacement can be omitted, not the regex delimiter itself.
 87    (when print?
 88      (exec-print editor (range->lpair editor (make-range))))))
 89
 90(define-edit-cmd (substitute exec-subst (make-range))
 91  (parse-cmd-char #\s)
 92
 93  ;; Triplet: (RE, replacement, print?)
 94  (parse-re-pair
 95    ;; POSIX only mentions escaping of the delimiter character within
 96    ;; the RE but not within the replacement thus this is not implemented.
 97    (lambda (delim)
 98      (parse-or
 99        (parse-bind
100          'previous-replace
101          (parse-char (lambda (c)
102                        (and
103                          (not (char=? c delim))
104                          (char=? c #\%)))))
105        (parse-replace delim))))
106
107  (parse-default
108    (parse-or
109      (parse-bind 0 (parse-char #\g))
110      parse-digits)
111    1))
112
113;;;;
114;;> Delete command.
115;;;;
116
117(define (exec-delete editor lines)
118  (let ((saddr (car lines)))
119    (editor-remove! editor lines)
120    (if (zero? (editor-lines editor))
121      (editor-goto! editor 0)
122      (editor-goto! editor (min (editor-lines editor) saddr)))))
123
124(define-edit-cmd (delete exec-delete (make-range))
125  (parse-cmd-char #\d))
126
127;;;;
128;;> Edit command.
129;;;;
130
131(define (%exec-edit editor filename)
132  (call-when-confirmed editor '%edit
133    (lambda ()
134      (exec-edit editor filename))))
135
136(define-file-cmd (%edit %exec-edit)
137  (parse-file-cmd #\e))
138
139;;;;
140;;> Edit without checking command.
141;;;;
142
143(define (exec-edit editor filename)
144  (editor-reset! editor)
145
146  (exec-read editor (addr->line editor (make-addr '(last-line)))
147             (editor-filename editor filename))
148  (text-editor-modified-set! editor #f)
149
150  ;; exec-read only updates filename if none is set.
151  ;; XXX: Might be beneficial to not re-use exec-read here.
152  (when (not (filename-cmd? filename))
153    (text-editor-filename-set!
154      editor
155      (editor-filename editor filename))))
156
157(define-file-cmd (edit exec-edit)
158  (parse-file-cmd #\E))
159
160;;;;
161;;> Filename command.
162;;;;
163
164(define (exec-filename editor filename)
165  (if (filename-cmd? filename) ;; XXX: Could be handled in parser
166    (editor-raise "current filename cannot be a shell command")
167    (begin
168      (unless (empty-string? filename)
169        (text-editor-filename-set! editor filename))
170      (println (editor-filename editor)))))
171
172(define-file-cmd (filename exec-filename)
173  (parse-file-cmd #\f))
174
175;;;;
176;;> Global command.
177;;;;
178
179(define (exec-global editor lines regex cmdstr)
180  (exec-command-list editor regex-match? lines regex cmdstr))
181
182(define-file-cmd (global exec-global
183                         (make-range
184                           (make-addr '(nth-line . 1))
185                           (make-addr '(last-line))))
186  (parse-cmd-char #\g)
187  parse-re
188  unwrap-command-list)
189
190;;;;
191;;> Interactive global command.
192;;;;
193
194(define (exec-interactive editor lines regex)
195  (exec-command-list-interactive editor regex-match? lines regex))
196
197(define-file-cmd (interactive exec-interactive
198                              (make-range
199                                (make-addr '(nth-line . 1))
200                                (make-addr '(last-line))))
201  (parse-cmd-char #\G)
202  parse-re)
203
204;;;;
205;;> Help command.
206;;;;
207
208(define (exec-help editor)
209  (let ((msg (text-editor-error editor)))
210    (when msg
211      (println msg))))
212
213(define-edit-cmd (help exec-help)
214  (parse-cmd-char #\h))
215
216;;;;
217;;> Help-mode command.
218;;;;
219
220(define (exec-help-mode editor)
221  (let ((prev-help? (text-editor-help? editor)))
222    (text-editor-help-set! editor (not prev-help?))
223    (when (not prev-help?)
224      (exec-help editor))))
225
226(define-edit-cmd (help-mode exec-help-mode)
227  (parse-cmd-char #\H))
228
229;;;;
230;;> Insert command.
231;;;;
232
233(define (exec-insert editor line data)
234  (let* ((sline (max (dec line) 0)))
235    (editor-goto!
236      editor
237      (editor-append! editor sline data))))
238
239(define-input-cmd (insert exec-insert (make-addr '(current-line)))
240  (parse-cmd-char #\i))
241
242;;;;
243;;> Join command.
244;;;;
245
246(define (exec-join editor lines)
247  (let ((start (car lines))
248        (end   (cdr lines)))
249    (unless (eqv? start end)
250      (editor-join! editor lines)
251      (editor-goto! editor start))))
252
253(define-edit-cmd (join exec-join (make-range
254                                   (make-addr '(current-line))
255                                   (make-addr '(current-line) '(1))))
256  (parse-cmd-char #\j))
257
258;;;;
259;;> Mark command.
260;;;;
261
262(define (exec-mark editor line mark)
263  (editor-mark-line editor line mark))
264
265(define-edit-cmd (mark exec-mark (make-addr '(current-line)))
266  (parse-cmd-char #\k)
267  parse-lowercase)
268
269;;;;
270;;> List command.
271;;;;
272
273(define (exec-list editor lines)
274  (let ((lst (editor-get-lines editor lines))
275        (end (cdr lines)))
276    (for-each (lambda (line)
277                (display
278                  (string->human-readable (string-append line "\n"))))
279              lst)
280    (editor-goto! editor end)))
281
282(define-print-cmd 'list exec-list #\l)
283
284;;;;
285;;> Move command.
286;;;;
287
288(define (exec-move editor lines addr)
289  (let ((dest-line (addr->line editor addr)))
290    (if (editor-in-range? editor lines dest-line)
291      (editor-raise "invalid move destination")
292      (editor-goto! editor (editor-move! editor lines dest-line)))))
293
294(define-edit-cmd (move exec-move (make-range))
295  (parse-cmd-char #\m)
296  parse-addr-with-off)
297
298;;;;
299;;> Copy command.
300;;;;
301
302(define (exec-copy editor lines addr)
303  (let ((dest-line (addr->line editor addr)))
304    (if (editor-in-range? editor lines dest-line)
305      (editor-raise "invalid copy destination")
306      (let ((data (editor-get-lines editor lines))
307            (target (addr->line editor addr)))
308        (editor-goto!
309          editor
310          (editor-append! editor target data))))))
311
312(define-edit-cmd (copy exec-copy (make-range))
313  (parse-cmd-char #\t)
314  parse-addr-with-off)
315
316;;;;
317;;> Undo command.
318;;;;
319
320(define (exec-undo editor)
321  (editor-undo! editor))
322
323(define-file-cmd (undo exec-undo)
324  (parse-cmd-char #\u))
325
326;;;;
327;;> Global non-matched command.
328;;;;
329
330(define (exec-global-unmatched editor lines regex cmdstr)
331  (exec-command-list editor (lambda (bre line)
332                              (not (regex-match? bre line)))
333                     lines regex cmdstr))
334
335(define-file-cmd (global-unmatched exec-global-unmatched
336                                   (make-range
337                                     (make-addr '(nth-line . 1))
338                                     (make-addr '(last-line))))
339  (parse-cmd-char #\v)
340  parse-re
341  unwrap-command-list)
342
343;;;;
344;;> Interactive global not-matched command.
345;;;;
346
347(define (exec-interactive-unmatched editor lines regex)
348  (exec-command-list-interactive editor (lambda (bre line)
349                                          (not (regex-match? bre line)))
350                                 lines regex))
351
352(define-file-cmd (interactive-unmatched exec-interactive-unmatched
353                                        (make-range
354                                          (make-addr '(nth-line . 1))
355                                          (make-addr '(last-line))))
356  (parse-cmd-char #\V)
357  parse-re)
358
359;;;;
360;;> Write command.
361;;;;
362
363(define (exec-write editor lines filename)
364  (let* ((fn (editor-filename editor filename))
365         (lines (editor-get-lines editor lines))
366         (written (write-lines fn lines)))
367    (unless written
368      (editor-raise "cannot open output file"))
369    (editor-verbose editor written)
370
371    (unless (filename-cmd? filename)
372      (if (empty-string? (text-editor-filename editor))
373        (text-editor-filename-set! editor fn))
374      (text-editor-modified-set! editor #f))))
375
376(define-file-cmd (write exec-write
377                        (make-range
378                          (make-addr '(nth-line . 1))
379                          (make-addr '(last-line))))
380  (parse-file-cmd #\w))
381
382;;;;
383;;> Line number command.
384;;;;
385
386(define (exec-line-number editor addr)
387  (println (text-editor-line editor)))
388
389(define-edit-cmd (line-number exec-line-number (make-addr '(last-line)))
390  (parse-cmd-char #\=))
391
392;;;;
393;;> Number command.
394;;;;
395
396(define (exec-number editor lines)
397  (let ((lst (editor-get-lines editor lines))
398        (eline (cdr lines)))
399    (for-each
400      (lambda (line number)
401        (println number "\t" line))
402      lst (editor-line-numbers lines))
403    (editor-goto! editor eline)))
404
405(define-print-cmd 'number exec-number #\n)
406
407;;;;
408;;> Print command.
409;;;;
410
411(define (exec-print editor lines)
412  (let ((lst (editor-get-lines editor lines))
413        (end (cdr lines)))
414    (for-each println lst)
415    (editor-goto! editor end)))
416
417(define-print-cmd 'print exec-print #\p)
418
419;;;;
420;;> Prompt command.
421;;;;
422
423(define (exec-prompt editor)
424  (editor-toggle-prompt! editor))
425
426(define-edit-cmd (prompt exec-prompt)
427  (parse-cmd-char #\P))
428
429;;;;
430;;> Quit command.
431;;;;
432
433(define (%exec-quit editor)
434  (call-when-confirmed editor '%quit
435    (lambda ()
436      (exec-quit editor))))
437
438(define-file-cmd (%quit %exec-quit)
439  (parse-cmd-char #\q))
440
441;; Special case: quit command via EOF.
442
443;; Manually use register-command here to allow interpreting
444;; EOF as a command without a terminating newline character.
445(register-command '%eof
446  (parse-map
447    parse-end
448    (lambda (args)
449      ;; XXX: register-command uses '%eof as a command name
450      ;; but for the command itself we use '%quit as well
451      ;; This allows confirming quit commands with EOF and
452      ;; vice versa. Furthermore we can filter out the EOF
453      ;; handling individually this way (e.g. for g cmd).
454      (make-cmd '%quit '() %exec-quit '()))))
455
456;;;;
457;;> Quit without checking command.
458;;;;
459
460(define (exec-quit editor)
461  (exit))
462
463(define-file-cmd (quit exec-quit)
464  (parse-cmd-char #\Q))
465
466;;;;
467;;> Shell escape command.
468;;;;
469
470(define (exec-command editor cmd)
471  (let ((cmdstr (fold-right (lambda (x ys)
472                              (string-append
473                                (case x
474                                  ((current-file) (editor-filename editor))
475                                  ((previous-command) (editor-shell-cmd editor))
476                                  (else x))
477                                ys)) "" cmd)))
478    (unless (and (list? cmd) (every string? cmd)) ;; replacement performed
479      (println cmdstr))
480    (system cmdstr)
481    (editor-verbose editor "!")
482    (text-editor-last-cmd-set! editor cmdstr)))
483
484(define-file-cmd (shell-escape exec-command)
485  (parse-cmd-char #\!)
486  (parse-map
487    (parse-seq
488      (parse-optional
489        (parse-bind 'previous-command (parse-char #\!)))
490      (parse-repeat
491        (parse-commit
492          (parse-or
493            (parse-bind 'current-file (parse-char #\%))
494            (parse-as-string
495              (parse-repeat+
496                (parse-or
497                  (parse-esc (parse-char #\%))
498                  (parse-not-char (char-set #\% #\newline)))))))))
499    (match-lambda
500      ((prefix cmd) (if prefix (cons prefix cmd) cmd)))))
501
502;;;;
503;;> Null command.
504;;;;
505
506(define (exec-null editor line)
507  (if (zero? line)
508    (editor-raise "invalid address")
509    (begin
510      (println (car (editor-get-lines editor (cons line line))))
511      (editor-goto! editor line))))
512
513(define-file-cmd (null exec-null (make-addr '(current-line) '(+1)))
514  (parse-ignore parse-epsilon))