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))