← Back to branch summary

~ubuntu-branches/ubuntu/trusty/erlang/trusty

« back to all changes in this revision

Viewing changes to lib/tools/test/eprof_SUITE_data/eed.erl

  • Committer: Bazaar Package Importer
  • Author(s): Clint Byrum
  • Date: 2011-05-05 15:48:43 UTC
  • mfrom: (3.5.13 sid)
  • Revision ID: james.westby@ubuntu.com-20110505154843-0om6ekzg6m7ugj27
Tags: 1:14.b.2-dfsg-3ubuntu1
* Merge from debian unstable.  Remaining changes:
  - Drop libwxgtk2.8-dev build dependency. Wx isn't in main, and not
    supposed to.
  - Drop erlang-wx binary.
  - Drop erlang-wx dependency from -megaco, -common-test, and -reltool, they
    do not really need wx. Also drop it from -debugger; the GUI needs wx,
    but it apparently has CLI bits as well, and is also needed by -megaco,
    so let's keep the package for now.
  - debian/patches/series: Do what I meant, and enable build-options.patch
    instead.
* Additional changes:
  - Drop erlang-wx from -et
* Dropped Changes:
  - patches/pcre-crash.patch: CVE-2008-2371: outer level option with
    alternatives caused crash. (Applied Upstream)
  - fix for ssl certificate verification in newSSL: 
    ssl_cacertfile_fix.patch (Applied Upstream)
  - debian/patches/series: Enable native.patch again, to get stripped beam
    files and reduce the package size again. (build-options is what
    actually accomplished this)
  - Remove build-options.patch on advice from upstream and because it caused
    odd build failures.

Show diffs side-by-side

added added

removed removed

Lines of Context:
lib/tools/test/eprof_SUITE_data/eed.erl
 
1
%%%----------------------------------------------------------------------
 
2
%%% File    : eed.erl
 
3
%%% Author  : Bjorn Gustavsson <bjorn@strider>
 
4
%%% Purpose : Unix `ed' look-alike.
 
5
%%% Created : 24 Aug 1997 by Bjorn Gustavsson <bjorn@strider>
 
6
%%%----------------------------------------------------------------------
 
7
 
 
8
-module(eed).
 
9
-author('bjorn@strider').
 
10
 
 
11
-export([edit/0, edit/1, file/1, cmd_line/1]).
 
12
 
 
13
-record(state, {dot = 0,                        % Line number of dot.
 
14
                upto_dot = [],                  % Lines up to dot (reversed).
 
15
                after_dot = [],                 % Lines after dot.
 
16
                lines = 0,                      % Total number of lines.
 
17
                print=false,                    % Print after command.
 
18
                filename=[],                    % Current file.
 
19
                pattern,                        % Current pattern.
 
20
                in_global=false,                % True if executing global command.
 
21
                input=[],                       % Global input stream.
 
22
                undo,                           % Last undo state.
 
23
                marks=[],                       % List of marks.
 
24
                modified=false,                 % Buffer is modified.
 
25
                opts=[{prompt, ''}],            % Options.
 
26
                last_error,                     % The last error encountered.
 
27
                input_fd                        % Input file descriptor.
 
28
               }).
 
29
 
 
30
-record(line, {contents,                        % Contents of line.
 
31
               mark=false                       % Marked (for global prefix).
 
32
              }).
 
33
 
 
34
cmd_line([Script]) ->
 
35
    file(Script),
 
36
    halt().
 
37
 
 
38
file(Script) ->
 
39
    case file:open(Script, [read]) of
 
40
        {ok,Fd} ->
 
41
            loop(#state{input_fd=Fd}),
 
42
            ok;
 
43
        {error,E} ->
 
44
            {error,E}
 
45
    end.
 
46
 
 
47
edit() ->
 
48
    loop(#state{input_fd=group_leader()}).
 
49
 
 
50
edit(Name) ->
 
51
    loop(command([$e|Name], #state{input_fd=group_leader()})).
 
52
 
 
53
loop(St0) ->
 
54
    {ok, St1, Cmd} = get_line(St0),
 
55
    case catch command(lib:nonl(Cmd), St1) of
 
56
        {'EXIT', Reason} ->
 
57
            %% XXX Should clear outstanding global command here.
 
58
            loop(print_error({'EXIT', Reason}, St1));
 
59
        quit ->
 
60
            ok;
 
61
        {error, Reason} ->
 
62
            loop(print_error(Reason, St1));
 
63
        St2 when record(St2, state) ->
 
64
            loop(St2)
 
65
    end.
 
66
 
 
67
command(Cmd, St) ->
 
68
    case parse_command(Cmd, St) of
 
69
        quit ->
 
70
            quit;
 
71
        St1 when function(St1#state.print) ->
 
72
            if
 
73
                St1#state.dot /= 0 ->
 
74
                    print_current(St1);
 
75
                true ->
 
76
                    ok
 
77
            end,
 
78
            St1#state{print=false};
 
79
        St1 when record(St1, state) ->
 
80
            St1
 
81
    end.
 
82
 
 
83
get_line(St) ->
 
84
    Opts = St#state.opts,
 
85
    {value, {prompt, Prompt}} = lists:keysearch(prompt, 1, Opts),
 
86
    get_line(Prompt, St).
 
87
 
 
88
get_line(Prompt, St) when St#state.input == [] ->
 
89
    Line = get_line1(St#state.input_fd, Prompt, []),
 
90
    {ok, St, Line};
 
91
get_line(_, St) ->
 
92
    get_input(St#state.input, St, []).
 
93
 
 
94
get_input([eof], St, []) ->
 
95
    {ok, St, eof};
 
96
get_input([eof], St, Result) ->
 
97
    {ok, St#state{input=[eof]}, lists:reverse(Result)};
 
98
get_input([$\n|Rest], St, Result) ->
 
99
    {ok, St#state{input=Rest}, lists:reverse(Result)};
 
100
get_input([C|Rest], St, Result) ->
 
101
    get_input(Rest, St, [C|Result]).
 
102
 
 
103
get_line1(Io, Prompt, Result) ->
 
104
    get_line2(Io, io:get_line(Io, Prompt), Result).
 
105
 
 
106
get_line2(Io, eof, []) ->
 
107
    eof;
 
108
get_line2(Io, eof, Result) ->
 
109
    lists:reverse(Result);
 
110
get_line2(Io, [$\\, $\n], Result) ->
 
111
    get_line1(Io, '', [$\n|Result]);
 
112
get_line2(Io, [$\n], Result) ->
 
113
    lists:reverse(Result, [$\n]);
 
114
get_line2(Io, [C|Rest], Result) ->
 
115
    get_line2(Io, Rest, [C|Result]).
 
116
 
 
117
print_error(Reason, St0) ->
 
118
    St1 = St0#state{last_error=Reason},
 
119
    io:put_chars("?\n"),
 
120
    case lists:member(help_always, St1#state.opts) of
 
121
        true ->
 
122
            help_command([], [], St1),
 
123
            St1;
 
124
        false ->
 
125
            St1
 
126
    end.
 
127
 
 
128
format_error(bad_command) -> "unknown command";
 
129
format_error(bad_filename) -> "illegal or missing filename";
 
130
format_error(bad_file) -> "cannot open input file";
 
131
format_error(bad_linenum) -> "line out of range";
 
132
format_error(bad_delimiter) -> "illegal or missing delimiter";
 
133
format_error(bad_undo) -> "nothing to undo";
 
134
format_error(bad_mark) -> "mark not lower case ascii";
 
135
format_error(bad_pattern) -> "invalid regular expression";
 
136
format_error(buffer_modified) -> "warning: expecting `w'";
 
137
format_error(nested_globals) -> "multiple globals not allowed";
 
138
format_error(nomatch) -> "search string not found";
 
139
format_error(missing_space) -> "no space after command";
 
140
format_error(garbage_after_command) -> "illegal suffix";
 
141
format_error(not_implemented) -> "not implemented yet";
 
142
format_error({'EXIT', {Code, {Mod, Func, Args}}}) ->
 
143
    lists:flatten(io_lib:format("aborted due to bug (~p)",
 
144
                                [{Code, {Mod, Func, length(Args)}}]));
 
145
format_error(A) -> atom_to_list(A).
 
146
 
 
147
 
 
148
 
 
149
%%% Parsing commands.
 
150
 
 
151
parse_command(Cmd, St) ->
 
152
    parse_command(Cmd, St, []).
 
153
 
 
154
parse_command(Cmd, State, Nums) ->
 
155
    case get_one(Cmd, State) of
 
156
        {ok, Num, Rest, NewState} ->
 
157
            parse_next_address(Rest, NewState, [Num|Nums]);
 
158
        false ->
 
159
            parse_command1(Cmd, State, Nums)
 
160
    end.
 
161
 
 
162
parse_next_address([$,|Rest], State, Nums) ->
 
163
    parse_command(Rest, State, Nums);
 
164
parse_next_address([$;|Rest], State, [Num|Nums]) ->
 
165
    parse_command(Rest, move_to(Num, State), [Num|Nums]);
 
166
parse_next_address(Rest, State, Nums) ->
 
167
    parse_command1(Rest, State, Nums).
 
168
 
 
169
parse_command1([Letter|Rest], State, Nums) ->
 
170
    Cont = fun(Fun, NumLines, Def) ->
 
171
                   execute_command(Fun, NumLines, Def, State, Nums, Rest) end,
 
172
    parse_cmd_char(Letter, Cont);
 
173
parse_command1([], State, Nums) ->
 
174
    execute_command(fun print_command/3, 1, next, State, Nums, []).
 
175
 
 
176
get_one(Cmd, St) ->
 
177
    case get_address(Cmd, St) of
 
178
        {ok, Addr, Cmd1, St1} ->
 
179
            get_one1(Cmd1, Addr, St1);
 
180
        false ->
 
181
            get_one1(Cmd, false, St)
 
182
    end.
 
183
 
 
184
get_one1([D|Rest], false, St) when $0 =< D, D =< $9 ->
 
185
    get_one2(get_number([D|Rest]), 1, 0, St);
 
186
get_one1([D|Rest], Sum, St) when $0 =< D, D =< $9 ->
 
187
    get_one2(get_number([D|Rest]), 1, Sum, St);
 
188
get_one1([$+, D|Rest], Sum, St) when $0 =< D, D =< $9 ->
 
189
    get_one2(get_number([D|Rest]), 1, Sum, St);
 
190
get_one1([$-, D|Rest], Sum, St) when $0 =< D, D =< $9 ->
 
191
    get_one2(get_number([D|Rest]), -1, Sum, St);
 
192
get_one1([$+|Rest], Sum, St) ->
 
193
    get_one2({ok, 1, Rest}, 1, Sum, St);
 
194
get_one1([$-|Rest], Sum, St) ->
 
195
    get_one2({ok, 1, Rest}, -1, Sum, St);
 
196
get_one1(Cmd, false, St) ->
 
197
    false;
 
198
get_one1(Cmd, Sum, St) ->
 
199
    {ok, Sum, Cmd, St}.
 
200
 
 
201
get_one2({ok, Number, Rest}, Mul, false, St) ->
 
202
    get_one1(Rest, St#state.dot+Mul*Number, St);
 
203
get_one2({ok, Number, Rest}, Mul, Sum, St) ->
 
204
    get_one1(Rest, Sum+Mul*Number, St).
 
205
 
 
206
get_number(Cmd) ->
 
207
    get_number(Cmd, 0).
 
208
 
 
209
get_number([D|Rest], Result) when $0 =< D, D =< $9 ->
 
210
    get_number(Rest, Result*10+D-$0);
 
211
get_number(Rest, Result) ->
 
212
    {ok, Result, Rest}.
 
213
 
 
214
get_address([$.|Rest], State) ->
 
215
    {ok, State#state.dot, Rest, State};
 
216
get_address([$$|Rest], State) ->
 
217
    {ok, State#state.lines, Rest, State};
 
218
get_address([$', Mark|Rest], St) when $a =< Mark, Mark =< $z ->
 
219
    case lists:keysearch(Mark, 2, St#state.marks) of
 
220
        {value, {Line, Mark}} ->
 
221
            {ok, Line, Rest, St};
 
222
        false ->
 
223
            {ok, 0, Rest, St}
 
224
    end;
 
225
get_address([$'|Rest], State) ->
 
226
    error(bad_mark);
 
227
get_address([$/|Rest], State) ->
 
228
    scan_forward($/, Rest, State);
 
229
get_address([$?|Rest], State) ->
 
230
    error(not_implemented);
 
231
get_address(Cmd, St) ->
 
232
    false.
 
233
 
 
234
scan_forward(End, Patt0, State) ->
 
235
    {ok, Rest, NewState} = get_pattern(End, Patt0, State),
 
236
    Dot = NewState#state.dot,
 
237
    After = NewState#state.after_dot,
 
238
    scan_forward1(Dot+1, After, NewState, Rest).
 
239
 
 
240
scan_forward1(Linenum, [Line|Rest], State, RestCmd) ->
 
241
    case regexp:first_match(Line#line.contents, State#state.pattern) of
 
242
        {match, _, _} ->
 
243
            {ok, Linenum, RestCmd, State};
 
244
        nomatch ->
 
245
            scan_forward1(Linenum+1, Rest, State, RestCmd)
 
246
    end;
 
247
scan_forward1(_, [], State, RestCmd) ->
 
248
    Dot = State#state.dot,
 
249
    Upto = State#state.upto_dot,
 
250
    case scan_forward2(Dot, Upto, State, RestCmd) of
 
251
        false ->
 
252
            error(bad_linenum);
 
253
        Other ->
 
254
            Other
 
255
    end.
 
256
 
 
257
scan_forward2(0, [], State, RestCmd) ->
 
258
    false;
 
259
scan_forward2(Linenum, [Line|Rest], State, RestCmd) ->
 
260
    case scan_forward2(Linenum-1, Rest, State, RestCmd) of
 
261
        false ->
 
262
            case regexp:first_match(Line#line.contents, State#state.pattern) of
 
263
                {match, _, _} ->
 
264
                    {ok, Linenum, RestCmd, State};
 
265
                nomatch ->
 
266
                    false
 
267
            end;
 
268
        Other ->
 
269
            Other
 
270
    end.
 
271
 
 
272
parse_cmd_char($S, Cont) -> Cont(fun quest_command/3, 0, none);
 
273
parse_cmd_char($T, Cont) -> Cont(fun time_command/3, 0, none);
 
274
parse_cmd_char($=, Cont) -> Cont(fun print_linenum/3, 1, last);
 
275
parse_cmd_char($a, Cont) -> Cont(fun append_command/3, 1, dot);
 
276
parse_cmd_char($c, Cont) -> Cont(fun change_command/3, 2, dot);
 
277
parse_cmd_char($d, Cont) -> Cont(fun delete_command/3, 2, dot);
 
278
parse_cmd_char($e, Cont) -> Cont(fun enter_command/3, 0, none);
 
279
parse_cmd_char($E, Cont) -> Cont(fun enter_always_command/3, 0, none);
 
280
parse_cmd_char($f, Cont) -> Cont(fun file_command/3, 0, none);
 
281
parse_cmd_char($g, Cont) -> Cont(fun global_command/3, 2, all);
 
282
parse_cmd_char($h, Cont) -> Cont(fun help_command/3, 0, none);
 
283
parse_cmd_char($H, Cont) -> Cont(fun help_always_command/3, 0, none);
 
284
parse_cmd_char($i, Cont) -> Cont(fun insert_command/3, 1, dot);
 
285
parse_cmd_char($k, Cont) -> Cont(fun mark_command/3, 1, dot);
 
286
parse_cmd_char($l, Cont) -> Cont(fun list_command/3, 2, dot);
 
287
parse_cmd_char($m, Cont) -> Cont(fun move_command/3, 2, dot);
 
288
parse_cmd_char($n, Cont) -> Cont(fun number_command/3, 2, dot);
 
289
parse_cmd_char($p, Cont) -> Cont(fun print_command/3, 2, dot);
 
290
parse_cmd_char($P, Cont) -> Cont(fun prompt_command/3, 0, none);
 
291
parse_cmd_char($q, Cont) -> Cont(fun quit_command/3, 0, none);
 
292
parse_cmd_char($Q, Cont) -> Cont(fun quit_always_command/3, 0, none);
 
293
parse_cmd_char($r, Cont) -> Cont(fun read_command/3, 1, last);
 
294
parse_cmd_char($s, Cont) -> Cont(fun subst_command/3, 2, dot);
 
295
parse_cmd_char($t, Cont) -> Cont(fun transpose_command/3, 2, dot);
 
296
parse_cmd_char($u, Cont) -> Cont(fun undo_command/3, 0, none);
 
297
parse_cmd_char($v, Cont) -> Cont(fun vglobal_command/3, 2, all);
 
298
parse_cmd_char($w, Cont) -> Cont(fun write_command/3, 2, all);
 
299
parse_cmd_char(_, Cont)  -> error(bad_command).
 
300
 
 
301
execute_command(Fun, NumLines, Def, State, Nums, Rest) ->
 
302
    Lines = check_lines(NumLines, Def, Nums, State),
 
303
    Fun(Rest, Lines, State).
 
304
 
 
305
check_lines(0, _, [], _State) ->
 
306
    [];
 
307
check_lines(1, dot, [], #state{dot=Dot}) ->
 
308
    [Dot];
 
309
check_lines(1, next, [], State) when State#state.dot < State#state.lines ->
 
310
    [State#state.dot+1];
 
311
check_lines(1, last, [], State) ->
 
312
    [State#state.lines];
 
313
check_lines(1, _, [Num|_], State) when 0 =< Num, Num =< State#state.lines ->
 
314
    [Num];
 
315
check_lines(2, dot, [], #state{dot=Dot}) ->
 
316
    [Dot, Dot];
 
317
check_lines(2, all, [], #state{lines=Lines}) ->
 
318
    [1, Lines];
 
319
check_lines(2, _, [Num], State) when 0 =< Num, Num =< State#state.lines ->
 
320
    [Num, Num];
 
321
check_lines(2, _, [Num2, Num1|_], State)
 
322
when 0 =< Num1, Num1 =< Num2, Num2 =< State#state.lines ->
 
323
    [Num1, Num2];
 
324
check_lines(_, _, _, _) ->
 
325
    error(bad_linenum).
 
326
 
 
327
 
 
328
%%% Executing commands.
 
329
 
 
330
%% ($)= - print line number
 
331
 
 
332
print_linenum(Rest, [Line], State) ->
 
333
    NewState = check_trailing_p(Rest, State),
 
334
    io:format("~w\n", [Line]),
 
335
    NewState.
 
336
 
 
337
%% ? - print state (for debugging)
 
338
 
 
339
quest_command([], [], State) ->
 
340
    io:format("~p\n", [State]),
 
341
    State.
 
342
 
 
343
%% Tcmd - time command
 
344
 
 
345
time_command(Cmd, [], St) ->
 
346
    Fun = fun parse_command/2,
 
347
    erlang:garbage_collect(),
 
348
    {Elapsed, Val} = timer:tc(erlang, apply, [Fun, [Cmd, St]]),
 
349
    io:format("Time used: ~p s~n", [Elapsed/1000000.0]),
 
350
    case Val of
 
351
        {error, Reason} ->
 
352
            throw({error, Reason});
 
353
        Other ->
 
354
            Other
 
355
    end.
 
356
 
 
357
%% (.)a - append text
 
358
 
 
359
append_command(Rest, [Line], St0) ->
 
360
    St1 = save_for_undo(St0),
 
361
    append(move_to(Line, check_trailing_p(Rest, St1))).
 
362
 
 
363
append(St0) ->
 
364
    {ok, St1, Line0} = get_line('', St0),
 
365
    case Line0 of
 
366
        eof ->
 
367
            St1;
 
368
        ".\n" ->
 
369
            St1;
 
370
        Line ->
 
371
            append(insert_line(Line, St1))
 
372
    end.
 
373
 
 
374
%% (.,.)c
 
375
 
 
376
change_command(Rest, Lines, St0) ->
 
377
    St1 = delete_command(Rest, Lines, St0),
 
378
    St2 = append_command([], [St1#state.dot-1], St1),
 
379
    save_for_undo(St2, St0).
 
380
 
 
381
%% (.,.)d - delete lines
 
382
 
 
383
delete_command(Rest, [0, Last], St) ->
 
384
    error(bad_linenum);
 
385
delete_command(Rest, [First, Last], St0) ->
 
386
    St1 = check_trailing_p(Rest, save_for_undo(St0)),
 
387
    delete(Last-First+1, move_to(Last, St1)).
 
388
 
 
389
delete(0, St) when St#state.dot == St#state.lines ->
 
390
    St;
 
391
delete(0, St) ->
 
392
    next_line(St);
 
393
delete(Left, St0) ->
 
394
    St1 = delete_current_line(St0),
 
395
    delete(Left-1, St1).
 
396
 
 
397
%% e file - replace buffer with new file
 
398
 
 
399
enter_command(Name, [], St) when St#state.modified == true ->
 
400
    error(buffer_modified);
 
401
enter_command(Name, [], St0) ->
 
402
    enter_always_command(Name, [], St0).
 
403
 
 
404
%% E file - replace buffer with new file
 
405
 
 
406
enter_always_command(Name, [], St0) ->
 
407
    St1 = read_command(Name, [0], #state{filename=St0#state.filename,
 
408
                                         opts=St0#state.opts}),
 
409
    St1#state{modified=false}.
 
410
 
 
411
%% f file - print filename; set filename
 
412
 
 
413
file_command([], [], St) ->
 
414
    io:format("~s~n", [St#state.filename]),
 
415
    St;
 
416
file_command([$_|Name0], [], St) ->
 
417
    Name = skip_blanks(Name0),
 
418
    file_command([], [], St#state{filename=Name});
 
419
file_command(_, _, _) ->
 
420
    error(missing_space).
 
421
 
 
422
%% (1,$)g/RE/commands - execute commands on all matching lines.
 
423
%% (1,$)v/RE/commands - execute commands on all non-matching lines.
 
424
 
 
425
global_command(Cmd, Lines, St) ->
 
426
    check_global0(true, Cmd, Lines, St).
 
427
 
 
428
vglobal_command(Cmd, Lines, St) ->
 
429
    check_global0(false, Cmd, Lines, St).
 
430
 
 
431
check_global0(_, _, _, St) when St#state.in_global == true ->
 
432
    error(nested_globals);
 
433
check_global0(Sense, [Sep|Pattern], Lines, St0) ->
 
434
    {ok, Cmd, St1} = get_pattern(Sep, Pattern, St0),
 
435
    St2 = mark(Sense, Lines, St1),
 
436
    do_global_command(Cmd, St2#state{in_global=true}, 0).
 
437
    
 
438
mark(Sense, [First, Last], St0) ->
 
439
    St1 = move_to(Last, St0),
 
440
    mark1(Sense, First-1, St1).
 
441
 
 
442
mark1(Sense, First, St) when St#state.dot == First ->
 
443
    St;
 
444
mark1(Sense, First, St) ->
 
445
    [Line|Prev] = St#state.upto_dot,
 
446
    NewLine = case match(St) of
 
447
                  true  -> Line#line{mark=Sense};
 
448
                  false -> Line#line{mark=not(Sense)}
 
449
              end,
 
450
    mark1(Sense, First, prev_line(St#state{upto_dot=[NewLine|Prev]})).
 
451
 
 
452
do_global_command(Cmd, St0, Matches) ->
 
453
    case find_mark(St0) of
 
454
        {ok, St1} ->
 
455
            St2 = St1#state{input=Cmd++[eof]},
 
456
            {ok, St3, Cmd1} = get_line(St2),
 
457
            St4 = command(Cmd1, St3),
 
458
            %% XXX There might be several commands.
 
459
            do_global_command(Cmd, St4, Matches+1);
 
460
        false when Matches == 0 ->
 
461
            error(nomatch);
 
462
        false ->
 
463
            St0#state{in_global=false, input=[]}
 
464
    end.
 
465
 
 
466
find_mark(State) ->
 
467
    find_mark(State#state.lines, State).
 
468
 
 
469
find_mark(0, _State) ->
 
470
    false;
 
471
find_mark(Limit, State) when State#state.dot == 0 ->
 
472
    find_mark(Limit, next_line(State));
 
473
find_mark(Limit, State) ->
 
474
    case State#state.upto_dot of
 
475
        [Line|Prev] when Line#line.mark == true ->
 
476
            NewLine = Line#line{mark=false},
 
477
            {ok, State#state{upto_dot=[NewLine|Prev]}};
 
478
        _Other ->
 
479
            find_mark(Limit-1, wrap_next_line(State))
 
480
    end.
 
481
 
 
482
%% h - print info about last error
 
483
 
 
484
help_command([], [], St) ->
 
485
    case St#state.last_error of
 
486
        undefined ->
 
487
            St;
 
488
        Reason ->
 
489
            io:put_chars(format_error(Reason)),
 
490
            io:nl(),
 
491
            St
 
492
    end;
 
493
help_command(_, _, _) ->
 
494
    error(garbage_after_command).
 
495
 
 
496
%% H - toggle automatic help mode on/off
 
497
 
 
498
help_always_command([], [], St) ->
 
499
    Opts = St#state.opts,
 
500
    case lists:member(help_always, Opts) of
 
501
        true ->
 
502
            St#state{opts=Opts--[help_always]};
 
503
        false ->
 
504
            help_command([], [], St),
 
505
            St#state{opts=[help_always|Opts]}
 
506
    end.
 
507
 
 
508
%% (.)i - insert text
 
509
 
 
510
insert_command(Rest, [0], State) ->
 
511
    error(bad_linenum);
 
512
insert_command(Rest, [Line], State) ->
 
513
    append_command(Rest, [Line-1], State).
 
514
 
 
515
%% (.)kx - mark line
 
516
 
 
517
mark_command(_, [0], St) ->
 
518
    error(bad_linenum);
 
519
mark_command([Mark|Rest], [Line], St) when $a =< Mark, Mark =< $z ->
 
520
    error(not_implemented);
 
521
mark_command(_, _, _) ->
 
522
    error(bad_mark).
 
523
    
 
524
%% (.,.)l - list lines
 
525
 
 
526
list_command(Rest, Lines, St) ->
 
527
    print([$l|Rest], Lines, St).
 
528
 
 
529
%% (.,.)m - move lines
 
530
 
 
531
move_command(Cmd, [First, Last], St) ->
 
532
    error(not_implemented).
 
533
 
 
534
%% (.,.)t - copy lines
 
535
 
 
536
transpose_command(Cmd, [First, Last], St) ->
 
537
    error(not_implemented).
 
538
 
 
539
%% (.,.)n - print lines with line numbers
 
540
 
 
541
number_command(Rest, Lines, St) ->
 
542
    print([$n|Rest], Lines, St).
 
543
 
 
544
%% (.,.)p - print lines
 
545
 
 
546
print_command(Rest, Lines, St) ->
 
547
    print([$p|Rest], Lines, St).
 
548
 
 
549
%% P - toggle prompt
 
550
 
 
551
prompt_command([], [], St) ->
 
552
    Opts = St#state.opts,
 
553
    case lists:keysearch(prompt, 1, Opts) of
 
554
        {value, {prompt, ''}} ->
 
555
            St#state{opts=[{prompt, '*'}|Opts]};
 
556
        {value, Value} ->
 
557
            St#state{opts=[{prompt, ''} | Opts--[Value]]}
 
558
    end;
 
559
prompt_command(_, _, _) ->
 
560
    error(garbage_after_command).
 
561
 
 
562
%% q - quit editor
 
563
 
 
564
quit_command([], [], _) ->
 
565
    quit;
 
566
quit_command(_, _, _) ->
 
567
    error(garbage_after_command).
 
568
 
 
569
%% Q - quit editor
 
570
 
 
571
quit_always_command([], [], _) ->
 
572
    quit;
 
573
quit_always_command(_, _, _) ->
 
574
    error(garbage_after_command).
 
575
 
 
576
%% ($)r file - read file
 
577
 
 
578
read_command([], _, St) when St#state.filename == [] ->
 
579
    error(bad_filename);
 
580
read_command([], [After], St) ->
 
581
    read(After, St#state.filename, St);
 
582
read_command([$ |Name0], [After], St) when St#state.filename == [] ->
 
583
    Name = skip_blanks(Name0),
 
584
    read(After, Name, St#state{filename=Name});
 
585
read_command([$ |Name0], [After], St) ->
 
586
    Name = skip_blanks(Name0),
 
587
    read(After, Name, St);
 
588
read_command(_, _, _) ->
 
589
    error(missing_space).
 
590
 
 
591
read(After, Name, St0) ->
 
592
    case file:read_file(Name) of
 
593
        {ok, Bin} ->
 
594
            Chars = size(Bin),
 
595
            St1 = move_to(After, St0),
 
596
            St2 = insert_line(binary_to_list(Bin), St1),
 
597
            io:format("~w~n", [Chars]),
 
598
            St2;
 
599
        {error, _} ->
 
600
            error(bad_file)
 
601
    end.
 
602
 
 
603
%% s/pattern/replacement/gp
 
604
 
 
605
subst_command(_, [0, _], _) ->
 
606
    error(bad_linenum);
 
607
subst_command([$ |Cmd0], [First, Last], St0) ->
 
608
    error(bad_delimiter);
 
609
subst_command([$\n|Cmd0], [First, Last], St0) ->
 
610
    error(bad_delimiter);
 
611
subst_command([Sep|Cmd0], [First, Last], St0) ->
 
612
    St1 = save_for_undo(St0),
 
613
    {ok, Cmd1, St2} = get_pattern(Sep, Cmd0, St1),
 
614
    {ok, Replacement, Cmd2} = get_replacement(Sep, Cmd1),
 
615
    {ok, Sub, Cmd3} = subst_check_gflag(Cmd2),
 
616
    St3 = check_trailing_p(Cmd3, St2),
 
617
    subst_command(Last-First+1, Sub, Replacement, move_to(First-1, St3), nomatch);
 
618
subst_command([], _, _) ->
 
619
    error(bad_delimiter).
 
620
    
 
621
subst_command(0, _, _, _, nomatch) ->
 
622
    error(nomatch);
 
623
subst_command(0, _, _, _, StLast) when record(StLast, state) ->
 
624
    StLast;
 
625
subst_command(Left, Sub, Repl, St0, LastMatch) ->
 
626
    St1 = next_line(St0),
 
627
    [Line|_] = St1#state.upto_dot,
 
628
    case regexp:Sub(Line#line.contents, St1#state.pattern, Repl) of
 
629
        {ok, _, 0} ->
 
630
            subst_command(Left-1, Sub, Repl, St1, LastMatch);
 
631
        {ok, NewContents, _} ->
 
632
            %% XXX This doesn't work with marks.
 
633
            St2 = delete_current_line(St1),
 
634
            St3 = insert_line(NewContents, St2),
 
635
            subst_command(Left-1, Sub, Repl, St3, St3)
 
636
    end.
 
637
 
 
638
subst_check_gflag([$g|Cmd]) -> {ok, gsub, Cmd};
 
639
subst_check_gflag(Cmd)      -> {ok, sub, Cmd}.
 
640
 
 
641
%% u - undo
 
642
 
 
643
undo_command([], [], St) when St#state.undo == undefined ->
 
644
    error(bad_undo);
 
645
undo_command([], [], #state{undo=Undo}) ->
 
646
    Undo;
 
647
undo_command(_, _, _) ->
 
648
    error(garbage_after_command).
 
649
 
 
650
%% (1,$)w - write buffer to file
 
651
 
 
652
write_command(Cmd, [First, Last], St) ->
 
653
    error(not_implemented).
 
654
    
 
655
 
 
656
%%% Primitive buffer operations.
 
657
 
 
658
print_current(St) ->
 
659
    [Line|_] = St#state.upto_dot,
 
660
    Printer = St#state.print,
 
661
    Printer(Line#line.contents, St).
 
662
 
 
663
delete_current_line(St) when St#state.dot == 0 ->
 
664
    error(bad_linenum);
 
665
delete_current_line(St) ->
 
666
    Lines = St#state.lines,
 
667
    [_|Prev] = St#state.upto_dot,
 
668
    St#state{dot=St#state.dot-1, upto_dot=Prev, lines=Lines-1, modified=true}.
 
669
    
 
670
insert_line(Line, State) ->
 
671
    insert_line1(Line, State, []).
 
672
 
 
673
insert_line1([$\n|Rest], State, Result) ->
 
674
    NewState = insert_single_line(lists:reverse(Result, [$\n]), State),
 
675
    insert_line1(Rest, NewState, []);
 
676
insert_line1([C|Rest], State, Result) ->
 
677
    insert_line1(Rest, State, [C|Result]);
 
678
insert_line1([], State, []) ->
 
679
    State;
 
680
insert_line1([], State, Result) ->
 
681
    insert_single_line(lists:reverse(Result, [$\n]), State).
 
682
 
 
683
insert_single_line(Line0, State) ->
 
684
    Line = #line{contents=Line0},
 
685
    Dot = State#state.dot,
 
686
    Before = State#state.upto_dot,
 
687
    Lines = State#state.lines,
 
688
    %% XXX Avoid updating the record every time.
 
689
    State#state{dot=Dot+1, upto_dot=[Line|Before], lines=Lines+1, modified=true}.
 
690
 
 
691
move_to(Line, State) when Line < State#state.dot ->
 
692
    move_to(Line, prev_line(State));
 
693
move_to(Line, State) when State#state.dot < Line ->
 
694
    move_to(Line, next_line(State));
 
695
move_to(Line, State) when Line == State#state.dot ->
 
696
    State.
 
697
 
 
698
prev_line(State) ->
 
699
    Dot = State#state.dot,
 
700
    Before = State#state.upto_dot,
 
701
    After = State#state.after_dot,
 
702
    State#state{dot=Dot-1, upto_dot=tl(Before), after_dot=[hd(Before)|After]}.
 
703
 
 
704
next_line(State) ->
 
705
    Dot = State#state.dot,
 
706
    Before = State#state.upto_dot,
 
707
    After = State#state.after_dot,
 
708
    State#state{dot=Dot+1, upto_dot=[hd(After)|Before], after_dot=tl(After)}.
 
709
 
 
710
wrap_next_line(State) when State#state.dot == State#state.lines ->
 
711
    move_to(1, State);
 
712
wrap_next_line(State) ->
 
713
    next_line(State).
 
714
 
 
715
 
 
716
%%% Utilities.
 
717
 
 
718
get_pattern(End, Cmd, State) ->
 
719
    get_pattern(End, Cmd, State, []).
 
720
 
 
721
get_pattern(End, [End|Rest], State, []) when State#state.pattern /= undefined ->
 
722
    {ok, Rest, State};
 
723
get_pattern(End, [End|Rest], State, Result) ->
 
724
    case regexp:parse(lists:reverse(Result)) of
 
725
        {error, _} ->
 
726
            error(bad_pattern);
 
727
        {ok, Re} ->
 
728
            {ok, Rest, State#state{pattern=Re}}
 
729
    end;
 
730
get_pattern(End, [C|Rest], State, Result) ->
 
731
    get_pattern(End, Rest, State, [C|Result]);
 
732
get_pattern(End, [], State, Result) ->
 
733
    get_pattern(End, [End], State, Result).
 
734
 
 
735
get_replacement(End, Cmd) ->
 
736
    get_replacement(End, Cmd, []).
 
737
 
 
738
get_replacement(End, [End|Rest], Result) ->
 
739
    {ok, lists:reverse(Result), Rest};
 
740
get_replacement(End, [$\\, $&|Rest], Result) ->
 
741
    get_replacement(End, Rest, [$&, $\\|Result]);
 
742
get_replacement(End, [$\\, C|Rest], Result) ->
 
743
    get_replacement(End, Rest, [C|Result]);
 
744
get_replacement(End, [C|Rest], Result) ->
 
745
    get_replacement(End, Rest, [C|Result]);
 
746
get_replacement(End, [], Result) ->
 
747
    get_replacement(End, [End], Result).
 
748
 
 
749
check_trailing_p([$l], St) ->
 
750
    St#state{print=fun(Line, _) -> lister(Line, 0) end};
 
751
check_trailing_p([$n], St) ->
 
752
    St#state{print=fun numberer/2};
 
753
check_trailing_p([$p], St) ->
 
754
    St#state{print=fun(Line, _) -> io:put_chars(Line) end};
 
755
check_trailing_p([], State) ->
 
756
    State;
 
757
check_trailing_p(Other, State) ->
 
758
    error(garbage_after_command).
 
759
 
 
760
error(Reason) ->
 
761
    throw({error, Reason}).
 
762
 
 
763
match(State) when State#state.dot == 0 ->
 
764
    false;
 
765
match(State) ->
 
766
    [Line|_] = State#state.upto_dot,
 
767
    Re = State#state.pattern,
 
768
    case regexp:first_match(Line#line.contents, Re) of
 
769
        {match, _, _} -> true;
 
770
        nomatch       -> false
 
771
    end.
 
772
 
 
773
skip_blanks([$ |Rest]) ->
 
774
    skip_blanks(Rest);
 
775
skip_blanks(Rest) ->
 
776
    Rest.
 
777
 
 
778
print(Rest, [Line], St0) when Line > 0 ->
 
779
    St1 = check_trailing_p(Rest, St0),
 
780
    print(Line, move_to(Line-1, St1));
 
781
print(Rest, [First, Last], St0) when First > 0 ->
 
782
    St1 = check_trailing_p(Rest, St0),
 
783
    print(Last, move_to(First-1, St1)).
 
784
 
 
785
print(Last, St) when St#state.dot == Last ->
 
786
    St#state{print=false};
 
787
print(Last, St0) ->
 
788
    St1 = next_line(St0),
 
789
    print_current(St1),
 
790
    print(Last, St1).
 
791
 
 
792
lister(Rest, 64) ->
 
793
    io:put_chars("\\\n"),
 
794
    lister(Rest, 0);
 
795
lister([C|Rest], Num) ->
 
796
    list_char(C),
 
797
    lister(Rest, Num+1);
 
798
lister([], _) ->
 
799
    ok.
 
800
 
 
801
list_char($\t) ->
 
802
    io:put_chars("\\t");
 
803
list_char($\n) ->
 
804
    io:put_chars("$\n");
 
805
list_char(C) ->
 
806
    io:put_chars([C]).
 
807
 
 
808
numberer(Line, St) ->
 
809
    io:format("~w\t~s", [St#state.dot, Line]).
 
810
 
 
811
save_for_undo(St) ->
 
812
    St#state{undo=St#state{undo=undefined, print=false}}.
 
813
 
 
814
save_for_undo(St, OldSt) ->
 
815
    St#state{undo=OldSt#state{undo=undefined, print=false}}.