-
Notifications
You must be signed in to change notification settings - Fork 2
/
Copy pathrxshell.rex
2091 lines (1979 loc) · 107 KB
/
rxshell.rex
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
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
/* OS/2 RxShell 3.3 at <URL:http//purl.net/xyzzy/src/rxshell.zip> */
/* The new 3.x versions (2003) run under OS/2 REXXSAA 4.0 (a.k.a. */
/* classic REXX) and Quercus REXX/Personal 3.0 for OS/2. Porting */
/* to other platforms and interpreters should be easy if and only */
/* if the target is ASCII based, i.e. neither EBCDIC nor UNICODE. */
/* REXX language level 4 is required for SIGNAL ON ... NAME ... */
/* (not met by old BREXX interpreters). An incomplete test with */
/* Object REXX (language level 6) worked as expected, but the new */
/* ANSI REXX LOSTDIGITS condition is not yet supported. */
/* If you want a RxShell version running under DOS simply remove */
/* the math. package: 5 parts /* >> nomath */ .. /* << nomath */. */
/* Try the old RxShell in <http://purl.net/xyzzy/src/rxshell.zip> */
/* if you want to use the math. package under DOS - at the moment */
/* this is essentially the same as version 3.0 for NUMERIC DIGITS */
/* up to 100 or greater than 501. */
/* Otherwise version 3.1 expects to find file -RXSHELL.cmd in the */
/* same path as RXSHELL.cmd. In fact it uses its own name plus a */
/* leading minus character. If you use say RXSHELL.bat, then you */
/* also need -RXSHELL.bat, and if you rename RXSHELL to BIGOOPS, */
/* then BIGOOPS would try to read -BIGOOPS. I know that this is */
/* a dirty solution, but old versions already used the same trick */
/* to determine the name of the history file with a leading zero, */
/* and I want a solution working under DOS on a FAT file system - */
/* if you don't like this, here's the source. */
/* math. package: */
/* RX.0DIGS used to watch numeric digits() set by user: */
/* call RX.DIGS w/out argument to (re)compute math. */
/* "constants" for new user digits() */
/* RX.DIGS also used to enter / leave "fuzzy" or double */
/* precision tracked in RX.0MATH internally. */
/* - RX.TRAP resets numeric digits RX.DIGS( 0 ) */
/* RX.FUNC functions like INT(f,a,b) = integral of f(X) dX */
/* from X=a to b have to INTERPRET f(X), where f is */
/* a user formula. This is done by RX.FUNC(X). */
/* RX.FUNK sets RX.0FUNC = 1 terminating the next RX.FUNC(), */
/* used as CALL ON HALT NAME RX.FUNK in potential */
/* dead loops like DF(), INT(), INV(), or SUM() */
/* RX.TRAF simplifies TRAce F handling of iterated RX.FUNC(). */
/* Abusing TRAce F for a special purpose should be no */
/* problem, it's otherwise the same as TRACE Normal. */
/* RX.MATH +2n: return n-th Bernoulli number, RX.0B.n */
/* odd: return 0, any odd Bernoulli number > 1 */
/* +1 : 0.5 for ZETA, but 1st Bernoulli = -0.5 */
/* -2n: return saved odd ZETA(1-2*n), RX.0B.m, m = -n */
/* 0 : Euler's C0 = lim 1+1/2+..+1/n-ln(n) = RX.0B.0 */
/* - RX.DIGS(0) calls RX.MATH 0 after dropping RX.0B.0 */
/* to (re)compute all necessary "constants": */
/* RX.0LN.2 = LN( 2 ) , RX.0PI.2 = 2 * ATAN( 1 ) */
/* RX.0LN.1 = e = EXP( 1 ) , RX.0PI.1 = pi = 2*RX.0PI.2 */
/* RX.0LN.0 = LN( 2 * pi ) , RX.0PI.0 = ROOT( pi / 4 ) */
/* RX.0ROOT 2nd..4th ROOT() solution returned by NORM() */
/* RX.0ZETA ZETA() accelerator determined by RX.MATH(0) */
/* RX.0GAMMA hardwired C0 digits, threshold for RX.INFO 5 */
/* RX.ARGN argument check in most functions, basically */
/* ARG( 1 = ARG()) without ill side effect */
/* Not yet implemented: ZETA(x) for 0 < x < 1 (unknown formula). */
/* Better don't use ZETA(x) if x is no integer, the */
/* convergence is extremely slow (unless x is "big"). */
/* Not yet implemented: real LOG(x) and real LN(x) for x < 0. */
/* GAMMA(x) for hardwired x > 1000 uses Stirling's approximation. */
/* This GAMMA-limit should be a function of digits(). */
/* GAMMA(x) won't work if 2 * x is no integer and digits() > 100, */
/* actually "odd" ZETA( 2*n+1 ) is the real problem. */
/* NUMERIC DIGITS 501 initialization is slow, but then accurate. */
/* NUMERIC DIGITS 502 initialization is also slow, and then some */
/* functions like GAMMA(x) and LI(x) are restricted. */
/* pi = ACOS(-1) and e = EXP(1) are always accurate. */
/* error handling: */
/* RC non-zero numerical RC reflected in RxShell prompt */
/* - preserved only if changed, otherwise dropped again */
/* - RX.TRAP sets RC according to the SIGNAL condition: */
/* -1 NOTREADY, -2 NOVALUE, -3 FAILURE, -4 HALT, */
/* -5..-99 SYNTAX errors 5..99 showing ERRORTEXT(RC) */
/* - RX.TRAP does not modify ERROR return codes set by */
/* external commands (except from FAILURE conditions) */
/* RX this variable is not exposed. If it's lost then */
/* all user variables are lost, indicating a severe */
/* RxShell error, i.e. generally no user error. */
/* - to debug the command loop RX.EXEC itself drop RX */
/* in RX.TRAP. Already prepared: if 0 then drop RX */
/* RX.WARP reload somehow lost RxGetKey() and RxScrSiz() with */
/* RX.UTIL(), drop into RX.TRAP, user variables lost */
/* RX.TRAP common error handler */
/* - if RX lost (=> user variables incl. RESULT lost): */
/* interactive REXX label trace (StdIn and StdOut), */
/* RETURN if CALLed, else (try to) continue anyway at */
/* RX.EXEC command loop after resetting RX.0ARGN = 0, */
/* numeric fuzz 0, and numeric digits RX.DIGS(0). */
/* - if RX not lost (assuming user error in INTERPRET): */
/* set RX.0HELP = command for detailed error help and */
/* continue at RX.EXEC, error output via RX.CRLF() */
/* - don't call RX.TRAP explicitly, this won't work as */
/* soon as some old trap condition() is pending after */
/* SIGNAL RX.EXEC. */
/* - HALT, NOVALUE, and SYNTAX are not always handled */
/* by RX.TRAP: compare RX.CHAW, RX.FUNK, and RX.WARP */
/* - note that SIGKILL and SIGTERM aren't trapped, only */
/* SIGINT [Ctrl]+[Break] or [Ctrl]+[C] causes HALT. */
/* - sometimes the REXX default SIGNAL OFF HALT instead */
/* of RX.TRAP handles HALT, this terminates RxShell: */
/* OS/2 REXXSAA HALT within INTERPRET is unreliable. */
/* RX.HALT break point used for interactive REXX label trace */
/* by RX.TRAP, could be called anywhere for debugging */
/* ERROR user commands SIGNAL ON ERROR or CALL ON ERROR are */
/* supported, i.e. handled by RX.TRAP like FAILURE */
/* - RX.TRAP doesn't reenable SIGNAL ON ERROR, only the */
/* first error is trapped. CALL ON ERROR can be used */
/* to handle all errors by RX.TRAP. Often non-zero */
/* return codes of OS commands are not really errors. */
/* NOTREADY supported like ERROR (ON or OFF, CALL or SIGNAL) */
/* - DOS NUL-device can cause spurious NOTREADY */
/* NOVALUE forced OFF before next command line INTERPRETation */
/* SYNTAX forced ON before next command line INTERPRETation */
/* FAILURE forced ON before next command line INTERPRETation */
/* HALT forced ON before next command line INTERPRETation */
/* LOSTDIGITS: not supported, as long as Regina 3.0 & Object REXX */
/* don't work reliably on an OS/2 system I can't test */
/* this new ANSI REXX feature... :-( */
/* trace handling: */
/* RX.0TEST saved user trace setting, initially the setting in */
/* effect before the 1st statement is executed (under */
/* 'Normal' conditions 'N' or '?R' if SET RXTRACE=ON) */
/* - at least one REXX implementation supports only the */
/* abbreviated settings 'O' for 'Off' etc., therefore */
/* this script internally uses only the abbreviations */
/* although RX.INFO 9 shows long names with RX.TRAV() */
/* - if the user traces his commands then he also sees */
/* the following two script lines unfortunately... */
/* RX.0TEST = trace( 'O' ) /* saves user's trace setting */ */
/* interpret RX.0LINE /* next command, user's trace */ */
/* RX.0? dummy call result used to preserve user's RESULT */
/* input handling: */
/* RX.CHAR gets the next input char. by RxGetKey( 'NoEcho' ), */
/* extended keys are returned as 2 bytes NUL || CODE */
/* compatible with Quercus INKEY( 'Wait', 'Fold' ) or */
/* Quercus REXXLIB.DLL INKEY() a.k.a. LIB_INKEY() */
/* - RxGetKey() reads from \dev\con (not StdIn) in its */
/* actual mode, normally "cooked": ^C, ^P, and ^S are */
/* handled within \dev\con and not seen by RxGetKey() */
/* - REXXLIB.DLL INKEY() returns "raw" ^C, ^P, and ^S, */
/* therefore RX.CHAR shows HALT as x2c(0000) = ^BREAK */
/* - DOS only: if "REXX/Personal" is the interpreter as */
/* noted in RX.0REXX then RX.CHAR() returns INKEY() */
/* - INKEY() normally "folds" extended scan codes E0?? */
/* to 00??, RxGetKey() always returns E0 and then ??. */
/* With RxGetKey() it's not possible to distinguish */
/* between alpha = d2c(224) = x2c(0E0) and new keys, */
/* therefore ALT [pad 2]+[pad 2]+[pad 4] won't work. */
/* - F6 RX.INFO(6) lists mapped "impossible" characters */
/* RX.CHAW HALT interrupt handler used by RX.CHAR and RX.CURS */
/* RX.PLUS input echoing by RX.ECHO() after translating ASCII */
/* NUL / BEL / BS / TAB / LF / CR / ESC to d2c( 176 ) */
/* defined in RX.0PLUS string of non-printable char.s */
/* - NAK is echoed "as is" d2c( 21 ), potential problem */
/* - NUL could be echoed "as is", 176 is better visible */
/* - ESC could be echoed "as is" if ANSI is OFF, but to */
/* test this r/w access on \dev\con would be required */
/* RX.ECHO input echoing and normal output using CHAROUT() on */
/* STDOUT: assumes a TTY-device supporting CR, LF, BS */
/* RX.BEEP calls RX.ECHO( x2c( 07 )), ASCII 7 is BEL */
/* RX.CURS toggles insert mode and if available CURSORTYPE(), */
/* REXX/Personal and REXXLIB.DLL have a CURSORTYPE(). */
/* RX.SIZE calls RxScrSiz() == RexxUtil's SysTextScreenSize() */
/* or SCRSIZE() under REXX/Personal (only for DOS) */
/* RX.MORE tiny pager supporting either 40-79 or more columns */
/* say only used in RX.TRAP or interactive RX.CHAR trace */
/* - SAY writes on STDOUT (like interactive REXX trace) */
/* STDIN: pseudo file name in some IBM REXX implementations */
/* STDOUT: dito, pseudo names aren't portable, not needed for */
/* standard I/O, and therefore not used here. Only a */
/* program using STREAM() may need 'STDIN:'/'STDOUT:' */
/* STDERR: dito, needed in unnamed pipe or background process */
/* '@ECHO OFF' only used if address() = 'CMD', not needed for DOS */
/* RxFuncAdd only used in RX.UTIL to load RxScrSiz and RxGetKey */
/* RxFuncQuery ditto. The ooREXX 6.03 RexxUtil.dll does not more */
/* support aliases RxScrSiz + RxGetKey, therefore the */
/* long names are now used. */
/* RxQueue only used in RX.INFO as RxQueue('Get') under OS/2 */
/* RxGetKey PC DOS 7 returns '' (a zero length string) instead */
/* of ASCII NUL (one character) as first character of */
/* extended key codes (i.e. function keys etc.), and */
/* so testing c2d(KEY) = 0 differs from KEY = d2c(0) */
/* RX.0abcd intentionally weird variable symbols, because user */
/* may set ABCD with side effects on any RX.ABCD, but */
/* he cannot change REXX constants like 0ABCD */
RX.0TEST = trace( 'O' ) /* <= very first statement */
trace 'N' /* preserves RXTRACE=ON */
numeric digits 20 /* 2010-04-11: add default */
RX.0CRLF = x2c( 0D0A ) /* RX.TRAP uses RX.0TRAP: */
RX.0TRAP = RX.0CRLF || right( '+++', 10 )
RX.0PLUS = RX.0CRLF || x2c( 000708091B )
RX.0PLOT = copies( d2c( 176 ), length( RX.0PLUS ))
signal on syntax name RX.TRAP ; signal on novalue name RX.TRAP
signal on halt name RX.TRAP ; signal on failure name RX.TRAP
RX.0ARGN = arg() > 1 | arg(1) <> '' /* 0: interactive input */
RX.0HELP = '' /* no error help shortcut */
RX.0USER = value( 'RESULT') /* initialize user result */
RX.0DIGS = 0 /* catch change of digits */
RX.0 = 0 /* history lines RX.1 upto RX.n, n = RX.0 */
RX.. = 0 /* 0 overtype or 1 insert mode, initial 0 */
parse source RX.1 . . /* if OS/2 ignore Quercus */
RX.0WARP = ( RX.1 = 'OS/2' ) | ( RX.1 = 'WindowsNT' )
if RX.0WARP /* 1: OS/2 , 0: assume DOS */
then call RX.UTIL /* Quercus : REXX/Personal */
else parse version RX.0REXX . . /* PC DOS 7: REXXSAA */
call RX.CURS ; call RX.CURS /* (try to) toggle cursor */
parse value RX.SIZE() with . RX.0ECHO .
select
when RX.0ECHO < 40 then exit RX.TRAP( '40+ columns required' )
when x2c( 30 ) <> 0 then exit RX.TRAP( 'EBCDIC not supported' )
when RX.0REXX = 'REXX/Personal' then options 'NEWCOM'
when RX.0REXX = 'REXXSAA' & RX.1 = 'DOS' then nop
when RX.0WARP & RX.0ECHO < 50000 then nop
when RX.0WARP then exit RX.TRAP( 'SysGetKey() required' )
otherwise call RX.TRAP 'warning: unknown' RX.1 RX.0REXX
end
RX.EXEC: /* ----------------------- */
do until RX.0ARGN > arg() & RX.0HELP = ''
if value( 'RC' ) = value( 'RX' ) then drop rc
RX = value( 'RC' ) ; rc = RX /* handle same or no value */
if \ datatype( RX, 'W' ) | RX = 0 then parse source . RX .
select /* select shell prompt: */
when RX = 'COMMAND' then RX = 'REXX'
when RX = 'FUNCTION' then RX = 'FUNC'
when RX = 'SUBROUTINE' then RX = 'CALL'
when RX > 0 then RX = right( RX, 4, 0 )
otherwise RX = right( RX, 4 )
end
RX.0ECHO = '[' || RX || '] '
/* >> nomath */
if RX.0DIGS <> digits() then do /* compute "constants": */
RX.0DIGS = digits() ; call RX.DIGS
end
/* << nomath */
if RX.0HELP = '' & RX.0ARGN > 0 then do
RX.0LINE = arg( RX.0ARGN ) /* treat arg as command */
RX.0ARGN = RX.0ARGN + 1 /* in recursive RxShell */
end
else RX.0LINE = RX.LINE( ) /* get new command line */
RX = rc ; if RX.0WARP & address() = 'CMD' then '@ECHO OFF'
rc = RX ; RX.0HELP = '' /* do not echo OS/2 CMD */
signal off novalue ; result = RX.0USER
RX.0USER = trace() ; trace value RX.0TEST
interpret RX.0LINE
RX.0TEST = trace( 'O' ) ; trace value RX.0USER
RX.0USER = value( 'RESULT' ) /* swap user RESULT, trace */
signal on syntax name RX.TRAP ; signal on novalue name RX.TRAP
signal on halt name RX.TRAP ; signal on failure name RX.TRAP
end
if datatype( value( 'RC' ), 'W' ) then exit rc ; else exit 0
RX.WARP: /* ----------------------- */
RX.0? = sigl
if rc = 43 then if RX.UTIL() /* 43: routine not found */
then call RX.ECHO RX.0TRAP 'RexxUtil functions reloaded'
sigl = RX.0?
ERROR: FAILURE: HALT: NOTREADY: NOVALUE: SYNTAX: RX.TRAP:
RX.0? = trace( 'O' ) /* stop interactive trace */
if 0 then drop RX /* 1: debug RX.EXEC itself */
if symbol( 'RX' ) = 'VAR' then do /* user error in INTERPRET */
trace value RX.0USER ; drop RX /* RX.TRAP error is fatal */
RX.0HELP = '' ; RX.0ECHO = ''
end
else do /* fatal: lost RX variable */
if RX.0? = 'O' then RX.0? = 'N' /* trace Normal (at least) */
trace value RX.0? ; parse source RX.0?
RX.0HELP = '.' ; RX.0ECHO = RX.0TRAP RX.0?
end
RX.0INFO = condition( 'd' ) /* description / errortext */
RX.0ECHO = RX.0ECHO || RX.0TRAP condition( 'c' ) 'trap:' RX.0INFO
signal off syntax ; signal on failure name RX.TRAP
signal off halt ; signal off novalue
select
when wordpos( condition( 'c' ), 'ERROR FAILURE' ) > 0 then do
if RX.0INFO > '' then RX.0ECHO = RX.0ECHO || RX.0TRAP
RX.0ECHO = RX.0ECHO '(RC' rc || ')'
if condition( 'c' ) = 'FAILURE' then do
if RX.0WARP & RX.0HELP = '' then
RX.0HELP = RX.HELP( 'sys' || right( rc, 4, 0 ))
rc = -3 /* OS/2: 'helpmsg sysNNNN' */
end
end
when wordpos( condition( 'c' ), 'HALT SYNTAX' ) > 0 then do
if condition( 'c' ) = 'HALT' then rc = 4
if RX.0INFO > '' & pos( RX.0INFO, rc errortext( rc )) = 0
then RX.0ECHO = RX.0ECHO || RX.0TRAP errortext( rc )
else RX.0ECHO = RX.0ECHO errortext( rc )
if RX.0INFO = '' then RX.0INFO = errortext( rc )
if RX.0HELP > '' then nop /* skip RX.HELP under test */
else if RX.0WARP /* REXX help OS/2 (or DOS) */
then RX.0HELP = RX.HELP( 'rex' || right( rc, 4, 0 ))
else RX.0HELP = RX.HELP( 'error', 'rexx' )
rc = -rc /* rc < 0: REXX error code */
end
when condition( 'c' ) = 'NOVALUE' then rc = -2 /* dubious */
when condition( 'c' ) = 'NOTREADY' then rc = -1 /* dubious */
otherwise /* force non-zero whole rc */
if datatype( value( 'RC' ), 'W' ) = 0 then rc = 1
if RX.0INFO = '' then RX.0ECHO = RX.0ECHO arg( 1 )
end /* any direct call RX.TRAP */
if RX.0HELP <> '.' & RX.0HELP <> '' then do
if RX.0REXX <> 'ooREXX' then do /* use old DOS + OS/2 help */
RX.0HELP = 'see "' || RX.0HELP || '"'
RX.0ECHO = RX.0ECHO || RX.0TRAP RX.0HELP
end
else do /* hide the ooREXX syntax: */
interpret "RX.0HELP = ( condition( 'o' )~MESSAGE <> .nil )"
if RX.0HELP then do /* show secondary message: */
interpret "RX.0HELP = condition( 'o' )~MESSAGE"
RX.0ECHO = RX.0ECHO || RX.0TRAP RX.0HELP
end /* Windows SysGetErrortext */
end /* not yet implemented :-( */
end
if RX.0HELP <> '.' & condition() = 'SIGNAL' then do
RX.0USER = value( 'RESULT' ) ; call RX.CRLF RX.0ECHO
signal on syntax name RX.TRAP ; signal on novalue name RX.TRAP
signal on halt name RX.TRAP ; signal RX.EXEC
end /* save RESULT before CALL */
RX.0ECHO = RX.0ECHO || RX.0CRLF || format( sigl, 6 )
signal on syntax name RX.SIGL /* throw syntax error 3... */
if 0 < sigl & 0 < sourceline() /* if no handle for source */
then RX.0ECHO = RX.0ECHO '*-*' strip( sourceline( sigl ))
else RX.0ECHO = RX.0ECHO '+++ (source line unavailable)'
RX.SIGL:
signal off syntax /* ...catch syntax error 3 */
if abbrev( right( RX.0ECHO, 2 + 6 ), RX.0CRLF ) then do
RX.0ECHO = RX.0ECHO '+++ (source line unreadable)' ; rc = -rc
end
say RX.0ECHO /* trace uses STDOUT anyway, SAY is okay */
if condition() = 'SIGNAL' then do /* SIGNAL, CALL, or empty */
RX.0USER = value( 'RESULT' ) ; call RX.HALT
/* >> nomath */
numeric digits RX.DIGS( 0 ) ; numeric fuzz 0
/* << nomath */
RX.0ARGN = 0 /* invalidate pending arg. */
signal on syntax name RX.TRAP ; signal on novalue name RX.TRAP
signal on halt name RX.TRAP ; signal RX.EXEC
end /* don't change next line: */
RX.HALT: trace ?L ; RX.HALT: RX.0? = trace( 'O' ) ; return rc
RX.LINE: procedure expose RX. /* ----------------------- */
EXPO = 'LINE POS SCAN' ; LINE = '' ; POS = 0 ; SCAN = 0
call RX.KILL 0 /* show initial prompt */
do until KEY == x2c( 0D )
KEY = RX.CHAR()
select
when KEY == x2c( 08 ) then do /* BS ----- */
if length( LINE ) = 0 | POS = 0 then iterate
LINE = delstr( LINE, POS, 1 ) ; POS = POS - 1
call RX.ECHO x2c(8) x2c(8) ; call RX.REST
end
when KEY == x2c( 09 ) then do /* TAB ---- */
if symbol( 'FIND' ) <> 'VAR' then FIND = LINE
if symbol( 'LAST' ) <> 'VAR' then FIND = LINE
else if LAST <> LINE then FIND = LINE
if SCAN = 0 then SCAN = RX.0 + 1
do I = SCAN -1 by -1 until I = SCAN
if I = 0 then do /* wrap around I = RX.0 */
if SCAN <= RX.0 then I = RX.0 ; else leave I
end /* found RX.I: I = SCAN */
if abbrev( RX.I, FIND ) then LAST = RX.SCAN( I )
end I
end
when KEY == x2c( 0A ) then call RX.NEXT KEY /* LF ----- */
when KEY == x2c( 0D ) then iterate /* CR ----- */
when KEY == x2c( 1B ) then do /* ESC ---- */
call RX.KILL 1 ; LINE = '' ; POS = 0
end
when KEY == x2c( 0000 ) then call RX.BEEP /* HALT --- */
when KEY == x2c( 0001 ) then call RX.NEXT x2c(1B) /* ESC */
when KEY == x2c( 0003 ) then call RX.NEXT x2c(00) /* NUL */
when KEY == x2c( 000E ) then call RX.NEXT x2c(08) /* BS */
when KEY == x2c( 000F ) then call RX.NEXT x2c(09) /* TAB */
when KEY == x2c( 0010 ) then call RX.NEXT x2c(11) /* c-Q */
when KEY == x2c( 0017 ) then call RX.NEXT x2c(09) /* TAB */
when KEY == x2c( 0019 ) then call RX.NEXT x2c(10) /* c-P */
when KEY == x2c( 001A ) then call RX.NEXT x2c(1B) /* ESC */
when KEY == x2c( 001C ) then call RX.NEXT x2c(0D) /* CR */
when KEY == x2c( 001E ) then call RX.NEXT d2c(224)
when KEY == x2c( 001F ) then call RX.NEXT x2c(13) /* c-S */
when KEY == x2c( 0022 ) then call RX.NEXT x2c(07) /* BEL */
when KEY == x2c( 0023 ) then call RX.NEXT x2c(08) /* BS */
when KEY == x2c( 0024 ) then call RX.NEXT x2c(0A) /* LF */
when KEY == x2c( 002E ) then call RX.NEXT x2c(03) /* ETX */
when KEY == x2c( 0032 ) then call RX.NEXT x2c(0D) /* CR */
when KEY == x2c( 0037 ) then call RX.NEXT x2c(1B) /* ESC */
when KEY == x2c( 003B ) then call RX.INFO 1 /* F1 ----- */
when KEY == x2c( 003C ) then select /* F2 ----- */
when LINE > '' then do
call RX.KILL 1 ; LINE = RX.QUOT( LINE )
call RX.PLUS LINE ; POS = length( LINE )
end
when RX.0 > 0 then do
I = RX.0 ; RX.I = RX.QUOT( RX.I )
call RX.SCAN I
end
otherwise nop /* no input and empty history */
end
when KEY == x2c( 003D ) then exit RX.CRLF() /* F3 ----- */
when KEY == x2c( 006B ) then exit RX.CRLF() /* a-F4 */
when KEY == x2c( 003E ) then do /* F4 ----- */
call RX.KILL 1 ; call RX.SAVE ; call RX.KILL 0
end
when KEY == x2c( 003F ) then call RX.INFO 5 /* F5 ----- */
when KEY == x2c( 0040 ) then call RX.INFO 6 /* F6 ----- */
when KEY == x2c( 0041 ) then call RX.BEEP /* F7 ----- */
when KEY == x2c( 0042 ) then call RX.BEEP /* F8 ----- */
when KEY == x2c( 0043 ) then call RX.INFO 9 /* F9 ----- */
when KEY == x2c( 0044 ) then do I = RX.0 to 1 by -1
RX.0 = I - 1 ; drop RX.I /* F10 ---- */
end I
when KEY == x2c( 0047 ) then do while RX.LEFT( 1 )
end /* 0047 Home, 0048 Up ---- */
when KEY == x2c( 0048 ) then call RX.SCAN SCAN - 1
when KEY == x2c( 0049 ) then call RX.BEEP /* PgUp --- */
when KEY == x2c( 004A ) then call RX.BEEP /* Minus -- */
when KEY == x2c( 004B ) then call RX.LEFT 1 /* Left --- */
when KEY == x2c( 004C ) then call RX.BEEP /* Center - */
when KEY == x2c( 004D ) then call RX.LEFT 0 /* Right -- */
when KEY == x2c( 004E ) then call RX.BEEP /* Plus --- */
when KEY == x2c( 004F ) then do while RX.LEFT( 0 )
end /* 004F End, 0050 Down --- */
when KEY == x2c( 0050 ) then call RX.SCAN SCAN + 1
when KEY == x2c( 0051 ) then call RX.BEEP /* PgDn --- */
when KEY == x2c( 0052 ) then call RX.CURS /* Ins ---- */
when KEY == x2c( 0053 ) then do /* Del ---- */
LINE = delstr( LINE, POS + 1, 1 ) ; call RX.REST
end /* 0072 supported by INKEY, not SysGetKey: */
when KEY == x2c( 0072 ) then call RX.BEEP /* c-PrtSc */
when KEY == x2c( 0073 ) then do while RX.LEFT( 1 )
if substr( LINE, POS + 1, 1 ) = ' ' then iterate
if substr( LINE, POS , 1 ) = ' ' then leave
end /* c-Left */
when KEY == x2c( 0074 ) then do while RX.LEFT( 0 )
if substr( LINE, POS , 1 ) <> ' ' then iterate
if substr( LINE, POS + 1, 1 ) <> ' ' then leave
end /* c-Right */
when KEY == x2c( 0075 ) then do /* c-End */
call RX.ECHO copies( ' ', length( LINE ) - POS )
call RX.ECHO copies( x2c(8), length( LINE ) - POS )
LINE = left( LINE, POS )
end
when KEY == x2c( 0076 ) then call RX.BEEP /* c-PgDn */
when KEY == x2c( 0077 ) then do /* c-Home */
call RX.KILL 1 ; LINE = substr( LINE, POS + 1 )
POS = 0 ; call RX.REST
end
when KEY == x2c( 0085 ) then call RX.BEEP /* F11 ---- */
when KEY == x2c( 0086 ) then do /* F12 ---- */
call RX.KILL 1 ; call RX.CODE KEY ; call RX.KILL 0
end
when length( KEY ) > 1 then call RX.BEEP /* ignore key */
otherwise call RX.NEXT KEY /* insert key */
end
end
if LINE > '' then do /* update LINE history: */
SCAN = RX.0 /* skip void or same */
if LINE <> RX.SCAN then do
SCAN = SCAN + 1 ; RX.0 = SCAN ; RX.SCAN = LINE
end
do while RX.LEFT( 0 ) ; end /* go to to end of line */
end
call RX.CRLF ; return LINE
RX.NEXT: procedure expose (EXPO) RX. /* insert/overwrite KEY */
POS = POS + 1 ; call RX.PLUS arg( 1 )
if RX.. then LINE = insert( arg( 1 ), LINE, POS - 1 )
else LINE = overlay( arg( 1 ), LINE, POS )
return RX.REST()
RX.REST: procedure expose (EXPO) RX. /* redraw rest of LINE */
call RX.PLUS substr( LINE, POS + 1 ) || ' '
return RX.ECHO( copies( x2c( 8 ), 1 + length( LINE ) - POS ))
RX.SCAN: procedure expose (EXPO) RX. /* input = history LINE */
arg SCAN ; if SCAN > RX.0 then SCAN = 1
if SCAN < 1 then SCAN = RX.0 ; call RX.KILL 1
if RX.0 = 0 then LINE = '' ; else LINE = RX.SCAN
POS = length( LINE ) ; call RX.PLUS LINE ; return LINE
RX.KILL: procedure expose (EXPO) RX. /* clear or redraw line */
if arg( 1 ) then do /* clear complete input */
call RX.PLUS substr( LINE, POS + 1 )
return RX.ECHO( copies( x2c(8) x2c(8), length( LINE )))
end
call RX.PLUS RX.0ECHO || LINE /* show prompt and line */
return RX.ECHO( copies( x2c(8), length( LINE ) - POS ))
RX.LEFT: procedure expose (EXPO) RX. /* move cursor position */
if arg( 1 ) then do /* move cursor left: */
if POS > 0 then call RX.ECHO x2c(8)
POS = max( 0, POS - 1 ) ; return sign( POS )
end /* else cursor right: */
else if POS < length( LINE ) then do
POS = POS + 1 ; call RX.PLUS substr( LINE, POS, 1 )
end /* result 1: not at end */
return POS < length( LINE ) /* result 0: End pos. */
RX.QUOT: procedure expose RX. /* return quoted arg(1) */
END = length( arg( 1 )) /* 1st -> '1st' */
parse arg TOP 2 MID =(END) END /* '2nd' -> "2nd" */
if TOP <> END then return "'" || arg( 1 ) || "'"
if TOP == "'" then return '"' || MID || '"'
if TOP == '"' then do /* "3rd" -> 'call 3rd' */
if abbrev( translate( MID ), 'CALL ' )
then return substr( MID, 6 ) /* "call 5th" -> 5th */
else return "'call" MID || "'"
end
return "'" || arg( 1 ) || "'" /* else -> 'else' */
RX.CODE: procedure expose RX. /* input key decoder... */
do N = 0 to 255 /* WIN keys INCOMPLETE */
X = d2x( N, 2 ) ; I.X = d2c( N )
if N < 32 then I.X = I.X ' (^' || d2c( N + 64 ) || ')'
X.X = '-/-' x2c( 7 ) /* for unknown 00??: x2c(7) BELl */
end N /* all DOS keys should be known */
I.07 = 'BEL (^G)' ; I.08 = 'BS (^H)' ; I.09 = 'TAB (^I)'
I.0A = 'LF (^J)' ; I.0D = 'CR (^M)' ; I.1B = 'ESC (^[)'
I.20 = 'SPace' ; I.FF = 'RSP' ; I.7F = 'DEL (^?)'
R.0 = 'Up Minus Center Plus Down Ins Del Tab Slash Star'
R.1 = 'F s-F c-F a-F' /* c-Up, c-Minus overlap 141,142 */
R.2 = 'QWERTYUIOP' /* hex. 0010..0019 */
R.3 = 'ASDFGHJKL:' /* hex. 001E..0028 */
R.4 = 'ZXCVBNM<>?' /* hex. 002C..0035 */
do N = 10 to 1 by -1
X = d2x( N + 1, 2 ) ; X.X = 'c-' || N // 10
X = d2x( N + 15, 2 ) ; X.X = 'alt' substr( R.2, N, 1 )
X = d2x( N + 29, 2 ) ; X.X = 'alt' substr( R.3, N, 1 )
X = d2x( N + 43, 2 ) ; X.X = 'alt' substr( R.4, N, 1 )
X = d2x( N + 58, 2 ) ; X.X = ' F' || N
X = d2x( N + 83, 2 ) ; X.X = 's-F' || N
X = d2x( N + 93, 2 ) ; X.X = 'c-F' || N
X = d2x( N +103, 2 ) ; X.X = 'a-F' || N
X = d2x( N +119, 2 ) ; X.X = 'alt' N // 10
KEY = word( R.1, (N + 1) % 2 ) || (11 + (N + 1) // 2)
X = d2x( N +132, 2 ) ; X.X = right( KEY, 5 )
X = d2x( N +140, 2 ) ; X.X = 'c-' || word( R.0, N )
end N
R.0 = 'Left Right End PgDn Home'
R.1 = '[{ ]} Enter -/- A' /* -/- 001D left Contr. */
R.2 = ';: ''" `~ -/- |\' /* -/- 002A left Shift */
R.3 = ',< .> /? -/- Star' /* -/- 0036 right Shift */
R.4 = 'Home Up PgUp Minus' /* overlap | 7 8 9 - 4 */
R.5 = 'Left Center Right Plus' /* numeric | 4 5 6 + 1 */
R.6 = 'End Down PgDn Ins Del' /* keypad | 1 2 3 0 . */
do N = 5 to 1 by -1
X = d2x( N + 25, 2 ) ; X.X = 'alt' word( R.1, N )
X = d2x( N + 38, 2 ) ; X.X = 'alt' word( R.2, N )
X = d2x( N + 53, 2 ) ; X.X = 'alt' word( R.3, N )
X = d2x( N + 70, 2 ) ; X.X = ' ' || word( R.4, N )
X = d2x( N + 74, 2 ) ; X.X = ' ' || word( R.5, N )
X = d2x( N + 78, 2 ) ; X.X = ' ' || word( R.6, N )
X = d2x( N +114, 2 ) ; X.X = 'c-' || word( R.0, N )
X = d2x( N +150, 2 ) ; X.X = 'a-' || word( R.4, N )
X = d2x( N +154, 2 ) ; X.X = 'a-' || word( R.5, N )
X = d2x( N +158, 2 ) ; X.X = 'a-' || word( R.6, N )
end N
I.00 = X.00 /* c-@ 0003 not mapped => no 00 */
X.00 = 'HALT' /* c-Break: see HALT in RX.CHAR */
X.01 = 'alt ESC' /* DOS: 0001, OS/2: task switch */
X.03 = 'NUL (^@)' /* WIN: 0002..000B see c-1..c-0 */
X.07 = I.00 /* c-6 0007 mapped to 1E, RS ^^ */
X.0D = 'ctrl =+' /* ???: 000D, DOS and OS/2: n/a */
X.0E = 'alt BS' /* c-_ 000C mapped to 1F, US ^- */
X.0F = 'shift TAB' /* n/a: 0038 left Alt */
X.37 = 'a-Star' /* n/a: 003A CapsLock */
X.39 = 'a-Space' /* WIN: 0039, DOS and OS/2: n/a */
X.2A = I.00 ; X.36 = I.00 /* n/a: 002A, 0036 L-, R-Shift */
X.4A = X.9A ; X.9A = I.00 /* n/a: 009A, alt pad Minus 004A */
X.9C = I.00 /* n/a: 009C a-Center impossible */
X.4E = X.9E ; X.9E = I.00 /* n/a: 009E, alt pad Plus: 004E */
X.72 = 'c-PrtSc' /* Print Screen, once shift STAR */
X.82 = 'alt -_ (scan 0C)' /* hex. 0082..0083 on key 12..13 */
X.83 = 'alt =+ (scan 0D)' /* n/a: 0045..0046 Num-, S-Lock */
X.84 = 'c-PgUp' /* hex. E00D NumEnter -> 0D CR */
X.A4 = 'a-Slash' /* hex. E00A c-NumEnter -> 0A LF */
X.A5 = 'a-Tab' /* DOS: 00A5, OS/2: task switch */
X.A6 = 'a-NumEnter' /* hex. 00A7..00FF undefined */
arg KEY OLD ; call RX.CRLF 'press key twice to exit decoder'
do until KEY = OLD /* WIN keys INCOMPLETE */
X = c2x( KEY ) ; N = right( X, 2 ) ; X = left( X, 4 )
if length( KEY ) = 2 then call RX.ECHO '[' || X || ']' X.N
else call RX.ECHO '[' || X || ']' I.N
call RX.ECHO left( '', 24 ) x2c( 0D )
OLD = KEY ; KEY = RX.CHAR()
end
return RX.ECHO( left( '', 24 ) x2c( 0D ))
RX.HELP: procedure expose RX. /* build a help command */
parse arg LINE, X
if RX.0WARP then CMD = "address CMD 'helpmsg"
else CMD = "address COMMAND 'help"
if X > '' then return CMD X LINE || "'"
else return CMD LINE || "'"
RX.FILE: procedure expose RX. /* history or constants */
parse source . . FILE
N = max( lastpos( '\', FILE ), lastpos( '/', FILE )) + 1
parse var FILE FILE =(N) N /* for LINUX, OS/2, DOS */
return FILE || arg( 1 ) || N /* rx\name ==> rx\0name */
RX.SAVE: procedure expose RX. /* save or load history */
FILE = RX.FILE( '0' ) /* rx\name ==> rx\0name */
HEAD = '/*' centre( ' */ signal off novalue /* ', 72, '-' ) '*/'
if RX.0 > 0 then do /* save history in file */
call lineout FILE, HEAD ; call lineout FILE, ''
do N = 1 to RX.0
call lineout FILE, RX.N ; drop RX.N
end
call RX.CRLF RX.0 'history lines saved >>' FILE
call lineout FILE ; RX.0 = 0 /* use "portable" close */
end
else do /* load command history */
do while sign( lines( FILE ))
N = RX.0 + 1 ; RX.N = linein( FILE )
if RX.N > '' & RX.N <> HEAD then RX.0 = N
end /* else empty or header */
call lineout FILE /* use "portable" close */
call RX.CRLF RX.0 'history lines loaded <' FILE
end
return
RX.UTIL: procedure expose RX. /* load RexxUtil stuff */
if \ RX.0WARP then return 0 /* 0 = not loaded (DOS) */
parse version RX.0REXX I . /* 1 = OS/2 or ooREXX ? */
if trunc( I ) = 6 then RX.0REXX = 'ooREXX'
parse source I . /* OS/2: force REXXSAA */
if I = 'OS/2' then RX.0REXX = 'REXXSAA'
/* ooREXX 6.03 does not support aliases, so use long names: */
Y.1 = 'SysGetKey' ; Y.2 = 'SysTextScreenSize' /* RexxUtil */
do I = 1 to 2
if RxFuncQuery( Y.I ) = 0 then iterate I
if RxFuncAdd( Y.I, 'RexxUtil', Y.I ) then return 0
end I /* 0 = fatal, not found */
return 1 /* 1 = functions loaded */
RX.BEEP: procedure expose RX. /* tty output ASCII BEL */
return RX.ECHO( x2c( 07 )) /* no beep() in DOSREXX */
RX.CURS: procedure expose RX. /* toggle insert mode */
RX.. = 1 - RX..
if RX.0REXX = 'ooREXX' & address() = 'CMD' then do
'color' d2x( 112 + 128 * RX.. ) /* NT color to show INS */
return (7 - 3 * RX..) 8 /* emulate 7 8 vs. 4 8 */
end
signal on syntax name RX.CHAW /* optional CursorType */
parse value CursorType() with T B . /* assume max. bottom B */
if RX.. then T = B % 2 ; else T = B - 1
return CursorType( T, B ) /* top T=1 doesn't work */
RX.CRLF: procedure expose RX. /* lineout(x) on StdOut */
return RX.ECHO( arg( 1 ) || RX.0CRLF )
RX.PLUS: procedure expose RX. /* echo TTY-"printable" */
return RX.ECHO( translate( arg( 1 ), RX.0PLOT, RX.0PLUS ))
RX.ECHO: procedure expose RX. /* charout(x) on StdOut */
return charout( /**/, arg( 1 ))
RX.CHAR: procedure expose RX. /* charin( ) w/out echo */
if sign( wordpos( trace( 'O' ), '?R ?I ?A ?L' ))
then say ' +++ next input key' || x2c( 07 ) || ':'
signal on syntax name RX.WARP /* if RxGetKey unloaded */
signal on halt name RX.CHAW /* interrupted RxGetKey */
select
when RX.0WARP then do
KEY = SysGetKey( 'NoEcho' )
if c2d( KEY ) = 0 | c2d( KEY ) = 224
then KEY = x2c( 00 ) || SysGetKey( 'NoEcho' )
end
when RX.0REXX = 'REXXSAA' then do
KEY = RxGetKey( 'NoEcho' )
if c2d( KEY ) = 0 | c2d( KEY ) = 224
then KEY = x2c( 00 ) || RxGetKey( 'NoEcho' )
end
when RX.0REXX = 'REXX/Personal' then KEY = INKEY()
otherwise KEY = charin() /* charin NOT supported */
end
return KEY
RX.CHAW: return x2c( 0000 ) /* HALT code 0000 Break */
RX.SIZE: procedure expose RX. /* get text screen size */
signal on syntax name RX.WARP /* if RxScrSiz unloaded */
select
when RX.0WARP then return SysTextScreenSize()
when RX.0REXX = 'REXXSAA' then return RxScrSiz()
when RX.0REXX = 'REXX/Personal' then return SCRSIZE()
otherwise return 24 80 /* dummy */
end
/* ----------------------------------------------------------- */
/* RxShell info functions, yet only used by RX.INFO( 9 ) */
RX.PATH: procedure expose RX. /* get/set a directory: */
parse arg DIR
if RX.0WARP | RX.0REXX <> 'REXXSAA' then do
if arg() = 1 then return directory( DIR )
else return directory()
end /* OS/2 or REXX/Personal okay */
if arg() = 1 then do /* assuming PC DOS 7 REXXSAA: */
if right( DIR, 1 ) = ':' then DIR = DIR || '.'
if RxChDir( DIR ) <> 0 then return ''
call RxChDrv left( DIR, pos( ':', DIR ))
end /* RxChDrv('') result ignored */
return RxGetDrv() || RxGetDir()
RX.EVAL: procedure expose RX. /* get/set environment: */
ENV = 'ENVIRONMENT'
select /* PC DOS REXXSAA needs upper case DOSENVIRONMENT: */
when RX.0REXX = 'ooREXX' then nop
when RX.0REXX = 'REXX/Personal' then nop
when RX.0WARP then ENV = 'OS2' || ENV
when RX.0REXX = 'REXXSAA' then ENV = 'DOS' || ENV
otherwise nop /* optimist */
end
if arg( 2, 'o' ) then return value( arg( 1 ),/* get */, ENV )
else return value( arg( 1 ), arg( 2 ), ENV )
RX.TRAV: procedure expose RX. /* show TRAce Verbosely */
arg TOP 2 VAL /* skip known prefixes */
if pos( TOP, '?!$+-' ) = 0 then arg VAL, TOP
select
when VAL = 'C' then return TOP || 'Commands'
when VAL = 'A' then return TOP || 'All'
when VAL = 'R' then return TOP || 'Results'
when VAL = 'E' then return TOP || 'Errors'
when VAL = 'O' then return TOP || 'Off'
when VAL = 'F' then return TOP || 'Failure'
when VAL = 'N' then return TOP || 'Normal'
when VAL = 'I' then return TOP || 'Intermediates'
when VAL = 'L' then return TOP || 'Labels'
when TOP || VAL = 'ON' then return 'ON (?Results)'
when TOP || VAL = 'OFF' then return 'OFF (Normal)'
when TOP || VAL = '' then return 'n/a (Normal)'
otherwise return TOP || VAL
end
RX.MORE: procedure expose RX. /* output item counter: */
parse arg ITEM, ROWS, COLS, TEXT ; if ITEM = 0 then return 0
call RX.PLUS TEXT ; ITEM = ITEM + 1
select
when ROWS = 1 then nop /* no new line if 1 row */
when COLS < 80 then call RX.CRLF /* new line 40..79 COLS */
otherwise /* new line if odd item */
if ITEM // 2 then call RX.CRLF
ROWS = 2 * ROWS - 2 /* double limit 80 COLS */
end
select /* adjust 1 prompt line */
when ROWS > 1 + ITEM then return ITEM
when ROWS = 2 & ITEM = 2 & 80 <= COLS then return ITEM
otherwise ITEM = 'press ESCape or any key to continue...'
end
select /* separate prompt line */
when ROWS > 1 then TEXT = ''
when COLS < length( TEXT ITEM ) then ITEM = x2c(7)
when COLS < length( TEXT ) + 40 then ITEM = ' ' || ITEM
otherwise ITEM = left( '', COLS - 40 - length( TEXT )) ITEM
end
TEXT = ITEM || TEXT
TEXT = copies( x2c(8) x2c(8), length( TEXT )) x2c( 0D )
call RX.ECHO ITEM ; ITEM = RX.CHAR() <> x2c( 1B )
call RX.ECHO TEXT ; return ITEM /* 1: new page, 0: ESC */
RX.INFO: procedure expose (EXPO) RX. /* show RxShell info */
call RX.KILL 1 ; call RX.CRLF
parse value RX.SIZE() with ROWS COLS
select
when arg( 1 ) = 1 then do /* F1: general help */
I.1 = 'F1 RxShell help (this text) '
I.3 = 'F2 quote (last) input line '
I.5 = 'F3 exit '
I.7 = 'F4 save or load history file '
I.9 = 'F5 -/- '
/* >> nomath */
I.9 = 'F5 list of RxShell functions '
/* << nomath */
I.11 = 'F6 input key mapping '
I.2 = 'F7 -/- '
I.4 = 'F8 -/- '
I.6 = 'F9 show REXX environment info '
I.8 = 'F10 clear history (free memory) '
I.10 = 'F11 -/- '
I.12 = 'F12 input key decoder tests '
I.13 = '<- arrow move cursor left '
I.14 = 'Ctrl <- move to prev. word '
I.15 = '-> arrow move cursor right '
I.16 = 'Ctrl -> move to next word '
I.17 = 'END last character '
I.18 = 'Ctrl END clear to last char '
I.19 = 'HOME first character '
I.20 = 'Ctrl HOME clear to first char '
I.21 = 'TAB complete line with history '
I.22 = 'BackSpace clear prev. char '
I.23 = 'up arrow show prev. line in history '
I.24 = 'DEL clear next char '
I.25 = 'down arrow show next line in history '
I.26 = 'ESC clear complete line '
I.27 = 'INS toggle insert mode '
I.28 = 'Alt-F4 exit '
end
when arg( 1 ) = 5 then do /* F5: math. functions */
/* >> nomath */
I.1 = 'ARC( x ) rad <-> degree.min.sec'
I.2 = 'complex ARG: see ATAN and also NORM'
I.3 = 'ASIN( x ) arcsin, if abs(x) <= 1' /* ----- */
I.4 = 'ARSH( x ) Area SH, x=ArSH(SH(x))' /* here */
I.5 = 'ACOS( x ) arccos: pi/2 - ASIN(x)' /* avoid */
I.6 = 'AREA( x ) 1<=x: ArCH, -1<x: ArTH' /* alpha */
I.7 = 'ATAN( x ) arctan, pi/2 = ACOS(0)' /* order */
I.8 = 'ATAN( x, y ) polar angle re x, im y' /* ----- */
I.9 = "DF( f, x ) diff. f'(X) = df(X)/dX"
I.10 = 'ERF( x ) int. error, x *ROOT(2)'
I.11 = 'GCD( x, y ) greatest common divisor'
I.12 = 'INT( f, a, b ) int. f(X) dX, X=a to b'
I.13 = 'LN( x ) log hyp, x=LN(EXP(x))' /* ----- */
I.14 = 'EXP( x ) e ** x with e = EXP(1)' /* here */
I.15 = 'LOG( x, y ) log: LN( x ) / LN( y )' /* avoid */
I.16 = 'GAMMA( x ) whole x only for x > 0' /* alpha */
I.17 = 'LOG( x ) binary log LN(x)/LN(2)' /* order */
I.18 = '!( x ) GAMMA( x+1 ) if 0 <= x' /* ----- */
I.19 = 'LI( x ) log int. if 0 < x <> 1'
I.20 = 'OVER( x, n ) binomial x over 0 <= n'
I.21 = 'SIN( x ) sine: COS( x - pi/2 )' /* ----- */
I.22 = 'SH( x ) sinh: (e**x - e**-x)/2' /* here */
I.23 = 'COS( x ) cosine' /* avoid */
I.24 = 'CH( x ) cosh: (e**x + e**-x)/2' /* alpha */
I.25 = 'TAN( x ) tangens: SIN(x)/COS(x)' /* order */
I.26 = 'TH( x ) tan hyp: SH(x) / CH(x)' /* ----- */
I.27 = 'ROOT( x, y ) x ** (1/y), for 0 <= x'
I.28 = 'NORM( x, y ) abs( re x, im y ) ** 2'
I.29 = 'ROOT( x ) square root x ** (1/2)'
I.30 = 'NORM( x ) abs(x) = ROOT(NORM(x))'
if digits() > RX.0GAMMA /* discourage GAMMA(x) dead loop */
then I.16 = 'GAMMA( x ) only for whole 2*x > 0'
else I.18 = 'GAMMA( x, y ) beta: G(x)*G(y)/G(x+y)'
I.31 = 'INV( f,y,a ) invert f(X)=y, tangent'
I.32 = 'SUM( f ) sum of f(X), X=1..0/0'
I.33 = 'INV( f,y,a,b ) invert f(X)=y, secant'
I.34 = 'ZETA( x ) use only whole x <> 1'
I.35 = 'f( X ) example: "X -" VAR "* ROOT(X)"'
I.36 = "trace 'F' watch f( X ) iteration"
/* >> option */
do I = 36 to 31 by -1
L = I + 4 ; I.L = I.I
end I /* 4 lines (optional) equations: */
I.31 = 'ROOT( a,b,c ) min.|s|: (a*s+b)*s+c=0'
I.32 = 'ROOT( a,b,c,d ) s: ((a*s+b)*s+c)*s+d=0'
I.33 = 'NORM( a,b,c ) max.|s|: (a*s+b)*s+c=0'
I.34 = 'NORM( a,b,c,d ) solution s2,s3 if real'
/* << option */
/* << nomath */
end
when arg( 1 ) = 6 then do /* F6: key mapping 00?? */
I.1 = 'alt-A mapped to d2c(224' d2c(224) /* 1E */
I.2 = 'Ctrl G unchanged BEL (^G' x2c(07)
I.3 = 'alt-C mapped to ETX (^C' x2c(03) /* 2E */
I.4 = 'alt-G mapped to BEL (^G' x2c(07) /* 22 */
I.5 = 'alt-BS mapped to BS (^H' x2c(08) /* 0E */
I.6 = 'shift-TAB mapped to TAB (^I' x2c(09) /* 0F */
I.7 = 'alt-H mapped to BS (^H' x2c(08) /* 23 */
I.8 = 'alt-I mapped to TAB (^I' x2c(09) /* 17 */
I.9 = 'Ctrl CR unchanged LF (^J' x2c(0A)
I.10 = 'alt-CR mapped to CR (^M' x2c(0D) /* 1C */
I.11 = 'alt-J mapped to LF (^J' x2c(0A) /* 24 */
I.12 = 'alt-M mapped to CR (^M' x2c(0D) /* 32 */
I.13 = 'alt-P mapped to DLE (^P' x2c(10) /* 19 */
I.14 = 'alt-Q mapped to DC1 (^Q' x2c(11) /* 10 */
I.15 = 'alt-S mapped to DC3 (^S' x2c(13) /* 1F */
I.16 = 'alt-ESC mapped to ESC (^[' x2c(1B) /* 01 */
I.17 = 'alt-STAR mapped to ESC (^[' x2c(1B) /* 37 */
I.18 = 'alt-[{ US mapped to ESC (^[' x2c(1B) /* 1A */
I.19 = 'Ctrl @2 mapped to NUL (^@' x2c(00) /* 03 */
I.20 = 'Use F12 to start key decoder tests...'
do I = 1 to 19
I.I = insert( '), echo', I.I, 28 )
end I
end
when arg( 1 ) = 9 then do /* F9: RxShell state */
parse source I.1 /* long line = 2 items: */
I.1 = 'source :' I.1 '(' || sourceline() 'lines)'
I.2 = substr( I.1, 40 ) ; parse version I.3
I.3 = 'version:' I.3
I.4 = 'address:' address()
L = condition() condition( 's' ) condition( 'c' )
I.5 = 'status :' L
if L = '' then L = '(no signal condition status)'
else L = RX.0INFO /* RX.0INFO by RX.TRAP */
if L = '' then L = '(no' condition( 'c' ) 'description)'
I.6 = 'verbose:' L
I.7 = 'numeric: digits' digits()
I.8 = 'numeric: fuzz' fuzz() 'form' form()
I.9 = 'trace :' RX.TRAV( RX.0TEST ) '(user)'
I.10 = 'trace():' RX.TRAV( trace()) '(shell)'
I.12 = 'RXTRACE:' RX.TRAV( RX.EVAL( 'RXTRACE' ))
I.11 = 'CWD :' RX.PATH() /* may overwrite RXTRACE: */
if 40 <= length( I.11 ) then I.12 = substr( I.11, 40 )
I.13 = 'queued :' queued() 'lines'
if RX.0WARP
then I.13 = I.13 '(' || RxQueue( 'Get' ) || ')'
else if RX.0REXX = 'REXX/Personal'
then I.13 = I.13 '(' || stackstatus( ) || ')'
if RX.0REXX = 'REXXSAA' | RX.0WARP
then I.14 = 'date :' date( 'W' ) || ',' date( 'L' )
else I.14 = 'date :' date( 'W' ) || ',' date()
I.15 = 'history:' RX.0 'lines'
I.16 = 'time :' time()
I.17 = 'result :' RX.0USER ; I.18 = substr( I.17, 40 )
if I.18 = '' then do
I.18 = COLS 'x' ROWS || ', insert:'
if RX.. then I.18 = I.18 'ON' ; else I.18 = I.18 'OFF'
I.18 = 'screen :' I.18
end
end
end /* otherwise REXX error 7: WHEN or OTHERWISE expected */
N = 1
do I = 1 while symbol( "I.I" ) = 'VAR'
N = RX.MORE( N, ROWS, COLS, left( I.I, 40 - 1 ))
end I
if I // 2 = 0 then call RX.CRLF ; return RX.KILL( 0 )
/* >> nomath */
/* ----------------------------------------------------------- */
/* RxShell arithmetical functions (almost arbitrary precision) */
/* Derived functions which could be easily added when needed: */
/* abs(x,y) = hypot(x,y) = ROOT(x*x + y*y) = ROOT( NORM(x,y) ) */
/* arg(x,y) = ATAN(x,y), "overloading" REXX arg() or abs() */
/* im(x,y) = x * SIN(y), complex polar coordinates x versor y */
/* re(x,y) = x * COS(y) for angle y = ATAN( re(x,y),im(x,y) ) */
/* (arc)cot: cot(x) = COS(x) / SIN(x), arccot(x) = ATAN( 1/x ) */
/* (Ar)cot hyp.: coth(x) = 1 / TH(x), Arcoth(x) = AREA( 1/x ) */
/* (co)sec hyp.: sech(x) = 1 / CH(x), csch(x) = 1 / SH(x) */
/* (co)secans: sec(x) = 1 / COS(x), cosec(x) = 1 / SIN(x) */
/* arc(co)sec: arcsec(x) = ACOS( 1/x), arccsc(x) = ASIN( 1/x ) */
/* Ar(co)sech: arsech(x) = AREA( 1/x), Arcsch(x) = ARSH( 1/x ) */
/* exp. int.: Ei(x) = LI( EXP( x )) , log10(x) = LOG( x,10 ) */
/* Gauss phi: phi(x) = ERF(x/ROOT(2)) aka probability integral */
/* power: pow(x,y) = EXP( LN(x)*y ), or x**y, ROOT(x,1/y) */
/* T(x,n) = 2**-n * ((x+ROOT(x*x-1))**n + (x-ROOT(x*x-1))**n), */
/* T(x,n) = 2**-n*2*COS(n*ACOS(x)), whole n>0: Cebysev-polynom */
/* The implemented DF(f,x) approximation of f'(x) is slow and */
/* unreliable. Whenever possible determine f'(x) directly: */
/* arctan'( x ) = 1 / ( 1 + x*x ), arccot'(x) = -arctan'(x) */
/* Artanh'( x ) = 1 / ( 1 - x*x ), Arcoth'(x) = +Artanh'(x) */
/* arcsin'( x ) = 1 / ROOT( 1-x*x), arccos'(x) = -arcsin'(x) */
/* Arsinh'( x ) = 1 / ROOT( 1+x*x), Arsech'(x) = arccos'(x)/x */
/* Arcosh'( x ) = 1 / ROOT( x*x-1), arcsec'(x) = Arcosh'(x)/x */
/* Arcsch'( x ) = - Arsinh'(x) / x, arccsc'(x) = -arcsec'(x) */
/* erf'(x) = EXP(-x*x ) / ROOT(pi/4), Ei'(x) = EXP(x) / x */
/* phi'(x) = EXP(-x*x/2) / ROOT(pi/2), Li'(x) = 1 / LN(x) */
/* sin'(x) = +COS(x), sh'(x) = CH(x), tan'(x) = 1 +TAN(x)**2 */
/* cos'(x) = -SIN(x), ch'(x) = SH(x), th'(x) = 1 - TH(x)**2 */
/* cot'(x) = -1 / (SIN(x)**2), coth'(x) = -1/(SH(x)**2) */
/* csc'(x) = -COS(x) / (SIN(x)**2), sec'(x) = TAN(x)/COS(x) */
/* csch'(x) = - CH(x) / ( SH(x)**2), sech'(x) = -TH(x)/ CH(x) */
/* generally: f'(x) = s'(x) * g'( s(x) ) for f(x) = g( s(x)), */
/* logarithm: f'(x) = s'(x) / s(x) for f(x) = LN( s(x)), */
/* parameter: f'(x) = s'(t) / c'(t) for x = c(t) and y = s(t), */
/* inverse: f'(x) = 1 / F'(x) for x = F(f(x)), y = f(x), */
/* a=0 polar: f'(x) = r'(0) / r(0) for x = r(0) and y = 0, */
/* polar: f'(x) = (r(a)+tan(a)*r'(a))/(r'(a)-tan(a)*r(a)), */
/* angle 0 < a < 2*pi, x = cos(a)*r(a) and y = sin(a)*r(a) */
RX.MATH: procedure expose RX. /* misc. math. function */
arg L ; if abs( L // 2 ) then return (L = 1) / 2
N = 0 ; F = L - 1 ; L = L % 2 /* L = 1: 0.5, odd L: 0 */
if symbol( 'RX.0B.L' ) = 'VAR' then return RX.0B.L
signal on syntax name RX.TRAP ; signal on novalue name RX.TRAP
numeric digits RX.DIGS( +2 ) ; numeric fuzz 0
TEST = RX.TRAF( 1 ) = 0 | right( RX.0TEST, 1 ) = 'F'