home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Simtel MSDOS 1992 June
/
SIMTEL_0692.cdr
/
msdos
/
eel
/
key_re.map
< prev
next >
Wrap
Internet Message Format
|
1988-09-17
|
170KB
Date: 13 Sep 1988 2311-EDT
From: LISKOV@XX.LCS.MIT.EDU
Subject: key re-mapping
To: info-ibmpc@walker-emh.arpa
to:infoibmpc
subject: remapping keys
Using NANSI.SYS or ANSI.SYS is the poor man's approach to key remapping.
It is done by using ansi escape sequences such as the following that I
use in my autoexec.bat to remap the function keys:
echo 9;"swap"13p0;"cls"13p2;"ls -au";13p
echo 3;"lf";13p4;"copy ";p
echo 5;"sdl d:/w";13p7;"sdl a:/w";13p8;"sdl c:/w";13p
echo 6;"sdl e:/w";13p
The 13p appends a carriage return to the remapped sequence. The character
is the escape character. If you cannot input an escape character in your
editor the prompt command can be used, for example:
echo on
prompt $e[0;59;"swap";13p
prompt $e[0;60;"cls";13p
prompt $e[0;61;"ls -au";13p
prompt $e[0;63;"lf ";13p
prompt $e[0;64;"copy "p
prompt $e[0;65;"sdl d:/w";13p
prompt $e[0;110;"sd d:/e";13p
prompt $e[0;66;"sdl c:/w";13p
prompt $e[0;111;"sd c:/e";13p
prompt $e[0;67;"sdl a:/w";13p
prompt $e[0;112;"sd a:/e";13p
prompt $e[0;68;"dir /w ";13p
prompt $d $t$h$h$h $p$g
I do not know if one can map meta keys using this approach, but it can
be done in Epsilon. In Epsilon one can define a key binding and then
make it permanent by saving the state, epsilon.sta. Or one can define
eel code for epsilon, compile it, and then load it in as needed or
load it in and make it permanent by saving the state with the eel
code loaded.
I am enclosing examples of eel code, most of which came from the old
info-ibmpc librady at c.isi.edu. These are all appended to this
note. To use an *.e file, use eel to compile it to an *.b file, then
within epsilon, load it by typing the f-3 key and following the prompt.
Type write-state to make those commands a permanent part of your key
definitions. Of course, the eel code is for use only by legitimate
epsilon licensees.
The nate.e file contains some the most useful generic features of the
.e files that appear to work well and I use these extensions in my
.sta file. Note that the nate.e contains some initial loading
defaults and key bindings... see end of file. Also the epsilon.sta
contains my normal alternate key bindings. View the *.e files for
specific documentation.
To right justify a paragraph type ctrl-u, esc-q and then wait. It
works a little slowly and requires that the paragraph not be
indented. This is an example of the result.
Narrow.e works as advertized, but is not included in nate.e.
The for-mode and the pas-mode in FOR_mode and PAS_mode appear very
useful in that they help with language syntax and insert all keywords
automatically. But they will take some getting used to. I would
suggest you load them when needed. I have modified them so that the
appropriate *.b files must be in the local directory when loaded.
You can change the appropriate #define statements to any specific
directory you desire to avoid this inconvenience. One might still
want to experiment with for_load (etc) or fortran.e for fortran
specific applications and pas_load (etc) for pascal applications.
Krypt works but is very slow.
Most of kmode appears to work and some appears very useful.
Happy computing
Nate Liskov % liskov.xx.mit.edu
******************************************************************
nate.e follows:
******************************************************************
/************************************************************************
This is a compliation of .eel commands from various .e sources on
info-ibmpc at c.isi.edu on the arpa net. These are ones that I think
will be useful and that appear to work as advertised. I have taken
liberty to modify key-bindings, etc. to my taste.
This material may be used and distributed freely, provided that it is not
used as part of a product to be sold for profit.
The ideas for most of the commands implemented here come primarily
from TOPS-20 EMACS, by Richard M. Stallman and others.
************************************************************************/
/************************************************************************
* "Epsilon", "EEL" and "Lugaru" are trademarks of Lugaru Software, Ltd. *
* *
* Copyright (C) 1985 Lugaru Software Ltd. All rights reserved. *
* *
* Limited permission is hereby granted to reproduce and modify this *
* copyrighted material provided that the resulting code is used only in *
* conjunction with Lugaru products and that this notice is retained in *
* any such reproduction or modification. *
************************************************************************/
/*
This file contains the following commands:
****************************************************************
Written by Nate Liskov:
insert_file - bound to C-X C-I - From Epsilon Manual EEL Example
****************************************************************
Written by Bob Knight copyright (C) 1986:
lowercase_region - lowercases the current region, bound to C-X C-L
uppercase_region - uppercases the current region, bound to C-X C-U
revert_file - restore the current buffer from the associated disk file, bound
to C-X C-R
connect_to_directory - connect to a named directory
count_lines_region - count the number of lines in the current region, bound to
M-=
****************************************************************
Modifications and extensions by Bruce K. Hillyer:
Fill-indented (<esc><tab>) fills the region, making the indentation equal to
that of the first line. This is useful, for instance, when editing a
quotation that is indented from the left margin. Mark fist line and then
go to end of paragraph and type esc followed by tab
Display-matching-parens is a command to toggle the behavior of the closing
delimiters ) ] } to control whether Epsilon automatically shows the
matching open delimiter.
split_and_find -bound to C-X S , splits screen and prompts for find_file
Insert-time inserts the current date and time into the buffer at point.
Show-time (C-X t) shows the current date and time in the echo area.
The next few commands are for scrolling when using two windows.
Next-page-lower (C-PgDn) is like next-page (C-V), but it controls
the window below the current one.
Previous-page-lower (C-PgUp) is like previous-page (A-V), but for
the window below the current one.
Next-page-both (C-keypad key 5) shows the next page in both
the current window and the one below.
Goto-beginning (A-<) and goto-end (A->) leave a mark behind.
Show-point (C-X =) also shows the decimal and octal values of the character
at point.
Next-page (C-V) and Previous-page (A-V) leave just one line of overlap.
********************************************************************
Copyright (C) 1985 George D. Hadden on right justify feature:
Right-justify paragraph: Ctrl-u ,ESC, Q
Right-justify region: Ctrl-u, fill_region
***************************************************************
*/
#include "eel.h"
/* lowercase the region */
command lowercase_region() on cx_tab[CTRL('l')]
{
do_region_case(1);
}
/* capitalize the region */
command uppercase_region() on cx_tab[CTRL('u')]
{
do_region_case(0);
}
/* Routine for region case converts */
do_region_case(do_lower)
{
int c, from = point, to = mark, temp;
char resp[80];
if (from > to)
temp = from, from = to, to = temp;
if ((to-from)>250)
get_string(resp, "Do you really want to case convert such a large region? [y]");
else *resp = 'Y';
if (toupper(*resp) != 'N') {
for (; from <= to; from++) {
check_abort();
c = character(from);
replace(from, do_lower ? tolower(c) : toupper(c));
}
}
}
/* Revert file - restore the current buffer from its associated disk file */
command revert_file() on cx_tab[CTRL('R')]
{
char resp[80];
int old_point;
if(!strcmp(bufname,"process"))
say("Can't revert process");
else {
get_string(resp, "Restore file from disk? [n]");
if (toupper(*resp) == 'Y') {
old_point = point;
read_file(filename);
point = old_point;
}
}
}
/* connect_to_directory */
command connect_to_directory()
{
char dir[80];
get_string(dir,"Connect to directory [\\]: ");
if (!*dir)
strcpy(dir,"\\");
if (chdir(dir))
say("Unable to connect to %s",dir);
else {
if (another) {
to_buffer("process");
point = size();
insert('\n');
to_buffer(previous_buffer);
}
}
}
/* count_lines_region */
command count_lines_region() on reg_tab[ALT('=')]
{
int curpoint = point, nlines = 1, temp;
if (point > mark)
temp = point, point = mark, mark = temp;
for (;point <= mark;) {
check_abort();
if (!nl_forward())
break;
if (point <= mark)
nlines++;
}
say("%d",nlines);
point = curpoint;
}
/************************************************
* *
* new functions by Bruce Hillyer *
* *
************************************************/
/* fill region making indentation equal to that of the first line
*
* The use of this routine is as follows. If you are writing a paragraph
* that is indented, as in a quotation, put a mark at the beginning of the
* first line, go past the last line, and press <escape> followed by <tab>.
* The entire paragraph will be filled, but all lines will be indented to
* match the first line.
*/
command fill_indented() on reg_tab[ALT(CTRL('I'))]
{
fill_region_indent(1);
}
/* automatically display matching delimiters (toggle)
*/
command display_matching_parens()
{
int display_matching_mode =
(has_arg ? (iter != 0)
: !(mode_keys[')'] == (short) show_matching_delimiter
&& mode_keys[']'] == (short) show_matching_delimiter
&& mode_keys['}'] == (short) show_matching_delimiter
)
);
if (display_matching_mode) {
say("Display matching )]}");
mode_keys[')'] =
mode_keys[']'] =
mode_keys['}'] = (short) show_matching_delimiter;
}
else {
say("No display matching )]}");
mode_keys[')'] =
mode_keys[']'] =
mode_keys['}'] = 0;
}
iter = 1;
}
/* Modifications and extensions to the Epsilon editor. Bruce K. Hillyer.
* Portions of this code are covered by the following notice:
*/
/************************************************************************
* "Epsilon", "EEL" and "Lugaru" are trademarks of Lugaru Software, Ltd. *
* *
* Copyright (C) 1985 Lugaru Software Ltd. All rights reserved. *
* *
* Limited permission is hereby granted to reproduce and modify this *
* copyrighted material provided that the resulting code is used only in *
* conjunction with Lugaru products and that this notice is retained in *
* any such reproduction or modification. *
************************************************************************/
/* split this window and find a file in the one below this
*/
command split_and_find() on cx_tab['s'], cx_tab['S']
{
window_split();
find_file();
}
/* insert the current date and time in the buffer
*/
command insert_time()
{
struct time_info b;
time_and_day(&b);
mark = point;
bprintf("%d-%02d-%d %d:%02d:%02d.%02d",
b.month, b.day, b.year, b.hour, b.minute, b.second, b.hundredth);
}
/* insert the current date and time in the buffer
*/
command insert_time()
{
struct time_info b;
time_and_day(&b);
mark = point;
bprintf("%d-%02d-%d %d:%02d:%02d.%02d",
b.month, b.day, b.year, b.hour, b.minute, b.second, b.hundredth);
}
/* show the current date and time in the echo area
*/
command show_time() on cx_tab['t']
{
struct time_info b;
time_and_day(&b);
say("%d-%02d-%d %d:%02d:%02d.%02d",
b.month, b.day, b.year, b.hour, b.minute, b.second, b.hundredth);
}
/* the next few commands are for scrolling when using two windows. C-PgUp
* is like A-V, but for the window below the current one. C-PgDn is like
* C-V, but for the window below. C-(keypad key 5) scrolls both the current
* window and the one below.
*/
/* show the previous page in the window below this one
*/
command previous_page_lower() on reg_tab[NUMCTRL(NUMDIGIT(9))]
{
window_number++;
previous_page();
window_number--;
}
/* show the next page in the window below this one
*/
command next_page_lower() on reg_tab[NUMCTRL(NUMDIGIT(3))]
{
window_number++;
next_page();
window_number--;
}
/* show the next page both in this window and the one below this
*/
command next_page_both() on reg_tab[NUMCTRL(NUMDIGIT(5))]
{
window_number++;
next_page();
window_number--;
next_page();
}
/************************************************
* *
* local modifications of functions *
* *
************************************************/
command show_point() on cx_tab['=']
{
/***/ say("Column=%d, point=%d, size=%d, chr=0x%x (%d)",
/***/ current_column(), point, size(), curchar(), curchar());
}
/* prog.e */
show_line() /* display point for a moment, then restore */
{
/* delay a bit longer when showing a matching delimiter.
*/
int oldstart = window_start;
int time;
maybe_refresh();
/***/ time = (window_start == oldstart) ? 8 : 25;
if (has_arg && iter > 0)
time = iter;
pause(time);
window_start = oldstart;
build_first = 1;
}
/* window.e */
int move_by()
{
/* leave just one line of overlap on C-V
*/
/***/ int n = window_size - 1;
/***/ if (n < 1)
/***/ n = 1;
return n;
}
fill_region_indent(indented)
int indented;
{
int start, *end = alloc_spot();
int indentation;
if (point > (*end = mark))
*end = point, point = mark;
/***/ to_begin_line();
/***/ re_search(1, "[ \t\n]*"); /* determine indentation */
/***/ indentation = (indented ? current_column() : 0);
while (point < *end) {
start = point;
if (search(1, "\n\n"))
point--;
if (point > *end)
point = *end;
/***/ if (character(point-1) == '\n')
/***/ point--;
/***/ region_fill_ind(start, point, indentation);
re_search(1, "[ \t\n]*"); /* skip paragraph indent */
}
free_spot(end);
}
command fill_paragraph() on reg_tab[ALT('q')], reg_tab[CTRL(']')]
{
int end, start=point;
iter = 0;
forward_paragraph();
end = point - 1;
backward_paragraph();
re_search(1, "[ \t\n]*"); /* leave leading whitespace intact */
/***/ region_fill_ind(point, end, 0);
if (start > size()) start = size();
point = start;
}
region_fill_ind(a, b, lmargin)
int a, b, lmargin;
{
/* leave two spaces after ':' when filling, and indent each line by the
* amount specified as lmargin
*/
int start, *end = alloc_spot();
char line[160];
int startcol;
point = a, *end = b;
if (a > b)
point = b, *end = a;
startcol = current_column();
while (point < *end) {
start = point;
/***/ if (line_fill(line, *end, margin_right, startcol, ".?:!",
")]'\""))
break;
while (point < *end && isspace(curchar()))
point++;
delete(start, point);
/***/ to_column(startcol);
stuff(line);
/***/ startcol = lmargin;
}
free_spot(end);
build_first = 1; /* redisplay hint */
}
command goto_beginning() on reg_tab[ALT('<')], reg_tab[NUMCTRL(NUMDIGIT(7))]
{
/***/ mark = point;
point = 0;
}
command goto_end() on reg_tab[ALT('>')], reg_tab[NUMCTRL(NUMDIGIT(1))]
{
/***/ mark = point;
point = size();
}
/* the following function has been modified by George D Hadden such
that when given a numeric argument, it will right justify as well as
fill the region */
command fill_region()
{
int start, *end = alloc_spot();
if (point > (*end = mark))
*end = point, point = mark;
while (point < *end) {
start = point;
if (search(1, "\n\n"))
point--;
if (point > *end)
point = *end;
region_fill(start, point);
re_search(1, "[ \t\n]*"); /* skip paragraph indent */
}
free_spot(end);
}
command fill_paragraph() on reg_tab[ALT('q')], reg_tab[CTRL(']')]
{
int end, start=point;
iter = 0;
forward_paragraph();
end = point - 1;
backward_paragraph();
re_search(1, "[ \t\n]*"); /* leave leading whitespace intact */
region_fill(point, end);
if (start > size()) start = size();
point = start;
}
region_fill(a, b)
int a, b;
{
int start, *end = alloc_spot();
char line[160], startcol;
point = a, *end = b;
if (a > b)
point = b, *end = a;
startcol = current_column();
while (point < *end) {
start = point;
if (line_fill(line, *end, margin_right, startcol, ".?!",
")]'\""))
break;
while (point < *end && isspace(curchar()))
point++;
delete(start, point);
/* geo's additions */
if (has_arg && /* numeric arg was provided */
index(line, '\n')) /* if end reached, no linefeed (?) */
justify(line, margin_right);
/* eventually, we'll do a left margin, too */
stuff(line); /* change these two lines to do left */
startcol = 0; /* margin. also add set-left-margin */
}
free_spot(end);
build_first = 1; /* redisplay hint */
}
justify (line, margin)
char *line, margin;
/* we can assume that line[0] is non-space */
{
char *line_ptr;
line_ptr = line;
while (strlen(line) < margin) {
/* returns immediately if longer than margin */
while (!isspace(*line_ptr))
line_ptr++;
while (isspace(*line_ptr) && *line_ptr != '\n')
line_ptr++;
if (*line_ptr == '\n')
line_ptr = line;
else
one_to_right(line_ptr++);
}
}
one_to_right(ptr)
char *ptr;
/* move characters in string one character to the right replacing *ptr
with a space */
{
char *end_ptr;
end_ptr = ptr;
while (*end_ptr)
end_ptr++;
while (end_ptr >= ptr) {
end_ptr[1] = *end_ptr;
end_ptr--;
}
*ptr = ' ';
}
command insert_file() on cx_tab[CTRL('I')]
{
char inserted_file[FNAMELEN];
char *original_buffer = bufname;
get_file(inserted_file, "Insert file: ");
zap("tempbuf"); /* make an empty buffer */
bufname = "tempbuf"; /* use that buffer */
filename = inserted_file;
if (file_read(inserted_file,1) > 0)
error("Read error: %s", inserted_file);
/* copy the characters */
xfer(original_buffer, 0 , size());
/* move back to buffer */
bufname = original_buffer;
delete_buffer("tempbuf");
}
/* declare routines that are defined elsewhere */
command goto_line();
command compare_windows();
when_loading()
{
/* set desired defaults */
use_default = 1;
margin_right = 70;
num_kbufs = 6;
use_default = 0;
/* supply desired bindings */
cx_tab['g'] = (short) goto_line;
reg_tab[ALT(CTRL('C'))] = (short) compare_windows;
/* for IBM-AT, swap the <esc> and <backquote> keys */
/* keytran[NUMCTRL(GREYESC)] = keytran[GREYESC] = '`';
keytran[NUMALT(GREYESC)] = ALT('`');
keytran['`'] = ESC; */
}
******************************************************************
narrow.e follows
******************************************************************
/********** Documentation to be inserted in file "edoc" ***********
narrow-bounds-to-region Narrow portion of buffer to edit to region.
Make region the only portion of the buffer that your commands
affect. Return to editting of the entire buffer with widen-bounds.
widen-bounds Widen bounds to entire buffer.
Use this command when you have finished editting a portion of the
buffer selected previously with narrow-bounds-to-region.
*********** End of documentation **********/
/*----- Gary R. Smith (smith#gary@b.mfenet@nmfecc.arpa) */
/****************** Beginning of file "narrow.e" ******************/
/* EEL commands to customize Epsilon 3.05 written by Gary R. Smith,
Aug. 9, 1986. */
#include "eel.h"
buffer int narrow_mode = 0; /* Are we in narrow mode? */
char *bef_reg;
char *aft_reg;
/*****************************************************************************
* *
* Save parts of buffer before and after region in temporary buffers, *
* and leave only region in the current buffer. *
* *
*****************************************************************************/
command narrow_bounds_to_region() on cx_tab['n']
{
int mod = modified;
int beg_reg = point;
int end_reg = mark;
if (narrow_mode) error("Already in Narrow mode");
if (point > mark) { /* beginning and end of region */
beg_reg = mark;
end_reg = point;
}
aft_reg = temp_buf();
xfer(aft_reg, end_reg, size()); /* save part after region */
delete(end_reg, size());
bef_reg = temp_buf();
xfer(bef_reg, 0, beg_reg); /* save part before region */
delete(0, beg_reg);
modified = mod;
narrow_mode = 1; /* now in Narrow mode */
make_mode();
}
/*****************************************************************************
* *
* Restore parts of buffer saved by narrow_bounds_to_region. *
* Keep point, mark, and window_start in same places. *
* *
*****************************************************************************/
command widen_bounds() on cx_tab['w']
{
int mod = modified;
char *current_buffer;
int oldstart = window_start; /* save start of window */
int oldpos = point; /* and point and mark */
int oldmark = mark;
int size_bef;
if (!narrow_mode) error("Cannot widen when not in Narrow mode");
point = 0; /* insert at beginning of current buffer */
current_buffer = bufname;
bufname = bef_reg; /* from 'before-region' temp buf */
xfer(current_buffer, 0, size());
size_bef = size();
bufname = current_buffer;
point = size(); /* insert at end of current buffer */
bufname = aft_reg; /* from 'after-region' temp buf */
xfer(current_buffer, 0, size());
bufname = current_buffer;
mark = oldmark + size_bef; /* restore point and mark */
point = oldpos + size_bef;
window_start = oldstart + size_bef; /* same start of window */
modified = mod;
narrow_mode = 0; /* no longer in Narrow mode */
make_mode();
}
/* make_mode() from disp.e is enhanced here to show Narrow mode */
make_mode()
{
strcpy(mode, major_mode);
if (fill_mode)
strcat(mode, " Fill");
if (over_mode)
strcat(mode, " Over");
if (!strip_returns)
strcat(mode, " NoTrans");
if (narrow_mode)
strcat(mode, " Narrow");
}
/****************** End of file "narrow.e" ******************/
******************************************************************
nuformat.e follows
******************************************************************
/************************************************************************
* "Epsilon", "EEL" and "Lugaru" are trademarks of Lugaru Software, Ltd. *
* *
* Copyright (C) 1985 Lugaru Software Ltd. All rights reserved. *
* *
* Limited permission is hereby granted to reproduce and modify this *
* copyrighted material provided that the resulting code is used only in *
* conjunction with Lugaru products and that this notice is retained in *
* any such reproduction or modification. *
************************************************************************/
/************************************************************************
* Portions of this file *
* Copyright (C) 1985 George D. Hadden *
* Permission is granted to reproduce and use this copyrighted material *
* for any purpose whatsoever. *
************************************************************************/
#include "eel.h"
#define WORD_PAT "[a-zA-Z0-9_]+"
/* position point after the next word */
command forward_word() on reg_tab[ALT('f')], reg_tab[NUMCTRL(NUMDIGIT(6))]
{
if (iter < 0) {
iter = -iter;
backward_word();
}
while (iter-- > 0)
re_search(1, WORD_PAT);
}
/* position point before the previous word */
command backward_word() on reg_tab[ALT('b')], reg_tab[NUMCTRL(NUMDIGIT(4))]
{
if (iter < 0) {
iter = -iter;
forward_word();
}
while (iter-- > 0)
re_search(-1, WORD_PAT);
}
#define tolow 0
#define toup 1
#define tocap 2
/* make the current word all lower case */
command lowercase_word() on reg_tab[ALT('l')]
{
int start = point;
forward_word();
mkcase(tolow, start, point);
}
/* make the current word all lower case */
command uppercase_word() on reg_tab[ALT('u')]
{
int start = point;
forward_word();
mkcase(toup, start, point);
}
/* capitalize the current word */
command capitalize_word() on reg_tab[ALT('c')]
{
int start = point;
forward_word();
mkcase(tocap, start, point);
}
/* fiddle with the case of the region */
mkcase(cs, from, to)
int cs;
int from, to;
{
int first = 1, new, c, newfirst;
int temp;
if (from > to)
temp = from, from = to, to = temp;
for (; from < to; from++) {
c = character(from), new = -1, newfirst = 0;
if (c >= 'A' && c <= 'Z') {
if (cs == tolow || cs == tocap && !first)
new = c + 'a' - 'A';
} else if (c >= 'a' && c <= 'z') {
if (cs == toup || cs == tocap && first)
new = c + 'A' - 'a';
} else
newfirst = 1;
first = newfirst;
if (new != -1)
replace(from, new);
}
}
/* transpose characters before and after point */
command transpose_characters() on reg_tab[CTRL('T')]
{
int p = point;
char c, d;
if (p == size() || curchar() == '\n') /* switch last two at end of line */
p--;
else if (p == 0 || character(point - 1) == '\n')
p++;
c = character(p); /* store away current */
d = character(p - 1);
if (p > 0 && p < size() && c != '\n' && d != '\n') {
replace(p, d);
replace(p - 1, c);
}
}
save_away(from, to)
int from, to;
{
zap("temp_buffer");
xfer("temp_buffer", from, to);
delete(from, to);
}
grab_back()
{
char *cur = bufname;
bufname = "temp_buffer";
xfer(cur, 0, size());
bufname = cur;
}
command transpose_words() on reg_tab[ALT('t')]
{
int first, second;
create("temp_buffer");
re_search(1, WORD_PAT);
re_search(-1, WORD_PAT);
re_search(-1, WORD_PAT);
first = point;
re_search(1, WORD_PAT);
save_away(first, point);
re_search(1, WORD_PAT);
second = point;
grab_back();
point = second;
re_search(-1, WORD_PAT);
save_away(point, second);
point = first;
grab_back();
delete_buffer("temp_buffer");
iter = 0;
}
command transpose_lines() on cx_tab[CTRL('T')]
{
int first;
create("temp_buffer");
nl_reverse();
to_begin_line();
first = point;
nl_forward();
save_away(first, point);
nl_forward();
grab_back();
nl_reverse();
to_begin_line();
delete_buffer("temp_buffer");
}
command set_fill_column() on cx_tab['f']
{
margin_right = (iter > 1) ? iter : (current_column() + 1);
iter = 1;
say("Fill column is %d", margin_right);
}
command mark_paragraph() on reg_tab[ALT('h')]
{
backward_paragraph();
mark = point;
forward_paragraph();
}
command forward_paragraph() on reg_tab[ALT(']')], reg_tab[NUMALT(NUMDIGIT(2))]
{
to_begin_line();
re_search(1, "([@.].*\n)*");
re_search(1, "[^ \t\n@.]");
if (re_search(1, "\n[ \t\n]")) {
point--;
re_search(-1, "^([@.].*\n)*");
} else
point = size();
}
command backward_paragraph() on reg_tab[ALT('[')],
reg_tab[NUMALT(NUMDIGIT(8))]
{
if (character(point - 1) == '\n')
re_search(-1, "^([@.].*\n)*");
re_search(-1, "[^ \t\n]");
if (re_search(-1, "\n[ \t\n]"))
re_search(1, "\n*");
re_search(1, "^([@.].*\n)*");
}
#define SENTEND "([.?!][])'\"]*[ \t\n]*([ \t][ \t]|\n))|(\n[ \t\n.])"
command forward_sentence() on reg_tab[ALT('e')],
reg_tab[NUMCTRL(NUMDIGIT(2))]
{
if (iter < 0) {
iter = -iter;
backward_sentence();
}
while (iter-- > 0) {
re_search(1, "[^ \t\n]"); /* don't find same sentence */
if (re_search(1, SENTEND)) /* go to end of sentence */
re_search(-1, "[ \n\t]*(.|\n)");
}
}
command backward_sentence() on reg_tab[ALT('a')],
reg_tab[NUMCTRL(NUMDIGIT(8))]
{
if (iter < 0) {
iter = -iter;
forward_sentence();
}
while (iter-- > 0) {
re_search(-1, "[^ \t\n]"); /* don't find same sentence */
if (re_search(-1, SENTEND))
re_search(1, "[ \n\t]+"); /* go to start of sent. */
}
}
command center_line() on reg_tab[ALT('s')] /* center current line */
{
int linelen; /* length of line */
to_begin_line(); /* first remove extra space */
delete_horizontal_space();
to_end_line();
delete_horizontal_space();
linelen = current_column(); /* column at end is length */
to_begin_line();
to_column((margin_right - linelen) / 2); /* indent to here */
}
/* make space break line or not */
command auto_fill_mode()
{
fill_mode = (has_arg? (iter != 0) : !fill_mode);
make_mode();
iter = 1;
}
/* determine where to break current line given right margin */
pick_break(col)
int col;
{
int orig = point, start;
to_begin_line();
start = point;
move_to_column(col); /* find first space before col */
if (!re_search(-1, "[ \t]") || point < start) { /* if none */
point = orig;
return 0;
}
point++;
return 1;
}
command maybe_break_line() on reg_tab[' '], reg_tab['\n']
{
int h, both, origkey = key;
int *spot;
if (fill_mode) {
spot = alloc_spot();
h = current_column() + 1;
both = (h > margin_right && pick_break(margin_right));
if (h >= margin_right) {
delete_horizontal_space();
key = '\n';
}
if (both) {
normal_character();
key = origkey;
point = *spot;
}
free_spot(spot);
}
normal_character();
}
command fill_region()
{
int start, *end = alloc_spot();
if (point > (*end = mark))
*end = point, point = mark;
while (point < *end) {
start = point;
if (search(1, "\n\n"))
point--;
if (point > *end)
point = *end;
region_fill(start, point);
re_search(1, "[ \t\n]*"); /* skip paragraph indent */
}
free_spot(end);
}
command fill_paragraph() on reg_tab[ALT('q')]
{
int end, start=point;
iter = 0;
forward_paragraph();
end = point - 1;
backward_paragraph();
re_search(1, "[ \t\n]*"); /* leave leading whitespace intact */
region_fill(point, end);
if (start > size()) start = size();
point = start;
}
/* the following function has been modified such that when given a
numeric argument, it will right justify as well as fill the region */
region_fill(a, b)
int a, b;
{
int start, *end = alloc_spot();
char line[160], startcol;
point = a, *end = b;
if (a > b)
point = b, *end = a;
startcol = current_column();
while (point < *end) {
start = point;
if (line_fill(line, *end, margin_right, startcol, ".?!",
")]'\""))
break;
while (point < *end && isspace(curchar()))
point++;
delete(start, point);
/* geo's additions */
if (has_arg && /* numeric arg was provided */
index(line, '\n')) /* if end reached, no linefeed (?) */
justify(line, margin_right);
/* eventually, we'll do a left margin, too */
stuff(line); /* change these two lines to do left */
startcol = 0; /* margin. also add set-left-margin */
}
free_spot(end);
build_first = 1; /* redisplay hint */
}
justify (line, margin)
char *line, margin;
/* we can assume that line[0] is non-space */
{
char *line_ptr;
line_ptr = line;
while (strlen(line) < margin) {
/* returns immediately if longer than margin */
while (!isspace(*line_ptr))
line_ptr++;
while (isspace(*line_ptr) && *line_ptr != '\n')
line_ptr++;
if (*line_ptr == '\n')
line_ptr = line;
else
one_to_right(line_ptr++);
}
}
one_to_right(ptr)
char *ptr;
/* move characters in string one character to the right replacing *ptr
with a space */
{
char *end_ptr;
end_ptr = ptr;
while (*end_ptr)
end_ptr++;
while (end_ptr >= ptr) {
end_ptr[1] = *end_ptr;
end_ptr--;
}
*ptr = ' ';
}
******************************************************************
local.e follows
******************************************************************
/* Modifications and extensions to the Epsilon editor. Bruce K. Hillyer.
* Portions of this code are covered by the following notice:
*/
/************************************************************************
* "Epsilon", "EEL" and "Lugaru" are trademarks of Lugaru Software, Ltd. *
* *
* Copyright (C) 1985 Lugaru Software Ltd. All rights reserved. *
* *
* Limited permission is hereby granted to reproduce and modify this *
* copyrighted material provided that the resulting code is used only in *
* conjunction with Lugaru products and that this notice is retained in *
* any such reproduction or modification. *
************************************************************************/
#include "eel.h"
/************************************************
* *
* new functions *
* *
************************************************/
/* fill region making indentation equal to that of the first line
*
* The use of this routine is as follows. If you are writing a paragraph
* that is indented, as in a quotation, put a mark at the beginning of the
* first line, go past the last line, and press <escape> followed by <tab>.
* The entire paragraph will be filled, but all lines will be indented to
* match the first line.
*/
command fill_indented() on reg_tab[ALT(CTRL('I'))]
{
fill_region_indent(1);
}
/* find a line before this one that is less indented, line up with it.
*
* The use of this routine is as follows. After typing a line of, say,
* Pascal, press C-M to start a new line indented under the previous
* line (see command indent_next() below). Then you can press A-M to
* unindent one nesting level.
*/
command indent_less() on reg_tab[ALT('m')] {
int orig_column; /* indentation of original line */
int prev_indent; /* indentation of some previous line */
int orig; /* point of original indentation */
int prev_try; /* to guarantee the loop keeps progressing */
to_indentation();
orig = point;
orig_column = current_column();
/* scan backwards for a line that is indented less */
do {
prev_try = point;
to_begin_line();
re_search(-1, "[^ \t\n]"); /* find previous non-blank line */
to_indentation();
prev_indent = current_column();
} while (point < prev_try && prev_indent >= orig_column);
point = orig;
to_column((prev_indent < orig_column) ? prev_indent : 0);
}
/* Go to the next line and then indent under
*/
command indent_next() on reg_tab[CTRL('M')]
{
insert('\n');
indent_under();
}
/* automatically display matching delimiters (toggle)
*/
command display_matching_parens()
{
int display_matching_mode =
(has_arg ? (iter != 0)
: !(mode_keys[')'] == (short) show_matching_delimiter
&& mode_keys[']'] == (short) show_matching_delimiter
&& mode_keys['}'] == (short) show_matching_delimiter
)
);
if (display_matching_mode) {
say("Display matching )]}");
mode_keys[')'] =
mode_keys[']'] =
mode_keys['}'] = (short) show_matching_delimiter;
}
else {
say("No display matching )]}");
mode_keys[')'] =
mode_keys[']'] =
mode_keys['}'] = 0;
}
iter = 1;
}
/* remember the parameters to a query replace so it can be reissued
*
* After leaving a query replace, give C-X % to start query replacing again,
* with the same arguments.
*/
char query_str[80], query_with[80];
int did_query = 0;
command query_replace_again() on cx_tab['%']
{
if (did_query)
string_replace(query_str, query_with, 1, has_arg, 0);
else
say("No previous query-replace.");
}
/* insert the current date and time in the buffer
*/
command insert_time()
{
struct time_info b;
time_and_day(&b);
mark = point;
bprintf("%d-%02d-%d %d:%02d:%02d.%02d",
b.month, b.day, b.year, b.hour, b.minute, b.second, b.hundredth);
}
/* show the current date and time in the echo area
*/
command show_time() on cx_tab['t']
{
struct time_info b;
time_and_day(&b);
say("%d-%02d-%d %d:%02d:%02d.%02d",
b.month, b.day, b.year, b.hour, b.minute, b.second, b.hundredth);
}
/* the next few commands are for scrolling when using two windows. A-Z
* is like A-V, but for the window below the current one. C-Z is like
* C-V, but for the window below. C-A-Z scrolls both the current window
* and the one below.
*/
/* show the previous page in the window below this one
*/
command previous_page_lower() on reg_tab[ALT('z')]
{
window_number++;
previous_page();
window_number--;
}
/* show the next page in the window below this one
*/
command next_page_lower() on reg_tab[CTRL('Z')]
{
window_number++;
next_page();
window_number--;
}
/* show the next page both in this window and the one below this
*/
command next_page_both() on reg_tab[ALT(CTRL('Z'))]
{
window_number++;
next_page();
window_number--;
next_page();
}
/* split this window and find a file in the one below this
*/
command split_and_find() on cx_tab['4']
{
window_split();
find_file();
}
/* allocate some K for process. if there is an argument, reserve that
* percent of the remaining memory for process. if no argument, split memory
* in the default way.
*
* The point of this command is as follows. I normally have the Epsilon
* environment variable set as: set epsilon=-m1, so that all of memory is
* reserved for editing. (I.e., so that Epsilon doesn't start swapping
* sooner than absolutely necessary.) If I want to see how much memory
* Epsilon is using, I give C-U 0 F2 process-mem <cr>. If I want to reserve
* 200K for the process buffer, I give C-U 200 F2 process-mem <cr>.
*/
command process_mem()
{
if (has_arg) {
if (iter < 1 || iter > 500)
say("use argument from 1 to 500 (Kbytes for process)");
else {
maxmem = minmem = availmem - 1024 * iter;
if (maxmem < mem_in_use + 30000)
maxmem = minmem = mem_in_use + 30000;
}
} else {
minmem = availmem - 200000; /* Epsilon uses remaining memory */
if (minmem < mem_in_use + 30000) /* make sure we have */
minmem = mem_in_use + 30000; /* 30k left for buffers */
if (availmem > 300000) /* if plenty, save some memory for process */
maxmem = minmem;
}
say("in-use %d avail %d epsilon %d process %d",
mem_in_use, availmem, maxmem, availmem - maxmem);
iter = 1;
}
/* put mark at the beginning of the buffer, and point at the end. Useful for
* killing the entire buffer, (say for inclusion in another).
*/
command mark_whole_buffer() on cx_tab['h']
{
mark = 0;
point = size();
}
/************************************************
* *
* local modifications of functions *
* *
************************************************/
/* basic.e */
command goto_beginning() on reg_tab[ALT('<')], reg_tab[NUMCTRL(NUMDIGIT(7))]
{
/***/ mark = point;
point = 0;
}
command goto_end() on reg_tab[ALT('>')], reg_tab[NUMCTRL(NUMDIGIT(1))]
{
/***/ mark = point;
point = size();
}
/* files.e */
command visit_file() on cx_tab[CTRL('V')]
/* if no file name is given, try to visit a file with the same name as
* the buffer name.
*/
{
char tmp[FNAMELEN];
char resp[80];
iter = 0;
get_file(tmp, "Visit file: ");
if (tmp[0] == '\0')
/***/ if (!filename || *filename == '\0') {
/***/ strcpy(tmp, bufname);
/***/ }
else
strcpy(tmp, filename);
if (!has_arg && modified) { /* buffer need to be saved? */
get_string(resp, "Save buffer? [y]");
if (toupper(*resp) != 'N')
save_file();
}
read_file(tmp);
}
command show_point() on cx_tab['=']
{
/***/ say("Column=%d, point=%d, size=%d, chr=0x%x (%d)",
/***/ current_column(), point, size(), curchar(), curchar());
}
/* format.e */
command maybe_break_line() on reg_tab[' '], reg_tab['\n']
{
int h;
int *spot;
if (fill_mode)
if ((h = current_column() + 1) > margin_right) {
spot = alloc_spot();
pick_break(margin_right);
delete_horizontal_space();
insert('\n');
point = *spot;
free_spot(spot);
/***/ if (key == '\n') return;
} else if (h == margin_right && isspace(key)) {
delete_horizontal_space();
key = '\n'; /* right at break */
}
normal_character();
}
/* fill region with no indentation (except whatever is on first line
*/
command fill_region()
{
/***/ fill_region_indent(0);
}
fill_region_indent(indented)
int indented;
{
int start, *end = alloc_spot();
int indentation;
if (point > (*end = mark))
*end = point, point = mark;
/***/ to_begin_line();
/***/ re_search(1, "[ \t\n]*"); /* determine indentation */
/***/ indentation = (indented ? current_column() : 0);
while (point < *end) {
start = point;
if (search(1, "\n\n"))
point--;
if (point > *end)
point = *end;
/***/ if (character(point-1) == '\n')
/***/ point--;
/***/ region_fill_ind(start, point, indentation);
re_search(1, "[ \t\n]*"); /* skip paragraph indent */
}
free_spot(end);
}
command fill_paragraph() on reg_tab[ALT('q')]
{
int end, start=point;
iter = 0;
forward_paragraph();
end = point - 1;
backward_paragraph();
re_search(1, "[ \t\n]*"); /* leave leading whitespace intact */
/***/ region_fill_ind(point, end, 0);
if (start > size()) start = size();
point = start;
}
region_fill_ind(a, b, lmargin)
int a, b, lmargin;
{
/* leave two spaces after ':' when filling, and indent each line by the
* amount specified as lmargin
*/
int start, *end = alloc_spot();
char line[160];
int startcol;
point = a, *end = b;
if (a > b)
point = b, *end = a;
startcol = current_column();
while (point < *end) {
start = point;
/***/ if (line_fill(line, *end, margin_right, startcol, ".?:!",
")]'\""))
break;
while (point < *end && isspace(curchar()))
point++;
delete(start, point);
/***/ to_column(startcol);
stuff(line);
/***/ startcol = lmargin;
}
free_spot(end);
build_first = 1; /* redisplay hint */
}
/* proc.e */
command start_process_split() on cx_tab[CTRL('M')]
{
window_split();
start_process();
}
/* prog.e */
show_line() /* display point for a moment, then restore */
{
/* delay a bit longer when showing a matching delimiter.
*/
int oldstart = window_start;
int time;
maybe_refresh();
/***/ time = (window_start == oldstart) ? 8 : 25;
if (has_arg && iter > 0)
time = iter;
pause(time);
window_start = oldstart;
build_first = 1;
}
/* search.e */
/* general replace routine */
gen_replace(query, regex)
int query;
{
/* save query replace arguments for use by query_replace_again()
*/
char msg[80], str[80], with[80];
iter = 0;
sprintf(msg, "%s%seplace string: ",
regex ? "R-E " : has_arg ? "Word " : "",
query? "Query r": "R");
get_string(str, msg);
if (*str) {
get_string(with, "with: ");
/***/ if (query) {
/***/ did_query = 1;
/***/ strcpy(query_str, str);
/***/ strcpy(query_with, with);
/***/ }
string_replace(str, with, query, has_arg, regex);
}
}
/* window.e */
int move_by()
{
/* leave just one line of overlap on C-V
*/
/***/ int n = window_size - 1;
/***/ if (n < 1)
/***/ n = 1;
return n;
}
#define BUFSIZE 100
command compare_windows()
{
/* if one buffer has more characters than the other, leave the cursor
* in the window with the extra characters.
*/
char buf1[BUFSIZE], buf2[BUFSIZE];
int max, end, i;
for (;;) {
check_abort();
max = BUFSIZE - 1;
if (point + max > size())
max = size() - point;
grab(point, point + max, buf1);
window_number++;
if (point + max > size())
max = size() - point;
grab(point, point + max, buf2);
if (strncmp(buf1, buf2, max) || strlen(buf1) < max) {
for (i = 0; i < max; i++) /* find difference */
if (buf1[i] != buf2[i]) {
say("Difference found.");
point += i;
window_number--;
point += i;
return;
}
}
point += max;
end = point >= size();
window_number--;
point += max;
if (end && point >= size()) {
say("No difference.");
return;
} else if (end || point >= size()) {
say("Extra characters.");
/***/ if (point >= size())
window_number++; /* show the longer one */
return;
}
}
}
/************************************************
* *
* set local default values and bindings *
* *
************************************************/
/* .mss .txt and .to files should start in auto-fill mode
*/
suffix_mss() { do_fill(); }
suffix_txt() { do_fill(); }
suffix_to() { do_fill(); }
do_fill()
{
fill_mode = 1;
make_mode();
}
/* this should probably be replaced by the code in lispmode.e
*/
keytable lsp_tab; /* to keep the key bindings for lisp mode (just
display-matching-parens at present) */
suffix_lsp()
{
mode_keys = lsp_tab;
major_mode = strsave("LSP");
make_mode();
}
/* declare routines that are defined elsewhere */
command goto_line();
command delete_hacking_tabs();
command scroll_down();
command scroll_up();
command compare_windows();
when_loading()
{
/* set desired defaults */
use_default = 1;
margin_right = 78;
num_kbufs = 4;
use_default = 0;
/* supply desired bindings */
cx_tab['g'] = (short) goto_line;
reg_tab[ALT(CTRL('J'))] = (short) to_indentation;
reg_tab[CTRL('H')] = (short) delete_hacking_tabs;
reg_tab[NUMDIGIT(2)] = (short) scroll_down;
reg_tab[NUMDIGIT(8)] = (short) scroll_up;
reg_tab[CTRL('I')] = (short) indent_under;
reg_tab[ALT(CTRL('C'))] = (short) compare_windows;
lsp_tab[')'] =
lsp_tab[']'] =
lsp_tab['}'] = (short) show_matching_delimiter;
/* for IBM-AT, swap the <esc> and <backquote> keys */
/* keytran[NUMCTRL(GREYESC)] = keytran[GREYESC] = '`';
keytran[NUMALT(GREYESC)] = ALT('`');
keytran['`'] = ESC; */
}
******************************************************************
local.hlp follows
******************************************************************
Fill-indented (<esc><tab>) fills the region, making the indentation equal to
that of the first line. This is useful, for instance, when editing a
quotation that is indented from the left margin.
Indent-next (C-M) goes to the next line and then indents under. This is
useful for writing programs in languages such as Pascal.
Indent-less (A-M) decreases the indentation of the current line to match some
previous line. The use of this routine is as follows. After typing a line
of, say, Pascal, press C-M to start a new line indented under the previous
line (command indent-next above). Then you can press A-M to unindent one
nesting level (for example, when leaving a BEGIN-END block). Each A-M will
unindent another level.
Display-matching-parens is a command to toggle the behavior of the closing
delimiters ) ] } to control whether Epsilon automatically shows the
matching open delimiter.
Query-replace (A-%) remembers its arguments. Query-replace-again (C-X %)
restarts query-replace with the previous arguments.
Insert-time inserts the current date and time into the buffer at point.
Show-time (C-X t) shows the current date and time in the echo area.
The next few commands are for scrolling when using two windows.
Next-page-lower (C-Z) is like next-page (C-V), but it controls the window
below the current one.
Previous-page-lower (A-Z) is like previous-page (A-V), but for the window
below the current one.
Next-page-both (C-A-Z) shows the next page in both the current window and
the one below.
Split-and-find (C-X 4) splits the current window into two, and finds a file
in the lower one.
Process-mem shows the amount of memory reserved for the process buffer and
used by currently used by Epsilon. Give an argument of 0 to see this
information. A positive argument tries to set the process buffer allocation
to that number of K. This requires some explanation. I normally set the
Epsilon environment variable set epsilon=-m1 to allocate no space for the
process buffer, so that when editing large files, Epsilon doesn't start
swapping until absolutely necessary. If I intend to use the process buffer,
say for compiling, I give Epsilon a command like C-U 250 A-X proc<esc>
which reserves 250K for the process buffer. This command isn't fully
protected: you can probably confuse Epsilon by giving unusual arguments.
Mark-whole-buffer (C-X h) puts mark at the beginning of the buffer, and point
at the end. It is useful for killing the entire buffer, say for inclusion in
another.
Goto-beginning (A-<) and goto-end (A->) leave a mark behind.
Visit-file (C-X C-V) uses the name of the buffer if no file name is specified.
Show-point (C-X =) also shows the decimal and octal values of the character
at point.
Next-page (C-V) and Previous-page (A-V) leave just one line of overlap.
I also include several other miscellaneous modifications and personal
preferences for key bindings. For example, the upward and downward arrows
on the keypad cause the screen to scroll in the corresponding direction.
******************************************************************
lispmode.e follows
******************************************************************
/************************************************************************
* "Epsilon", "EEL" and "Lugaru" are trademarks of Lugaru Software, Ltd. *
* *
* Copyright (C) 1985 Lugaru Software Ltd. All rights reserved. *
* *
* Limited permission is hereby granted to reproduce and modify this *
* copyrighted material provided that the resulting code is used only in *
* conjunction with Lugaru products and that this notice is retained in *
* any such reproduction or modification. *
************************************************************************/
/************************************************************************
* Portions of this file
* Copyright (C) 1985 Robert C. Pettengill
* Permission is granted to reproduce and use this copyrighted material
* for any purpose whatsoever.
************************************************************************/
#include "eel.h"
#define LEFTD '('
#define RIGHTD ')'
#define LISP_INDENT 991 /* this_cmd code for lisp-indent command */
/*
Automatic indentation for Lisp code.
*/
command delete_hacking_tabs();
keytable lisp_tab; /* key table for lisp mode */
int lisp_comment_col = 40; /* column for lisp comments to begin */
/* by default, the indenting levels are 2 spaces apart */
#define INCR 2
/* find the column position of the ( in the current level
and return that pos + INCR
*/
lisp_compute_indent()
{
int ind = 0; /* indentation to use */
int orig = point;
if (lisp_move_level(-1, RIGHTD, LEFTD) > 0)
ind = current_column() + INCR;
else
ind = 0;
point = orig;
return ind;
}
/* Indenter called on a new line */
command lisp_indenter()
{
to_indentation(); /* this seems to be needed, why? */
to_column(lisp_compute_indent());
}
/* Indent an existing line of lisp code. If we're not in this line's
indentation, though, or our new indentation matches the old,
just insert a tab.
*/
command lisp_indent() on lisp_tab['\t']
{
int orig = point;
int orig_column = current_column();
to_indentation();
if (orig_column > current_column()) { /* if not in indentation */
point = orig;
insert('\t'); /* insert a tab */
} else if (prev_cmd == LISP_INDENT) /* repeated, make bigger */
to_column(orig_column + INCR);
else
to_column(lisp_compute_indent());
this_cmd = LISP_INDENT;
}
command lisp_comment() on lisp_tab[ALT(';')]
{
end_of_line();
if (lisp_comment_col > (current_column() + 1))
to_column(lisp_comment_col);
else insert(' ');
insert(';');
}
command lisp_def_begin() on lisp_tab[ALT(CTRL('A'))]
{
re_search(-1,"^%(def");
}
command lisp_def_end() on lisp_tab[ALT(CTRL('E'))]
{
int orig = point;
lisp_def_begin();
forward_level();
}
command lisp_up_level() on lisp_tab[ALT(CTRL('U'))]
{
lisp_move_level(-1,RIGHTD,LEFTD);
}
command lisp_down_level() on lisp_tab[ALT(CTRL('D'))]
{
lisp_move_level(1,LEFTD,RIGHTD); /* not quite right */
}
/*
Move in direction dir to find a parenthesis that would
match first at point. Return 1 on success. Otherwise go to
starting point, and return 0.
*/
lisp_move_level(dir, first, second)
char first, second;
{
int orig = point;
int level = -dir; /* hack for up & down level */
char pat[6]; /* temporary pattern */
sprintf(pat, "[%c%c]", first, second);
while (re_search(dir, pat)) { /* look for either first or second */
if (character(point - (dir > 0)) == first)
level++;
else
level--;
if (level == 0) /* when we return to same level, done */
return 1;
}
point = orig;
return 0;
}
command lisp_mode()
{
mode_keys = lisp_tab; /* use these keys */
lisp_tab[')'] = lisp_tab[']'] = (short) show_matching_delimiter;
lisp_tab[CTRL('H')] = (short) delete_hacking_tabs;
major_mode = strsave("Lisp");
make_mode();
indenter = lisp_indenter;
auto_indent = 1;
margin_right = 80;
}
/* make this the default mode for .l, and .lsp files */
suffix_l() { lisp_mode(); }
suffix_lsp() { lisp_mode(); }
******************************************************************
krypt.e follows
******************************************************************
/* -*- Mode: C -*-
*
* File: [ZonkerPC]c:\ep\lib\krypt.e
* Author: rcp
* Date: 16-Nov-1986 12:34:25
*
* Description: file encryption for epsilon based on
*
* Crypt: Encryption routines for MicroEMACS
* written by Dana Hoggatt and Daniel Lawrence
*/
#include "eel.h"
int keyy; /* 29 bit encipherment key */
int salt; /* salt to spice up key with */
command krypt()
{
char pw[24];
int pos = 0, last = size(), c, n = 0;
keyy = 0; /* 29 bit encipherment key */
salt = 0; /* salt to spice up key with */
get_string(pw, "Enter password: ");
for(n=0; n < strlen(pw); n++)
pw[n] = crypt(pw[n]);
for (; pos < last; pos++) {
c = character(pos);
c = crypt(c);
replace(pos,c);
}
}
/**********
*
* crypt - in place encryption/decryption of a buffer
*
* (C) Copyright 1986, Dana L. Hoggatt
* 1216, Beck Lane, Lafayette, IN
*
* When consulting directly with the author of this routine,
* please refer to this routine as the "DLH-POLY-86-B CIPHER".
*
* This routine was written for Dan Lawrence, for use in V3.8 of
* MICRO-emacs, a public domain text/program editor.
*
* I kept the following goals in mind when preparing this function:
*
* 1. All printable characters were to be encrypted back
* into the printable range, control characters and
* high-bit characters were to remain unaffected. this
* way, encrypted would still be just as cheap to
* transmit down a 7-bit data path as they were before.
*
* 2. The encryption had to be portable. The encrypted
* file from one computer should be able to be decrypted
* on another computer.
*
* 3. The encryption had to be inexpensive, both in terms
* of speed and space.
*
* 4. The system needed to be secure against all but the
* most determined of attackers.
*
* ... Decryption is totally isomorphic, and is performed
* in the same manner by the same routine.
*
* For the interest of cryptologists, at the heart of this
* function is a Beaufort Cipher. The cipher alphabet is the
* range of printable characters (' ' to '~'), all "control"
* and "high-bit" characters are left unaltered.
*
* The key is a variant autokey, derived from a wieghted sum
* of all the previous clear text and cipher text. A counter
* is used as salt to obiterate any simple cyclic behavior
* from the clear text, and key feedback is used to assure
* that the entire message is based on the original key,
* preventing attacks on the last part of the message as if
* it were a pure autokey system.
*
* Overall security of encrypted data depends upon three
* factors: the fundamental cryptographic system must be
* difficult to compromise; exhaustive searching of the key
* space must be computationally expensive; keys and plaintext
* must remain out of sight. This system satisfies this set
* of conditions to within the degree desired for Micro-EMACS.
*
* Though direct methods of attack (against systems such as
* this) do exist, they are not well known and will consume
* considerable amounts of computing time. An exhaustive
* search requires over a billion investigations, on average.
*
* The choice, entry, storage, manipulation, alteration,
* protection and security of the keys themselves are the
* responsiblity of the user.
*
**********/
/* [ZonkerPC]c:\ep\lib\krypt.e, 22-Nov-1986 15:19:46, Edit by rcp
* hacked to work for epsilon - changed crypt to work a character at
* a time.
*/
crypt(cc)
int cc; /* current character being considered */
{
int nc;
/* only encipher printable characters */
if ((cc >= ' ') && (cc <= '~')) {
/** If the upper bit (bit 29) is set, feed it back into the key. This
assures us that the starting key affects the entire message. **/
keyy &= 0x1FFFFFFFL; /* strip off overflow */
if (keyy & 0x10000000L) {
keyy ^= 0x0040A001L; /* feedback */
}
/** Down-bias the character, perform a Beaufort encipherment, and
up-bias the character again. We want key to be positive
so that the left shift here will be more portable and the
mod95() faster **/
nc = mod95((int)(keyy % 95) - (cc - ' ')) + ' ';
/** the salt will spice up the key a little bit, helping to obscure
any patterns in the clear text, particularly when all the
characters (or long sequences of them) are the same. We do
not want the salt to go negative, or it will affect the key
too radically. It is always a good idea to chop off cyclics
to prime values. **/
if (++salt >= 20857) { /* prime modulus */
salt = 0;
}
/** our autokey (a special case of the running key) is being
generated by a wieghted checksum of clear text, cipher
text, and salt. **/
keyy = keyy + keyy + nc + cc + salt;
return(nc);
}
else
return(cc);
}
mod95(val)
int val;
{
/* The mathematical MOD does not match the computer MOD */
/* Yes, what I do here may look strange, but it gets the
job done, and portably at that. */
while (val >= 9500)
val -= 9500;
while (val >= 950)
val -= 950;
while (val >= 95)
val -= 95;
while (val < 0)
val += 95;
return (val);
}
******************************************************************
kmode.e follows
******************************************************************
/************************************************************************
Most of this is copyright (C) 1986, Bob Knight. The rest is copyrighted
by Lugaru Software, as noted in the following copyright blurb.
This material may be used and distributed freely, provided that it is not
used as part of a product to be sold for profit.
The ideas for most of the commands implemented here come primarily
from TOPS-20 EMACS, by Richard M. Stallman and others.
************************************************************************/
/************************************************************************
* "Epsilon", "EEL" and "Lugaru" are trademarks of Lugaru Software, Ltd. *
* *
* Copyright (C) 1985 Lugaru Software Ltd. All rights reserved. *
* *
* Limited permission is hereby granted to reproduce and modify this *
* copyrighted material provided that the resulting code is used only in *
* conjunction with Lugaru products and that this notice is retained in *
* any such reproduction or modification. *
************************************************************************/
/*
This file contains the following commands:
lowercase_region - lowercases the current region, bound to C-X C-L
capitalize_region - uppercases the current region, bound to C-X C-U
set_comment_strings - set the begin-comment and end-comment strings
set_comment_column - set the default column for beginning comments, bound
to C-X ;
indent_for_comment - indent to the comment column on the current line, bound
to M-;
up_comment_line - go to the previous line and indent to the comment column,
bound to M-P
down_comment_line - go to the next line and indent to the comment column,
bound to M-N
revert_file - restore the current buffer from the associated disk file, bound
to C-X C-R
date_edit - insert an "edited-by" line at the beginning of the file, bound to
M-Z
make - spawn a process and issue a make command, bound to C-X C-Q
connect_to_directory - connect to a named directory
count_lines_region - count the number of lines in the current region, bound to
M-=
search_for_string_in_files - perform a re_search of the named files
In addition, comment_start and comment_end are set for various extensions of
files as they are visited.
*/
#include "eel.h"
char comment_start[80] = "; ", comment_end[80] = "", make_string[80] = "";
int comment_column = 40;
/* lowercase the region */
command lowercase_region() on cx_tab[CTRL('l')]
{
do_region_case(1);
}
/* capitalize the region */
command capitalize_region() on cx_tab[CTRL('u')]
{
do_region_case(0);
}
/* Routine for region case converts */
do_region_case(do_lower)
{
int c, from = point, to = mark, temp;
char resp[80];
if (from > to)
temp = from, from = to, to = temp;
if ((to-from)>250)
get_string(resp, "Do you really want to case convert such a large region? [y]");
else *resp = 'Y';
if (toupper(*resp) != 'N') {
for (; from <= to; from++) {
check_abort();
c = character(from);
replace(from, do_lower ? tolower(c) : toupper(c));
}
}
}
/* Set comment start and comment end strings, initially "; " */
command set_comment_strings()
{
char msg[80], tmp[80];
sprintf(msg,"Comment start [%s]: ",comment_start);
get_string(tmp,msg);
if(*tmp)
strcpy(comment_start,tmp);
get_string(tmp,"Comment end: ");
strcpy(comment_end,tmp);
say("Comment start = %s, comment end = %s",
comment_start,comment_end);
}
/* Set comment column */
command set_comment_column() on cx_tab[';']
{
comment_column = (has_arg ? iter : 40);
iter = 0;
say("Comment column = %d",comment_column);
}
/* Indent for comment */
command indent_for_comment() on reg_tab[ALT(';')]
{
do_comment();
}
/* Up comment line */
command up_comment_line() on reg_tab[ALT('p')]
{
maybe_flush_comment_line();
point = prev_screen_line(1);
do_comment();
}
/* Down comment line */
command down_comment_line() on reg_tab[ALT('n')]
{
maybe_flush_comment_line();
point = next_screen_line(1);
do_comment();
}
/* maybe_flush_comment_line - flush a line if the only thing on it is a
comment start followed by comment end. flush is a misnomer, we simply
flush the comment start and comment end */
maybe_flush_comment_line()
{
int to, from;
char foo[80], bar[80];
to_end_line();
to = point;
to_begin_line();
from = point;
for (;point < to;point++) {
if ((curchar() != ' ') & (curchar() != '\t')) break;
}
if (curchar() != '\n') {
strcpy(bar,comment_start); strcat(bar,comment_end);
strcat(bar,"\n");
grab(point,point+strlen(bar),foo);
if (!strncmp(foo,bar,strlen(bar)))
delete(from,point+strlen(bar)-1);
}
}
/* do_comment - routine for emplacing comments on the current line */
do_comment()
{
int to, found, start, from;
char foo[80];
to_end_line();
to = point;
to_begin_line();
found = 0;
start = point;
for (; point < to; point++) {
grab(point,point+strlen(comment_start),foo);
if (!strncmp(foo,comment_start,strlen(comment_start))) {
found = 1;
break;
}
}
if (found==1) {
if (current_column() < comment_column) {
to_column(comment_column);
} else {
if (current_column() > comment_column) {
from = point;
for (point--;point >= start;point--) {
if ((curchar() != ' ') &
(curchar() != '\t')) break;
}
point++;
delete(point,from);
if (current_column() > comment_column)
insert(' ');
else to_column(comment_column);
}
}
point = point + strlen(comment_start);
} else {
if (current_column() < comment_column)
to_column(comment_column);
if (current_column() > comment_column)
insert(' ');
stuff(comment_start); stuff(comment_end);
point = point - strlen(comment_end);
}
}
/* Revert file - restore the current buffer from its associated disk file */
command revert_file() on cx_tab[CTRL('R')]
{
char resp[80];
int old_point;
if(!strcmp(bufname,"process"))
say("Can't revert process");
else {
get_string(resp, "Restore file from disk? [n]");
if (toupper(*resp) == 'Y') {
old_point = point;
read_file(filename);
point = old_point;
}
}
}
/* Date edit - insert a line at the start of the file with date/time, etc. */
command date_edit() on reg_tab[ALT('z')]
{
char edit_string[100], month_string[6];
struct time_info date_time;
point = 0;
insert('\n');
point = 0;
time_and_day(&date_time);
switch (date_time.month) {
case 1:
strcpy(month_string,"Jan");
break;
case 2:
strcpy(month_string,"Feb");
break;
case 3:
strcpy(month_string,"Mar");
break;
case 4:
strcpy(month_string,"Apr");
break;
case 5:
strcpy(month_string,"May");
break;
case 6:
strcpy(month_string,"Jun");
break;
case 7:
strcpy(month_string,"Jul");
break;
case 8:
strcpy(month_string,"Aug");
break;
case 9:
strcpy(month_string,"Sep");
break;
case 10:
strcpy(month_string,"Oct");
break;
case 11:
strcpy(month_string,"Nov");
break;
case 12:
strcpy(month_string,"Dec");
break;
}
sprintf(edit_string,
"%s[%s]%s, %2d-%s-%04d %2d:%02d:%02d, Edit by %s%s\n%s%s",
comment_start, getenv("sysname"), filename, date_time.day,
month_string, date_time.year, date_time.hour,
date_time.minute, date_time.second, getenv("user"),
comment_end, comment_start, comment_end);
stuff(edit_string);
point = point - strlen(comment_end);
}
/* Comment string sets for various suffixes
Eventually to be expanded to mode-type editing */
suffix_asm()
{
strcpy(comment_start,"; "); strcpy(comment_end,"");
}
suffix_plm()
{
strcpy(comment_start,"/* "); strcpy(comment_end," */");
}
suffix_pas()
{
strcpy(comment_start,"(* "); strcpy(comment_end," *)");
}
suffix_c()
{
strcpy(comment_start,"/* "); strcpy(comment_end," */");
c_mode();
}
suffix_h()
{
strcpy(comment_start,"/* "); strcpy(comment_end," */");
c_mode();
}
suffix_e()
{
strcpy(comment_start,"/* "); strcpy(comment_end," */");
c_mode();
}
/* Don't look at me! I didn't choose BASIC for the MicroSCADA package! */
suffix_bas()
{
strcpy(comment_start,"' "); strcpy(comment_end,"");
}
/* make - create a process window, if no present, then fire up a make */
command make() on cx_tab[CTRL('Q')]
{
int error;
char foo[80],tmp[80];
sprintf(foo,"Enter filename to make [%s]: ",make_string);
get_string(tmp,foo);
if (*tmp)
strcpy(make_string,tmp);
if (*make_string) {
error = 0;
if (!another) {
zap("process");
error = concur_shell(getenv("COMSPEC"),tmp);
} else {
say("A process is already running.");
}
if (error) {
say("Couldn't exec");
} else {
to_buffer("process");
point = size();
sprintf(tmp,"make %s\n",make_string);
stuff(tmp);
}
} else {
say("Null make string not allowed");
}
}
/* connect_to_directory */
command connect_to_directory()
{
char dir[80];
get_string(dir,"Connect to directory [\\]: ");
if (!*dir)
strcpy(dir,"\\");
if (chdir(dir))
say("Unable to connect to %s",dir);
else {
if (another) {
to_buffer("process");
point = size();
insert('\n');
to_buffer(previous_buffer);
}
}
}
/* count_lines_region */
command count_lines_region() on reg_tab[ALT('=')]
{
int curpoint = point, nlines = 1, temp;
if (point > mark)
temp = point, point = mark, mark = temp;
for (;point <= mark;) {
check_abort();
if (!nl_forward())
break;
if (point <= mark)
nlines++;
}
say("%d",nlines);
point = curpoint;
}
/* search_for_string_in_files -
search the current directory for a given string */
command search_for_string_in_files()
{
char str[80], files[80], tmp[80];
get_string(str,"Search for string: ");
if(*str) {
get_string(files,"in files: ");
fondle_buffers();
to_buffer("found_buffer");
sprintf(tmp,"String search for '%s' in files %s\n\n",
str,files);
stuff(tmp);
to_buffer("filename_buffer");
if(!do_dired(files)) {
do_file_search(str);
to_buffer("search_buffer");
modified = 0;
to_buffer("filename_buffer");
modified = 0;
to_buffer("found_buffer");
delete_buffer("search_buffer");
delete_buffer("filename_buffer");
point=size();
stuff("Done.\n");
modified = 0;
} else
say("File(s) not found");
} else
say("Null string invalid");
}
fondle_buffers()
{
zap("filename_buffer");
zap("search_buffer");
create("found_buffer");
}
do_file_search(str)
char *str;
{
int from, opoint;
char tmp[80], tmp2[80], filename[80];
for(point=0;point < size();) {
check_abort();
if ((!nl_forward()) | (point >= size()))
break;
move_to_column(16);
grab(point,point+4,tmp);
if(strncmp(tmp,"<DIR>",5)) { /* If no match, not directory */
move_to_column(2);
from = point;
for(;curchar() != ' ';point++);
grab(from,point--,filename);
to_buffer("found_buffer");
sprintf(tmp,"Searching %s\n",filename);
stuff(tmp);
to_buffer("search_buffer");
file_read(filename,1);
do {
check_abort();
if (re_search(1,str)) {
opoint = point;
to_begin_line();
from = point;
to_end_line();
grab(from,point,tmp);
sprintf(tmp2,"%6d: %s\n",opoint,tmp);
to_buffer("found_buffer");
stuff(tmp2);
to_buffer("search_buffer");
point = opoint++;
}
} while (point<size());
}
to_buffer("filename_buffer");
}
}
******************************************************************
tex.e follows
******************************************************************
/********** Documentation to be inserted in file "edoc" ***********
show-matching-dollar Insert $ and show matching $ or $$ in TeX mode.
Calls normal-character to insert the key $, then shows the
matching $ that delimits math-mode or displayed material.
tex-mode Show delimiters for TeX code and fill.
This command puts the current buffer in TeX mode and
is invoked automatically for a file with extension .tex .
([{ are flashed using show-matching-delimiter(). Dollar signs
$ or $$ invoke show-matching-dollar(). fill-mode is set on, and
fill-column is set to 72. The mode line says TeX Fill.
*********** End of documentation **********/
----- Gary R. Smith (smith#gary@b.mfenet@nmfecc.arpa)
/****************** Beginning of file "tex.e" ******************/
#include "eel.h"
/*
Show delimiters for TeX code and fill.
Written by Gary R. Smith in Oct. 1986.
Fill mode is enabled automatically and the fill column set to 72.
When one of )]} is typed, the matching ([{ is flashed, by binding the
former keys to show-matching-delimiter().
Matching dollar signs, which indicate math-mode and displayed
material, are searched for using show-matching-dollar(). That
function performs searches that are limited to a small portion of
text by these assumptions about the TeX code: (a) new paragraphs do
not begin in $...$ or $$...$$, and (b) $...$ is not nested within
$$...$$, or vice versa. The following searches are made:
(1) If the $ just typed is preceded by another $, search backwards,
counting occurrences of $$, until a solitary $ or the beginning of
the buffer or the beginning of a paragraph is found (\n\n, i.e., a
blank line, or TeX command \par). If the $$ just typed is the
first, third, fifth, etc., occurrence, then flash the first of the
matching $$.
(2) A solitary $ causes a search backwards, counting occurrences of
solitary $, until $$ or the beginning of the buffer or the
beginning of a paragraph is found. If the $ just typed is the
first, third, fifth, etc., occurrence, then flash the first of the
matching $.
*/
buffer int tex_mode_on = 0; /* Are we in TeX mode? */
keytable tex_tab; /* Key table for TeX mode */
command show_matching_dollar() on tex_tab['$']
{
int orig;
normal_character();
iter = 0;
say("");
orig = point;
if (dollar_match()) show_line(); /* Function from prog.e */
point = orig;
return;
}
dollar_match() /* Return 1 if backwards search finds matching $,
return 0 otherwise */
{
int double = 0;
int count = 0;
int loc; /* Will hold location of match, if found */
if (point < 3) return 0;
point -= 2;
if (curchar() == '$') double = 1; /* $$ just typed */
else point++;
while (re_search(-1, "$|\n\n|\\par")) { /* To beginning or break */
if (curchar() == '$') { /* Found $ */
if (double) { /* Trying to match $$ */
if (point > 0 && character(point-1) == '$') {
/* Yes $$ */
point--;
if (!count++) loc = point;
/* Count, and save loc if first */
}
else break; /* Found solitary $ */
}
else { /* Trying to match solitary $ */
if (!point) {
if (!count++) loc = 0;
}
else if (character(point-1) != '$') {
/* Found $ */
if (!count++) loc = point;
/* Count, and save loc if first */
}
else break; /* Found $$ */
}
}
else break; /* Found beginning of paragraph */
}
point = loc;
return count % 2;
}
command tex_mode()
{
mode_keys = tex_tab; /* Use these keys */
tex_tab[')'] = (short) show_matching_delimiter;
tex_tab[']'] = (short) show_matching_delimiter;
tex_tab['}'] = (short) show_matching_delimiter;
fill_mode = 1;
margin_right = 72;
tex_mode_on = 1;
major_mode = strsave("TeX");
make_mode();
}
/* Make this the default mode for .tex files */
suffix_tex() { tex_mode(); }
/****************** End of file "tex.e" ******************/
******************************************************************
fortran.e follows
******************************************************************
/********** Documentation to be inserted in file "edoc" ***********
for-mode Do automatic indentation of Fortran code.
This command puts the current buffer in Fortran mode and
is invoked automatically for a file with extension .for .
<Enter> runs fortran-indent-line() to insert all necessary tabs
or spaces in the line just typed. tab-size is set to 3. When
the buffer is written, you are asked if it should be untabified.
Matching ('s are shown when typed. fill-mode is set on, and
fill-column is set to 72, so excess space-delimited entities
move to the next line. The mode line says Fortran Fill.
fortran-indent-line Indents previous line of Fortran code.
Determines where whitespace should be adjusted to put statement
numbers in the required columns and to show the block structure of the
code. Does nothing to full-line or on-line comments. If the state-
ment before the one just typed was incomplete, a continuation is made.
if-then-else-elseif-endif blocks are indented to show code structure.
do-continue blocks are also, if there is a continue for each do.
A do-loop without a continue will cause improper indentation of the
following statement, unless the loop is only two lines long.
fortran-indent-region Indent a region of Fortran code.
Indents all lines that terminate between point and mark using
fortran-indent-line().
*********** End of documentation **********/
/*----- Gary R. Smith (smith#gary@b.mfenet@nmfecc.arpa)*/
/****************** Beginning of file "fortran.e" ******************/
#include "eel.h"
/*
Automatic indentation for Fortran code.
Written by Gary R. Smith in Sept. 1986.
Indentation occurs after each Fortran statement is typed, or when
the command fortran-indent-region is given. Entering of Fortran code
is speeded up, because the programmer can let Epsilon insert the spaces
needed to produce clearly indented code.
Indentation involves scanning a statement and the lines preceding it
to determine where whitespace should be adjusted to put statement
numbers in the required columns and to show the block structure of the
code. The following steps occur:
1. If the line begins with a comment character, nothing is done.
2. If the previous statement was incomplete (ends in one of "=+-*,(" ),
the present line is indented as a continuation and the remaining steps
are omitted.
3. If the line begins with a number (string of digits), indentation
and right justification occurs for a statement number.
4. For lines that are neither comments nor continuations, the presence
of if-then-else-elseif-endif or do-continue blocks is detected by
examination of the first strings (after statement numbers, if any) in both
the previous and present statements. An indentation level found from the
previous statement is used for the present line except in these cases:
(a) Presence of "if-then", "else", "elseif-then", or "do" in the previous
statement, increments (by tab_size) the indentation level for the
present line.
(b) Presence of "else", "elseif-then", "endif", or "continue" on the
present line, decrements the indentation level for the present line.
(Note that all "continue"s are treated as if they end do-continue
blocks and may be indented too little if they do not.)
5. If the previous statement begins with a statement number, it ends a
two-line do-loop if the statement before it contains "do" followed by
that statement number. In this case, the indentation level for the
present line is decremented. Only two-line do-loops are detected;
automatic indentation of longer loops occurs only if they end with
"continue".
The previous statement is found by checking the previous line and its
predecessors, skipping blank and empty lines and (both full-line and
on-line) comments, for a line that is not a continuation.
Fill mode is enabled automatically and the fill column set to 73.
Therefore, a space entered past column 72 will cause space-delimited
entities to move to the next line. If the last character remaining
on the long line indicates an incomplete statement, the next line is
made a continuation automatically.
The command fortran-indent-region indents all lines that terminate
between point and mark. The steps described above are performed on all
of the lines. A future improvement would be to minimize time-consuming
searches by remembering the indentation level from one line to the next.
*/
buffer int fortran_mode = 0; /* Are we in fortran mode? */
keytable fortran_tab; /* Key table for fortran mode */
#define FORTRAN_SKIP "(([ \t]*\n)|([ \t]*[!#].*\n))+"
#define FORTRAN_COMMENT "cC!#*"
#define FORTRAN_OP "=+-*,("
#define FORTRAN_CONT '.'
#define MAXWORD 80
#define NBEGWORDS 4
#define NENDWORDS 5
char *beg_word[NBEGWORDS];
char *end_word[NENDWORDS];
command fortran_indent_region() on fortran_tab[ALT(CTRL('\\'))]
{
int temp, *begin;
if (point > mark) { /* If point follows mark, swap */
temp = mark;
mark = point;
point = temp;
}
if (nl_reverse()) /* To begin of line, even if it's first */
point++;
begin = alloc_spot();
*begin = point;
while (point < mark) { /* Indent each line in region */
if (!nl_forward()) break;
fortran_indent_line();
}
mark = *begin; /* Region is just-indented set of lines */
free_spot(begin);
iter = 0;
return;
}
fortran_indent_line()
{
int *orig;
int this_beg, prev_end, prev_indent, prev_cont, prev_stmt;
int stmt_no_len, this_col6;
char key_word[MAXWORD];
int i, cmp_result;
char stmt_no[6], stmt_np[6];
if (point == 0) return; /* Handle first line if indenting region */
this_beg = prev_screen_line(1);
if (index(FORTRAN_COMMENT, character(this_beg))) return;
/* Comment found */
orig = alloc_spot();
*orig = point;
re_search(-1, "[ \t]*\n");
if (point == this_beg) goto exit;
/* Blank or empty line found */
point = this_beg;
prev_end = find_prev_end();
if (prev_end > 0 && stmt_incomp(prev_end)) {
/* Test if stmt is incomplete */
prev_indent = find_indent(prev_end);
prev_cont = check_cont(prev_end); /* 1 if was cont. */
if (check_cont(this_beg)) move_to_column(6);
else make_cont(); /* Make this line a continuation
by replacing cols. 1-6 */
to_column(6 + prev_indent + !prev_cont * tab_size);
/* Replace indentation with same as previous line
+ tab_size if previous stmt not continuation */
goto exit;
}
point = this_beg;
if (stmt_no_len = check_no(stmt_no)) {
to_column(5 - stmt_no_len); /* Right justify stmt no */
point = point + stmt_no_len; /* Point after stmt no */
}
to_column(6); /* Remove whitespace and
put space in col. 6 ( or 1-6 if no stmt no) */
this_col6 = point;
if (prev_end > 0) { /* Test that previous stmt found */
point = prev_end;
prev_indent = find_prev_stmt(stmt_no); /* Find indentation */
if (find_word(1, key_word)) {
/* Word that began previous stmt */
for(i=0; i < NBEGWORDS; ++i) { /* Is it on list? */
cmp_result = strcmp(key_word, beg_word[i]);
if (cmp_result >= 0) break;
}
if (cmp_result == 0 && i == 0) {
/* Is if followed by then? */
point = prev_end;
find_word(-1, key_word);
if (strcmp(key_word, "then"))
cmp_result = 1; /* No */
}
if (!cmp_result) {
prev_indent += tab_size;
goto fin;
}
else {
/* Not beginning of block, check for two-line do-loop */
if (*stmt_no == '\0') goto this;
to_begin_line();
if ((prev_end = find_prev_end()) < 0)
goto this;
find_prev_stmt(stmt_np);
if (find_word(1, key_word)) {
if (strcmp(key_word, "do"))
goto this;
if (check_no(stmt_np) &&
!strcmp(stmt_no, stmt_np)) {
prev_indent -= tab_size;
goto fin;
}
}
else {
key_word_error();
goto exit;
}
}
}
else { /* Apparent error in user type-in */
key_word_error();
goto exit;
}
}
else goto exit; /* Nothing to be done if no previous stmt */
this: point = this_col6;
if (find_word(1, key_word)) { /* Word that begins this stmt */
for(i=0; i < NENDWORDS; ++i) { /* Is it on list? */
cmp_result = strcmp(key_word, end_word[i]);
if (cmp_result >= 0) break;
}
if (!cmp_result) prev_indent -= tab_size;
}
else { /* Apparent error in user type-in */
key_word_error();
goto exit;
}
fin: point = this_col6;
if (prev_indent > 0) insert_to_column(6, 6 + prev_indent);
exit: point = *orig;
free_spot(orig);
return;
}
find_prev_end() /* Move point to last character of previous stmt,
passing comments and whitespace. Return
point if there was a previous statement,
-1 if not */
{
fortran_skip_lines();
re_search(-1, FORTRAN_SKIP); /* Skip to end of stmt */
if (point > 0) return point; /* Last character found */
else return -1; /* No previous stmt */
}
fortran_skip_lines() /* Assumes point is at beginning of a line and
skips back over blank, empty, or comment lines */
{
re_search(-1, "[ \t\n]*"); /* Skip to a line with darkspace */
if (point == 0) return; /* Done if at beginning of file */
while (to_begin_line(), index(FORTRAN_COMMENT, curchar())) {
/* Comment line found */
re_search(-1, "[ \t\n]*");/* Skip to a line with darkspace */
if (point == 0) return;
}
nl_forward(); /* After \n of searchable line */
return;
}
stmt_incomp(loc) /* Check if character before loc indicates an
incomplete stmt. Return nonzero, if incomplete */
int loc;
{
if (loc > 0)
return (index(FORTRAN_OP, character(--loc)) != 0);
else return 0;
}
find_indent(loc) /* Return number of columns of indentation in
the stmt surrounding loc. Point is left
after the end of the indentation */
int loc;
{
point = loc;
move_to_column(6); /* Position point after continuation col. */
re_search(1, "[ \t]*"); /* Move point to first darkspace character */
return current_column() - 6;
}
check_cont(loc) /* Return 1 if the line containing loc has whitespace
in cols. 1-5, then a darkspace character in col. 6.
Otherwise return 0. Leave point after col. 6. */
int loc;
{
point = loc;
to_begin_line();
re_search(1, "[ \t]*"); /* Move point to first darkspace character */
if (current_column() == 5) {
++point;
return 1;
}
else {
move_to_column(6);
return 0;
}
}
make_cont() /* Make line containing point a continuation by
replacing initial whitespace with 5 columns of
whitespace followed by the continuation char.
First darkspace should be the first char
of Fortran on this line */
{
to_begin_line();
to_column(5);
insert(FORTRAN_CONT);
return; /* Point is left after continuation char. */
}
check_no(stmt_no) /* Check if, following point, there is (optional)
whitespace, then a string of 5 or fewer digits
(a Fortran statement number). If so, return
pointer to it in stmt_no */
char *stmt_no;
{
int orig = point;
int begin;
int length;
re_search(1, "[ \t]*"); /* Skip whitespace, if any */
begin = point;
while(isdigit(curchar())) point++;
length = point - begin; /* Length of string of digits */
if (length > 0 && length <= 5) { /* String was found */
point = begin;
parse_string(1, "[0-9]*", stmt_no);
}
else { /* Not found */
length = 0;
*stmt_no = '\0';
}
point = orig;
return length;
}
find_prev_stmt(stmt_no) /* Find start of previous statement, when point is in
it, returning length of statement's indentation
or -1 if there was no previous statement.
Also, return pointer stmt_no to a statement
number, if present */
char *stmt_no;
{
while (point > 0 && check_cont(point)) {
to_begin_line();
fortran_skip_lines();
/* Skip back over empty and blank lines & comments */
--point;
}
if (point >= 0) {
to_begin_line();
check_no(stmt_no);
return find_indent(point);
}
else return -1;
}
find_word(dir, word) /* Searching in direction dir,
find string of alphabetic characters beginning
at point, and copy the string to word,
changing to lower case, and return
the length of the string as function value */
int dir;
char *word;
{
int length;
length = parse_string(dir, "[a-zA-Z]*", word);
while ((*word++ = tolower(*word)) != '\0');
return length;
}
#define MAXERRSTRING 10
key_word_error() /* Report apparent error in user type-in */
{
char err_string[MAXERRSTRING+1];
grab(point, point+MAXERRSTRING, err_string);
say("%s%s", "Expected Fortran keyword but found: ",
err_string);
maybe_ding();
return;
}
command for_mode()
{
char resp[80];
mode_keys = fortran_tab; /* Use these keys */
fortran_tab[')'] = (short) show_matching_delimiter;
indenter = fortran_indent_line;
auto_indent = 1;
fill_mode = 1;
margin_right = 73;
fortran_mode = 1;
major_mode = strsave("Fortran");
make_mode();
beg_word[0] = strsave("if");
beg_word[1] = strsave("elseif");
beg_word[2] = strsave("else");
beg_word[3] = strsave("do");
end_word[0] = strsave("endif");
end_word[1] = strsave("end");
end_word[2] = strsave("elseif");
end_word[3] = strsave("else");
end_word[4] = strsave("continue");
if (search(1, "\t")) {
get_string(resp, "Tab found in file, untabify buffer? [y]");
if (toupper(*resp) != 'N') {
resp[0] = 'a';
while (!isdigit(*resp)) {
resp[0] = '3';
get_string(resp,
"What size tab for untabify? [3]");
}
tab_size = resp[0] - '0';
build_first = 1;
maybe_refresh();
point = 0;
mark = size();
untabify_region();
}
}
point = 0;
mark = 0;
tab_size = 3;
}
/* Make this the default mode for .for files */
suffix_for() { for_mode(); }
/* save_file() from files.e was modified to behave appropriately if
narrow or fortran mode is on, by Gary R. Smith, Sept. 1986 */
buffer int narrow_mode;
command save_file() on cx_tab[CTRL('S')]
{
char backupname[80];
int err;
int mod;
char resp[80];
iter = 0;
if (!*filename)
return write_file();
strcpy(backupname, filename);
strcpy(get_extension(backupname), ".bak");
if (want_backups && strcmp(filename, backupname)) {
delete_file(backupname); /* don't check errors */
rename_file(filename, backupname);
}
if (fortran_mode) { /* Fortran file may need to be untabified */
get_string(resp, "Untabify buffer? [y]");
if (toupper(*resp) != 'N') {
point = 0;
mark = size();
untabify_region();
}
}
mod = modified;
if (err = file_write(filename, strip_returns))
file_error(err,filename,"write error");
else
say("%s written.", filename);
if (narrow_mode)
modified = mod;
return err;
}
/****************** End of file "fortran.e" ******************/
******************************************************************
for_ext.e follows
******************************************************************
/* Written by James S. Storey */
/* Subroutines and commands in Fortran extension table (C-] table)
These routines insert templates for Fortran statements. */
#include "eel.h"
#define PREINDENT() if (current_column() < 6) move_to_column(6);\
if (current_column() < 6) to_column(6)
#define MENU "for_menu"
keytable fort_tab; /* table for basic commands */
keytable fort_ext_tab; /* table for extended commands */
buffer short bell_key;
get_fort_menu() /* make sure Fortran menu file is ready to go */
{
int exists = exist("-fort_menu");
char *oldbuf = bufname;
create("-fort_menu");
bufname = "-fort_menu";
if (!exists) {
sayput("Loading Fortran menu file. . .");
if (file_read(MENU, 1)) {
bufname = oldbuf;
delete_buffer("-fort_menu");
gripe("Can't find Fortran menu file %s", MENU);
say("");
return 0;
}
say("");
point = 0;
bufname = oldbuf;
return 1;
}
else {
if (size()==0) {
bufname = oldbuf;
delete_buffer("-fort_menu");
gripe("No Fortran menu file %s", MENU);
return 0;
}
point = 0;
bufname = oldbuf;
return 1;
}
}
fort_menu() on fort_ext_tab[CTRL(']')], fort_ext_tab['?']
{
sayput("C-] ");
if (get_fort_menu())
view_buffer("-fort_menu");
check_abort();
do {
getkey();
} while ((key == CTRL(']'))||(key == '?'));
say("");
do_again();
}
fort_function() on fort_ext_tab['f']
{
jmp_buf this_level, *old_level = top_level;
short orig_ret = fort_tab[CTRL('J')];
int i;
/* Set up abort trap to unbind keys */
top_level = &this_level;
bell_key = fort_tab[CTRL('G')];
if (setjmp(top_level)) {
major_mode = strsave("Fortran");
make_mode();
say("Aborted.");
fort_tab[CTRL('J')] = orig_ret;
reg_tab[CTRL('G')] = find_index("abort");
fort_tab[CTRL('G')] = bell_key;
top_level = old_level;
return;
}
PREINDENT();
bprintf("FUNCTION ()\n\n");
fort_indenter();
stuff("RETURN\n");
fort_indenter();
stuff("END\n");
for (i=1; i++<=4; nl_reverse())
;
move_to_column(6);
re_search(1,"[ \t]*");
insert(' ');
--point;
major_mode = strsave("FUNCTION type (single letter)");
strcpy(mode, major_mode);
maybe_refresh();
/* Get type, completing on a single key */
fort_tab[CTRL('G')] = find_index("f-abort");
reg_tab[CTRL('G')] = find_index("f-abort");
do {
getkey();
check_abort();
if ((key >= 'A') && (key <= 'Z'))
key -= 'A' - 'a';
switch (key) {
case ' ': {
delete(point,point+1);
break;
}
case 'c': {
stuff("CHARACTER");
break;
}
case 'd': {
stuff("DOUBLE PRECISION");
break;
}
case 'i': {
stuff("INTEGER");
break;
}
case 'j': {
stuff("COMPLEX");
break;
}
case 'l': {
stuff("LOGICAL");
break;
}
case 'r': {
stuff("REAL");
break;
}
case BELL: {
ungot_key=BELL;
f_abort();
break;
}
default : {
maybe_ding();
break;
}
}
} while (!index(" cdijlr",key));
/* Input function name in recursive edit mode. */
point += 10;
fort_tab[CTRL('J')] = find_index("exit-level");
fort_tab[(' ')] = find_index("exit-level");
major_mode = strsave("FUNCTION name (<cr> to exit)");
strcpy(mode, major_mode);
recursive_edit();
fort_tab[(' ')] = find_index("normal-character");
check_abort();
/* Input parameters in recursive edit mode. */
++point;
major_mode = strsave("FUNCTION parameters (<cr> to exit)");
strcpy(mode, major_mode);
recursive_edit();
check_abort();
/* Restore keys */
major_mode = strsave("Fortran");
make_mode();
fort_tab[CTRL('J')] = orig_ret;
reg_tab[CTRL('G')] = find_index("abort");
fort_tab[CTRL('G')] = bell_key;
nl_forward();
top_level = old_level;
}
fort_program() on fort_ext_tab['p']
{
int i;
PREINDENT();
bprintf("PROGRAM \n\n");
fort_indenter();
stuff("END\n");
for (i=1; i++<=3; nl_reverse())
;
}
fort_subroutine() on fort_ext_tab['s']
{
jmp_buf this_level, *old_level = top_level;
short orig_ret = fort_tab[CTRL('J')];
int i;
/* Set up abort trap to unbind keys */
top_level = &this_level;
bell_key = fort_tab[CTRL('G')];
if (setjmp(top_level)) {
major_mode = strsave("Fortran");
make_mode();
say("Aborted.");
fort_tab[CTRL('J')] = orig_ret;
reg_tab[CTRL('G')] = find_index("abort");
fort_tab[CTRL('G')] = bell_key;
top_level = old_level;
return;
}
PREINDENT();
bprintf("SUBROUTINE ()\n\n");
fort_indenter();
stuff("RETURN\n");
fort_indenter();
stuff("END\n");
for (i=1; i++<=3; nl_reverse())
;
point -=3;
/* Input subroutine name in recursive edit mode. */
fort_tab[CTRL('J')] = find_index("exit-level");
fort_tab[(' ')] = find_index("exit-level");
fort_tab[CTRL('G')] = find_index("f-abort");
reg_tab[CTRL('G')] = find_index("f-abort");
major_mode = strsave("SUBROUTINE name (<cr> to exit)");
strcpy(mode, major_mode);
recursive_edit();
fort_tab[(' ')] = find_index("normal-character");
check_abort();
/* Input parameters in recursive edit mode. */
++point;
major_mode = strsave("SUBROUTINE parameters (<cr> to exit)");
strcpy(mode, major_mode);
recursive_edit();
check_abort();
/* Restore keys */
major_mode = strsave("Fortran");
make_mode();
fort_tab[CTRL('J')] = orig_ret;
reg_tab[CTRL('G')] = find_index("abort");
fort_tab[CTRL('G')] = bell_key;
top_level = old_level;
nl_forward();
}
fort_character() on fort_ext_tab['a']
{
PREINDENT();
stuff("CHARACTER\t\t");
}
fort_double() on fort_ext_tab['d']
{
PREINDENT();
stuff("DOUBLE PRECISION\t");
}
fort_complex() on fort_ext_tab['j']
{
PREINDENT();
stuff("COMPLEX\t\t");
}
fort_integer() on fort_ext_tab['i']
{
PREINDENT();
stuff("INTEGER\t\t");
}
fort_logical() on fort_ext_tab['l']
{
PREINDENT();
stuff("LOGICAL\t\t");
}
fort_real() on fort_ext_tab['r']
{
PREINDENT();
stuff("REAL\t\t\t");
}
fort_common() on fort_ext_tab[ALT('c')]
{
PREINDENT();
stuff("COMMON / / ");
point-=3;
}
fort_data() on fort_ext_tab[ALT('d')]
{
PREINDENT();
stuff("DATA //");
point-=2;
}
fort_blockif() on fort_ext_tab[CTRL('B')]
{
short orig_ret = fort_tab[CTRL('J')];
bell_key = fort_tab[CTRL('G')];
PREINDENT();
stuff("IF () THEN\n");
fort_indenter();
fort_tabify();
insert('\n');
fort_indenter();
stuff("ENDIF\n");
nl_reverse();
nl_reverse();
nl_reverse();
point -= 6;
/* enter condition in recursive edit mode */
fort_tab[CTRL('G')] = find_index("f-abort");
reg_tab[CTRL('G')] = find_index("f-abort");
fort_tab[CTRL('J')] = find_index("exit-level");
major_mode = strsave("IF condition (<cr> to exit)");
strcpy(mode, major_mode);
recursive_edit();
/* Restore keys */
major_mode = strsave("Fortran");
make_mode();
fort_tab[CTRL('J')] = orig_ret;
reg_tab[CTRL('G')] = find_index("abort");
fort_tab[CTRL('G')] = bell_key;
check_abort();
nl_forward();
to_end_line();
}
fort_call() on fort_ext_tab['c']
{
stuff("CALL ()");
point-=2;
}
fort_continue() on fort_ext_tab[CTRL('C')]
{
PREINDENT();
stuff("CONTINUE\n");
fort_indenter();
}
fort_do() on fort_ext_tab[CTRL('D')]
{
jmp_buf this_level, *old_level = top_level;
char line_no[20];
int tag;
short orig_ret = fort_tab[CTRL('J')];
/* Set up abort trap to unbind keys */
top_level = &this_level;
bell_key = fort_tab[CTRL('G')];
if (setjmp(top_level)) {
major_mode = strsave("Fortran");
make_mode();
say("Aborted.");
fort_tab[' '] = find_index("maybe-break-line");
fort_tab[CTRL('J')] = orig_ret;
reg_tab[CTRL('G')] = find_index("abort");
fort_tab[CTRL('G')] = bell_key;
top_level = old_level;
return;
}
PREINDENT();
bprintf("DO =,\n");
fort_indenter();
fort_tabify();
nl_reverse();
point -= 3;
/* Input line number in recursive edit mode.
Space or <cr> exits. */
fort_tab[CTRL('J')] = find_index("exit-level");
fort_tab[' '] = find_index("exit-level");
fort_tab[CTRL('G')] = find_index("f-abort");
reg_tab[CTRL('G')] = find_index("f-abort");
major_mode = strsave("DO CONTINUE line number (<cr> to exit)");
strcpy(mode, major_mode);
recursive_edit();
check_abort();
/* Grab the line number if entered */
tag = point;
re_search(-1,"[0123456789]*");
if (point!=tag)
grab(point,tag,line_no);
nl_forward();
to_end_line();
insert('\n');
fort_indenter();
fort_tabify();
stuff("continue\n");
nl_reverse();
nl_reverse();
tag = point++;
bprintf("%5.5s",line_no);
re_search(1,"[ \t]*");
say("Continuation line?");
major_mode = strsave("DO CONTINUE query");
strcpy(mode, major_mode);
maybe_refresh();
getkey();
if (key == CTRL('G'))
error("Aborted.");
delete(point,point+8);
if ((key == CTRL('H'))||(toupper(key) == 'N')||(key == GREYBACK)) {
to_end_line();
delete(tag,point);
}
else
stuff("CONTINUE");
say("");
/* Input index in recursive edit mode. <cr> exits */
search(-1,"=,");
major_mode = strsave("DO index (<cr> or Space to exit)");
strcpy(mode, major_mode);
recursive_edit();
check_abort();
/* insert range */
++point;
major_mode = strsave("DO start (<cr> or Space to exit)");
strcpy(mode, major_mode);
recursive_edit();
check_abort();
++point;
major_mode = strsave("DO end (<cr> or Space to exit)");
strcpy(mode, major_mode);
recursive_edit();
/* Restore keys */
major_mode = strsave("Fortran");
make_mode();
fort_tab[' '] = find_index("maybe-break-line");
fort_tab[CTRL('J')] = orig_ret;
reg_tab[CTRL('G')] = find_index("abort");
fort_tab[CTRL('G')] = bell_key;
top_level = old_level;
check_abort();
++point;
nl_forward();
--point;
}
fort_else() on fort_ext_tab[CTRL('E')]
{
PREINDENT();
fort_delete_tab();
stuff("ELSE\n");
fort_indenter();
fort_tabify();
}
fort_elseif() on fort_ext_tab['e']
{
short orig_ret = fort_tab[CTRL('J')];
bell_key = fort_tab[CTRL('G')];
PREINDENT();
fort_delete_tab();
stuff("ELSEIF () THEN\n");
fort_indenter();
fort_tabify();
nl_reverse();
point -= 6;
/* enter condition in recursive edit mode */
fort_tab[CTRL('J')] = find_index("exit-level");
fort_tab[CTRL('G')] = find_index("f-abort");
reg_tab[CTRL('G')] = find_index("f-abort");
major_mode = strsave("ELSE IF condition (<cr> to exit)");
strcpy(mode, major_mode);
recursive_edit();
/* Restore keys */
major_mode = strsave("Fortran");
make_mode();
fort_tab[CTRL('J')] = orig_ret;
reg_tab[CTRL('G')] = find_index("abort");
fort_tab[CTRL('G')] = bell_key;
check_abort();
nl_forward();
nl_forward();
--point;
}
fort_goto() on fort_ext_tab['g']
{
PREINDENT();
stuff("GOTO ");
}
fort_if() on fort_ext_tab[CTRL('I')]
{
short orig_ret = fort_tab[CTRL('J')];
bell_key = fort_tab[CTRL('G')];
PREINDENT();
stuff("IF () ");
point -= 2;
/* enter condition in recursive edit mode */
fort_tab[CTRL('J')] = find_index("exit-level");
fort_tab[CTRL('G')] = find_index("f-abort");
reg_tab[CTRL('G')] = find_index("f-abort");
major_mode = strsave("IF condition (<cr> to exit)");
strcpy(mode, major_mode);
recursive_edit();
/* Restore keys */
major_mode = strsave("Fortran");
make_mode();
fort_tab[CTRL('J')] = orig_ret;
reg_tab[CTRL('G')] = find_index("abort");
fort_tab[CTRL('G')] = bell_key;
check_abort();
point +=2;
}
fort_format() on fort_ext_tab[CTRL('f')]
{
jmp_buf this_level, *old_level = top_level;
char line_no[20];
short orig_ret = fort_tab[CTRL('J')];
int tag;
/* Set up abort trap to unbind keys */
top_level = &this_level;
bell_key = fort_tab[CTRL('G')];
if (setjmp(top_level)) {
major_mode = strsave("Fortran");
make_mode();
say("Aborted.");
fort_tab[' '] = find_index("maybe-break-line");
fort_tab[CTRL('J')] = orig_ret;
reg_tab[CTRL('G')] = find_index("abort");
fort_tab[CTRL('G')] = bell_key;
top_level = old_level;
return;
}
PREINDENT();
bprintf("FORMAT ()");
to_begin_line();
/* Input line number in recursive edit mode.
Space or <cr> exits. */
fort_tab[CTRL('J')] = find_index("exit-level");
fort_tab[' '] = find_index("exit-level");
fort_tab[CTRL('G')] = find_index("f-abort");
reg_tab[CTRL('G')] = find_index("f-abort");
major_mode = strsave("FORMAT line number");
make_mode();
recursive_edit();
check_abort();
/* Grab the line number if entered, and right justify */
tag = point;
re_search(-1,"[0123456789]*");
if (point!=tag) {
grab(point,tag,line_no);
move_to_column(0);
delete(point,tag);
bprintf("%5.5s",line_no);
}
/* Restore keys */
major_mode = strsave("Fortran");
make_mode();
fort_tab[' '] = find_index("maybe-break-line");
fort_tab[CTRL('J')] = orig_ret;
reg_tab[CTRL('G')] = find_index("abort");
fort_tab[CTRL('G')] = bell_key;
top_level = old_level;
search(1,"FORMAT (");
}
fort_open() on fort_ext_tab[CTRL('o')]
{
jmp_buf this_level, *old_level = top_level;
char unit_no[20];
int tag;
short orig_ret = fort_tab[CTRL('J')];
/* Set up abort trap to unbind keys */
top_level = &this_level;
bell_key = fort_tab[CTRL('G')];
if (setjmp(top_level)) {
major_mode = strsave("Fortran");
make_mode();
say("Aborted.");
fort_tab[' '] = find_index("maybe-break-line");
fort_tab[CTRL('J')] = orig_ret;
reg_tab[CTRL('G')] = find_index("abort");
fort_tab[CTRL('G')] = bell_key;
top_level = old_level;
return;
}
PREINDENT();
bprintf("OPEN (*,FILE='for*.dat',status='new')");
point -= 31;
major_mode = strsave("OPEN unit number (<cr> or Space to exit)");
strcpy(mode, major_mode);
maybe_refresh();
getkey();
check_abort();
ungot_key = key;
delete(point,point+1);
/* Input unit number in recursive edit mode.
Space, or <cr> exits. */
fort_tab[CTRL('J')] = find_index("exit-level");
fort_tab[' '] = find_index("exit-level");
fort_tab[CTRL('G')] = find_index("f-abort");
reg_tab[CTRL('G')] = find_index("f-abort");
recursive_edit();
fort_tab[' '] = find_index("maybe-break-line");
/* Grab the unit number if entered, and right justify */
tag = point;
re_search(-1,"[0123456789]*");
if (point!=tag) {
grab(point,tag,unit_no);
}
else{
unit_no[0] = 0;
}
/* Query standard file name */
if (search(1,"for*")) {
delete(point,point-1);
tag = point-3;
bprintf("%.4s",unit_no);
point = tag;
say("Standard Filename?");
major_mode = strsave("OPEN filename query");
strcpy(mode, major_mode);
maybe_refresh();
getkey();
if (key == CTRL('G'))
error("Aborted.");
if ((key == CTRL('H'))
||(toupper(key) == 'N')||(key == GREYBACK)) {
if (search(1,"dat")) {
delete(tag,point);
/* Enter filename in recursive edit */
major_mode = strsave(
"OPEN file name (<cr> to exit)");
strcpy(mode, major_mode);
recursive_edit();
}
}
else {
delete(point,point+3);
stuff("FOR");
if (search(1,"dat")) {
delete(point-3,point);
stuff("DAT");
}
}
say("");
}
/* Query status */
if (search(1,"status")) {
point -= 6;
say("Status=New?");
major_mode = strsave("OPEN status query");
strcpy(mode,major_mode);
maybe_refresh();
getkey();
if (key == CTRL('G'))
error("Aborted.");
delete(point,point+12);
if ((key == CTRL('H'))
||(toupper(key) == 'N')||(key == GREYBACK)) {
delete(point-1,point);
}
else
stuff("STATUS='NEW'");
say("");
}
/* Restore keys */
major_mode = strsave("Fortran");
make_mode();
fort_tab[CTRL('J')] = orig_ret;
reg_tab[CTRL('G')] = find_index("abort");
fort_tab[CTRL('G')] = bell_key;
check_abort();
top_level = old_level;
to_end_line();
}
fort_read() on fort_ext_tab[CTRL('r')]
{
PREINDENT();
stuff("READ (*,*) ");
/* Input unit number */
point -= 5;
maybe_refresh();
getkey();
if (isdigit(key)) {
delete(point,point+1);
while (isdigit(key)) {
insert(key);
maybe_refresh();
getkey();
}
}
else {
check_abort();
++point;
}
/* Input format line number */
++point;
maybe_refresh();
getkey();
if (isdigit(key)) {
delete(point,point+1);
while (isdigit(key)) {
insert(key);
maybe_refresh();
getkey();
}
}
else {
check_abort();
++point;
}
point += 2;
}
fort_write() on fort_ext_tab[CTRL('w')]
{
PREINDENT();
stuff("WRITE (*,*) ");
/* Input unit number */
point -= 5;
maybe_refresh();
getkey();
if (isdigit(key)) {
delete(point,point+1);
while (isdigit(key)) {
insert(key);
maybe_refresh();
getkey();
}
}
else {
check_abort();
++point;
}
/* Input format line number */
++point;
maybe_refresh();
getkey();
if (isdigit(key)) {
delete(point,point+1);
while (isdigit(key)) {
insert(key);
maybe_refresh();
getkey();
}
}
else {
check_abort();
++point;
}
point += 2;
}
/* Commands to prompt for and complete names of fort- routines */
/* Requires modified COMPLETE.E file */
/*
/char *fsub_match(s, start)
/char *s;
/{
/int i;
/
/for (; i = name_match(s, start); start = 0)
/ switch (name_type(i)) {
/ case NT_COMMAND: case NT_SUBR:
/ return name_name(i);
/ }
/return 0;
/}
/
/get_fsub(res, pr)
/char *res, *pr;
/{
/strcpy(res,"fort-");
/comp_read(res, pr, fsub_match, 0);
/}
/
/get_fsub_index(pr)
/char *pr;
/{
/char fsub[80];
/int name_index;
/
/get_fsub(fsub, pr);
/name_index = find_index(fsub);
/if (name_index && (name_type(name_index) == NT_SUBR ||
/ name_type(name_index) == NT_COMMAND))
/ return name_index;
/error("There's no Fortran command named '%.50s'.",fsub);
/return 0;
/}
/
/command fort_named() on fort_tab[ALT(']')], fort_tab[FALT(2)]
/{
/char msg[40];
/int index;
/
/if (has_arg)
/ sprintf(msg, "%d Fortran Command: ", iter);
/else
/ sprintf(msg, "Fortran Command: ");
/if (index = get_fsub_index(msg))
/ do_command(index);
/}
*/
when_loading()
{
int i;
fort_tab[CTRL(']')] = find_index("fort-ext-tab");
for (i = 'A'; i <= 'Z'; i++) {
if (fort_ext_tab[ALT(i)] <= 0)
fort_ext_tab[ALT(i)] = find_index("case-indirect");
if (fort_ext_tab[i] <= 0)
fort_ext_tab[i] = find_index("case-indirect");
}
fort_ext_tab[CTRL('H')] = find_index("fort-delete-tab");
}
******************************************************************
for_load.e follows
******************************************************************
/************************************************************************
* "Epsilon", "EEL" and "Lugaru" are trademarks of Lugaru Software, Ltd. *
* *
* Copyright (C) 1985 Lugaru Software Ltd. All rights reserved. *
* *
* Limited permission is hereby granted to reproduce and modify this *
* copyrighted material provided that the resulting code is used only in *
* conjunction with Lugaru products and that this notice is retained in *
* any such reproduction or modification. *
************************************************************************/
/* Developed by James S. Storey */
#include "eel.h"
/* This mode auto-loads from files FOR_MODE and FOR_EXT */
#define FOR_MODE "for_mode"
#define FOR_EXT "for_ext"
/* Format buffer for FORTRAN programs.
This command puts the current buffer in the Fortran mode,
appropriate for editing programs written in Fortran.
Command names are of the form fort-COMMAND. A series of
statement commands automatically insert a template for most
Fortran statements. These statement commands are bound to keys
prefixed by the C-] key.
By default, the find-file command automatically turns on
Fortran mode for files with the extensions .f or .for. */
command fort_mode()
{
char *_fort_tab = "fort-tab", *_ind_ptr = "fort-indenter";
short *_fort_ptr;
if (!find_index("fort-tab")) {
sayput("Loading Fortran mode commands. . .");
load_commands(FOR_MODE);
load_commands(FOR_EXT);
say("");
}
_fort_ptr=index_table(find_index(_fort_tab));
mode_keys = _fort_ptr;
major_mode = strsave("Fortran");
make_mode();
(short) indenter = find_index(_ind_ptr);
auto_indent = 1;
tab_size = 6;
}
/* make this the default mode for .f and .for files */
suffix_f() { fort_mode(); }
suffix_for() { fort_mode(); }
******************************************************************
for_menu follows
******************************************************************
^B block if d double prec. l logical
c call i integer ^O open
a character ^E else p program
A-c common e elseif ^R read
j complex ^F format r real
^C continue f function s subroutine
A-d data g goto ^W write
^D do ^I if
******************************************************************
for_mode.e follows
******************************************************************
/* Written by James S. Storey */
/* Subroutines and commands for Fortran mode.
These commands are read in when Fortran mode is invoked for the
first time */
#include "eel.h"
int structured = 1; /* 1 indents to previous line, 0 indents to col 7 */
int Matchdelim = 1; /* 1 for showing matching ')' */
keytable fort_tab; /* key table for Fortran mode */
buffer short bell_key;
f_abort()
{
fort_tab[BELL] = bell_key;
reg_tab[BELL] = find_index("abort");
if (recursion_level>0)
exit_level();
user_abort = 1;
}
/* Routine used by fort-cont and fort-indent to decide how to continue
the line. */
fort_cont_indent()
{
char cont_char;
int eol = point, indent_col;
to_begin_line();
cont_char=curchar();
if (index("*cC",cont_char)) { /* Previous line was a comment */
indent_col = 3;
if (structured) { /* find first darkspace past col 1 */
++point; /* skip comment character */
if ((re_search(1, "[^ \t]")) && (point <= eol)) {
/* set indentation to begn of darkspace */
indent_col = current_column() -1;
}
}
point = eol+1;
bprintf("%c ",cont_char);
to_column(indent_col);
}
else { /* Previous line was a statement */
indent_col = 6;
if (structured) { /* find first darkspace past col 1 */
move_to_column(6);
if ((re_search(1, "[^ \t]")) && (point <= eol)) {
/* set indentation to begn of darkspace */
indent_col = current_column() -1;
}
}
point = eol+1;
bprintf(" +");
to_column(indent_col);
}
}
/* fort-cont Fortran continue current line.
Continues current line on next line. If the current line is
blank, another blank line is inserted. If the current line is
a comment line, the comment character is copied to the next
line and the line is indented to column 4. If the current line
is a program line, the continuation character '+' is inserted
in column 6 */
command fort_cont() on fort_tab[ALT('j')], fort_tab[CTRL(ALT('j'))]
{
insert('\n');
--point;
fort_cont_indent();
}
/* fort-late-cont This command makes an existing line into a
continuation of the previous line. */
command fort_late_cont() /* on A-N-+ */
{
int orig = point;
move_to_column(6);
if (current_column() < 6) {
to_column(5);
insert('+');
}
else {
if (character(point-1) == '\t')
orig += tab_size - 1;
delete_hacking_tabs();
insert('+');
point = orig;
}
}
/* command to toggle structured indentation */
command set_struct()
{
structured = (has_arg? (iter != 0) : !structured);
say(structured?"Structured indentation on" :
"Structured indentation off");
iter = 1;
}
/* fort-indenter Indent newlines in Fortran mode.
Called following a newline character. If the newline is at the
end of a line, the line is indented normally. If the newline
is the middle of a program line, the line is continued as in
"fort-cont", Fortran continue current line.
Bugs: With auto-fill, it continues lines after a newline if the
last character in the previous line is at the fill-column, and
it does not continue lines if more than one space preceded the
character which caused the auto-fill. */
fort_indenter()
{
int orig = point;
/* Check for newline at the end of a line, or followed by blanks */
to_end_line();
if (!re_search(-1, "[^ \t]") || point < orig) {
/* Check for auto-return */
point = orig-1;
if ((current_column() < margin_right-1) || !(fill_mode)) {
++point;
if (structured) {
indent_previous();
if (current_column() < 6)
to_column(6);
}
else
to_column(6); /* indent to column 7 */
}
else
/* Auto-return, continue previous line */
fort_cont_indent();
}
else {
point = orig-1;
fort_cont_indent();
}
}
/* backward-kill-spaces(back) Delete up to BACK spaces preceding point */
backward_kill_spaces(back)
int back;
{
int orig = point;
re_search(-1,"( )*");
if (point <= orig-back) {
point = orig;
delete(point-back,point);
}
else {
delete(point,orig);
}
}
/* fort-tabify Indent by half-tabs.
If the point is in the current line's indentation, a half-tab is
added to the indentation. Otherwise, if the point is in columns
1 to 6, whitespace is added out to column 6, or if the point is
past column 6, a half-tab is added before the point.
When adding half-tabs, if the point is preceded by 1/2 a tab or
more spaces, the spaces following the last tab-stop are deleted
and a tab is added. Otherwise, spaces are added up to 1/2 a tab
past the last tab stop. */
#define HALF_TAB tab_size/2
command fort_tabify() on fort_tab[CTRL('I')]
{
int orig = point, excess, lack;
/* skip leading blanks */
to_begin_line();
if (!re_search(1, "[^ \t]") || point > orig) { /* skip blanks */
point = orig;
to_indentation();
}
else /* restore point */
point = orig;
/* Tabify line */
if (current_column() < 5 ) /* insert tab */
to_column(6);
else { /* insert half-tab */
excess = (current_column()%tab_size);
lack = HALF_TAB-excess;
if (lack > 0) { /* between tab and half-tab stops */
for (; lack-- > 0; insert(' ')) ;
}
else { /* between half-tab and tab stops */
backward_kill_spaces(excess);
insert('\t');
}
}
}
/* fort-delete-tab If at column 7, delete the label field. Otherwise,
Delete a half tab preceding the point, hacking full tabs. */
fort_delete_tab() /* on fort_ext_tab[CTRL('H')] */
{
int excess, i;
if (current_column() == tab_size) {
if (character(point-1) == '\t')
delete(point-1,point);
else
backward_kill_spaces(tab_size);
return;
}
/* Else */
excess = (current_column()%tab_size);
if (excess == 0) { /* at a tab stop */
if (character(point-1) == '\t') {
/* delete previous tab, insert half tab */
delete(point-1,point);
for( i=1 ; i++ <=HALF_TAB ; insert(' ')) ;
}
else /* delete to last non-space or half tab stop */
backward_kill_spaces(HALF_TAB);
}
else {
if (excess <= HALF_TAB) /* Between tab and half tab */
backward_kill_spaces(excess);
else /* Between half tab and tab */
backward_kill_spaces(excess-HALF_TAB);
}
}
/* fort-merge Fortran merge continuation with previous.
Merges the current line with the previous, removing line numbers
and continuation characters (if necessary) for statement lines,
and removing the comment character for comment lines. An error
message is given if the command would merge a comment character
onto the end of a statement character. */
command fort_merge() on fort_tab[ALT('^')]
{
int orig = point, bol;
to_begin_line();
bol = point;
if (index("*cC",curchar())) { /* Merge continuation line */
--point;
to_begin_line();
if (!index("*cC",curchar())) {
/* Error: Attempt to Merge with statement */
say("Error: cannot merge continuation line with statement line");
point = orig;
return;
}
else {
if (orig = bol)
orig = bol-1;
else
orig -= 2;
delete(bol-1,bol+1);
}
}
else {
if (!search(1, "\t") || (point > bol+6)) {
/* No tabs in Col 1-6 */
if (orig < bol+6)
orig = bol-1; /* end of previous line */
else
orig -= 7; /* orig minus amount deleted */
delete(bol-1,bol+6);
}
else {
if (orig < point)
orig = bol-1; /* end of previous line */
else
orig -= point-bol+1;
/* orig minus amount deleted */
delete(bol-1,point);
}
}
point = orig;
}
/* fort-comment Pad the current line with blanks out to column 80.
This command allows end of line comments that will wrap to the
next screen line. */
command fort_comment() on fort_tab[ALT(';')]
{
int orig=point, col7;
move_to_column(6);
col7 = point;
for (point = orig; point <= col7+72; insert(' '))
;
}
when_loading()
{
int i;
for (i = 'A'; i <= 'Z'; i++)
if (fort_tab[ALT(i)] <= 0)
fort_tab[ALT(i)] = find_index("case-indirect");
if (Matchdelim)
fort_tab[')'] = find_index("show-matching-delimiter");
fort_tab[ALT('i')] = find_index("indent-under");
fort_tab[CTRL('M')] = find_index("newline");
fort_tab[CTRL('H')] = find_index("delete-hacking-tabs");
keytran[NUMALT(GREYPLUS)] = NUMALT(GREYPLUS);
fort_tab[NUMALT(GREYPLUS)] = (short) fort_late_cont;
}
******************************************************************
for_pas.doc follows
******************************************************************
Received: FROM SU-SIERRA.ARPA BY B.ISI.EDU WITH TCP ; 31 Oct 86 14:35:16 PST
Date: Fri 31 Oct 86 13:00:36-PST
From: James S. Storey <FAT.STOREY@Sierra.Stanford.EDU>
Subject: EEL code for Fortran and Pascal modes
To: info-ibmpc@B.ISI.EDU
Message-ID: <12251267181.17.FAT.STOREY@Sierra.Stanford.EDU>
I am sending a number of files which make up a Fortran and a Pascal mode
for Epsilon (I have V3.01). The files are: FOR_LOAD.E, FOR_MODE.E,
FOR_EXT.E, FOR_MENU, PAS_LOAD.E, PAS_MODE.E, PAS_EXT.E, and PAS_MENU.
I attempted to make them somewhat user friendly,
with some prompts and an on-line menu, but have not had time to document
everything, so the source code is the only complete description of what the
commands do. This should be usable by anyone with a version of Epsilon
that supports EEL code, but will probably be most useful to people with
some familiarity of EEL, who can customize the code to their particular
whims.
Because I often use the process window, and like to have memory available,
I set up the commands to be read in only when a Fortran (or Pascal) program
is being edited, similar to the auto-load stuff on UNIX Emacs. Thus, when
the commands are not used, they are not loaded. The Fortran commands will be
auto-loaded whenever a file with the extension .f or .for is edited, and
the Pascal commands with .p or .pas. In my system, I use a similar auto
loading for the C-mode, bufed, and dired commands, so my basic editor is
leaner than the standard configuration.
To set up the Fortran mode, the following files must be installed. First,
the file FOR_LOAD.E must be compiled and loaded into the basic Epsilon. I
suggest saving the state, rather than loading this file every time. Next,
set up a subdirectory \epsilon\modes, and compile the files FOR_MODE.E and
FOR_EXT.E, with the *.B output in this subdirectory. Also, copy the file
FOR_MENU into this subdirectory. The file FOR_LOAD.E assumes that the
auto-load files are in the subdirectory "C:\EPSILON\MODES". If a different
subdirectory will be used, lines 17 and 18 should be changed. If the menu is
in a different subdirectory, change line 12 of FOR_EXT.E. Similar steps will
set up the Pascal mode, using the PAS files instead of the FOR files.
There are two levels of complexity available. The first takes care of
indenting and several other minor chores. For the Fortran mode, this is in
the file FOR_MODE. The more complex mode is a template system, setting up a
SUBROUTINE outline or a DO loop outline, for example. These commands are in
the file FOR_EXT. If this extension is not desired, the auto-load command
"fort_mode()" should be altered, deleting the line
load_commands(FOR_EXT);
The organization of the Pascal mode is similar. For the extension commands,
a new prefix key CRTL-] is defined. This is intended to be analagous to the
prefix key CTRL-[. The key sequence CTRL-] CTRL-] will call up an on-line
menu of the available completions of the CTRL-].
For those who are not put off by EEL code, I have implemented a command which
prompts for and completes the Fortran or Pascal mode commands. However,
this requires modifying the source code of the file complete.e. I did not
want these modes to be unusable by people who do not want to mess with
the source code, so the files supplied have these commands - fort_named() and
pas_named() - as comments. For the adventureous types, the following
modifications are needed. First, remove the comment characters /* and */
surrounding the commands fsub_match(), get_fsub(), get_fsub_index(), and
fort_named() in FOR_EXT.E (similarly for the Pascal mode). Next, in the
Epsilon source file COMPLETE.E, make the following two changes:
1) Line 29: change
int i = 0, j, num_match = 0;
to
int i = strlen(trystr), j, num_match = 0;
2) Before every call to comp_read(), add the line
res[0]=0;
(8 occurances). The first change allows a partially formed string to be
passed to comp_read, so the command completed will already have the prefix
"fort-" or "pas-". The second change sets this initial string to NULL, so
the existing commands operate the same. Once these changes are made, and
the whole thing is recompiled, the completion is invoked by ALT-]. The
command is similar to the ALT-X command, prompting for fortran or pascal
commands and completing.
I have used both formats for about 9 months now, and I think I have cleaned
up all the major bugs. One minor bug that creeps in now and then is that
the new keytable associated with the prefix key CTRL-] seems to have bindings
which I never asked for. So, when a key which is not defined is pressed,
odd things sometimes happen. These have always been benign, and I have not
had the time to track down what is happening. If anyone does manage to fix
this, I would appreciate it if they would let me know what the problem is.
I grant full right to anyone to use and modify these programs, subject to
to conditions of the modified Lugaru code in the *_LOAD.E files. I would
appreciate hearing about any good extensions any bugs found, especially if
the cure has been found as well. I will be losing this computer account as I
move into the wild world of industry, so if there are any questions or
suggestions, the best way to contact me is by U.S. mail, at
James S. Storey
Teknekron, C.S.D.
2121 Allston Way
Berkeley, CA, 94704
(415) 548-4100
******************************************************************
pascal.e follows
******************************************************************
/* Modifications and extensions to the Epsilon editor. Bruce K. Hillyer.
* Portions of this code are covered by the following notice:
*/
/************************************************************************
* "Epsilon", "EEL" and "Lugaru" are trademarks of Lugaru Software, Ltd. *
* *
* Copyright (C) 1985 Lugaru Software Ltd. All rights reserved. *
* *
* Limited permission is hereby granted to reproduce and modify this *
* copyrighted material provided that the resulting code is used only in *
* conjunction with Lugaru products and that this notice is retained in *
* any such reproduction or modification. *
************************************************************************/
#include "eel.h"
/* find a line before this one that is less indented, line up with it.
*
* The use of this routine is as follows. After typing a line of, say,
* Pascal, press C-M to start a new line indented under the previous
* line (see command indent_next() below). Then you can press A-i to
* unindent one nesting level.
*/
command indent_less() on reg_tab[ALT('i')] {
int orig_column; /* indentation of original line */
int prev_indent; /* indentation of some previous line */
int orig; /* point of original indentation */
int prev_try; /* to guarantee the loop keeps progressing */
to_indentation();
orig = point;
orig_column = current_column();
/* scan backwards for a line that is indented less */
do {
prev_try = point;
to_begin_line();
re_search(-1, "[^ \t\n]"); /* find previous non-blank line */
to_indentation();
prev_indent = current_column();
} while (point < prev_try && prev_indent >= orig_column);
point = orig;
to_column((prev_indent < orig_column) ? prev_indent : 0);
}
/* Go to the next line and then indent under
*/
command indent_next() on reg_tab[CTRL('M')]
{
insert('\n');
indent_under();
}
/* automatically display matching delimiters (toggle)
*/
command display_matching_parens()
{
int display_matching_mode =
(has_arg ? (iter != 0)
: !(mode_keys[')'] == (short) show_matching_delimiter
&& mode_keys[']'] == (short) show_matching_delimiter
&& mode_keys['}'] == (short) show_matching_delimiter
)
);
if (display_matching_mode) {
say("Display matching )]}");
mode_keys[')'] =
mode_keys[']'] =
mode_keys['}'] = (short) show_matching_delimiter;
}
else {
say("No display matching )]}");
mode_keys[')'] =
mode_keys[']'] =
mode_keys['}'] = 0;
}
iter = 1;
}
******************************************************************
pas_ext.e follows
******************************************************************
/* Written by James S. Storey */
/* Subroutines and commands in Pascal extension table (C-] table)
These routines insert templates for Pascal statements. */
#include "eel.h"
#define MENU "pas_menu"
/* define an RE matching Pascal comments or whitespace, on same line */
#define P_SKIP "((%(%*([^*\n]|%*[^)\n])*%*%))|{([^}\n])*}|[ \t])*"
keytable pas_tab; /* table for basic commands */
keytable pas_ext_tab; /* table for extended commands */
buffer short bell_key;
int end_comments = 1; /* end_comments=1 causes comments to be added to
end statements */
get_pas_menu() /* make sure Pascal menu file is ready to go */
{
int exists = exist("-pas_menu");
char *oldbuf = bufname;
create("-pas_menu");
bufname = "-pas_menu";
if (!exists) {
sayput("Loading Pascal menu file. . .");
if (file_read(MENU, 1)) {
bufname = oldbuf;
delete_buffer("-menu");
gripe("Can't find Pascal menu file %s", MENU);
say("");
return 0;
}
say("");
point = 0;
bufname = oldbuf;
return 1;
}
else {
if (size()==0) {
bufname = oldbuf;
delete_buffer("-pas_menu");
gripe("No Pascal menu file %s", MENU);
return 0;
}
point = 0;
bufname = oldbuf;
return 1;
}
}
pas_menu() on pas_ext_tab[CTRL(']')], pas_ext_tab['?']
{
sayput("C-] ");
if (get_pas_menu())
view_buffer("-pas_menu");
check_abort();
do {
getkey();
} while ((key == CTRL(']'))||(key == '?'));
say("");
do_again();
}
command set_comments() /* Command to toggle end_comments */
{
end_comments = (has_arg? (iter != 0) : !end_comments);
say(end_comments?"End comments":"No end comments");
iter = 1;
}
pas_begin() on pas_ext_tab[CTRL('B')]
{
stuff("BEGIN\n");
pas_tabify();
insert('\n');
pas_indenter();
pas_tabify();
stuff("END;");
if (end_comments)
stuff(" (* BEGIN *)");
search(-1,"\n");
}
pas_end() on pas_ext_tab['e']
{
stuff("END;\n");
pas_indenter();
}
pas_program() on pas_ext_tab['p']
{
jmp_buf this_level, *old_level = top_level;
int i, tag1, tag2, diff1, diff2;
char prog_name[40];
short orig_ret = pas_tab[CTRL('J')],
orig_alt_ret = pas_tab[CTRL(ALT('j'))];
/* Set up abort trap to unbind keys */
top_level = &this_level;
bell_key = pas_tab[CTRL('G')];
if (setjmp(top_level)) {
major_mode = strsave("Pascal");
make_mode();
say("Aborted.");
pas_tab[CTRL(ALT('j'))] = orig_alt_ret;
reg_tab[CTRL('G')] = find_index("abort");
pas_tab[CTRL('G')] = bell_key;
top_level = old_level;
return;
}
/* Insert PROGRAM, BEGIN/END block, label with program name */
bprintf("PROGRAM ();\n\n");
stuff("BEGIN");
if (end_comments)
stuff(" (* *)");
tag1 = point-3;
insert('\n');
pas_tabify();
insert('\n');
stuff("END.");
if (end_comments) {
stuff(" (* *)");
tag2 = point-3;
}
insert('\n');
for (i=1; i++<=5; nl_reverse())
;
point -= 4;
/* tag BEGIN and END comments for inserting program name */
if (end_comments) {
diff1 = tag1-point;
diff2 = tag2-point;
}
/* Input program name in recursive edit mode.
<cr>, A-<cr> and space exit from recursion */
pas_tab[CTRL(ALT('j'))] = find_index("exit-level");
pas_tab[CTRL('J')] = find_index("exit-level");
pas_tab[CTRL('G')] = find_index("p-abort");
reg_tab[CTRL('G')] = find_index("p-abort");
pas_tab[' '] = find_index("exit-level");
major_mode = strsave("PROGRAM name (<cr> to exit)");
strcpy(mode, major_mode);
recursive_edit();
pas_tab[' '] = find_index("normal-character");
pas_tab[CTRL('J')] = orig_ret;
check_abort();
/* Grab the program name and insert it in BEGIN and END comments */
if (end_comments) {
tag1 = point;
backward_word();
grab(point,tag1,prog_name);
point = tag1+diff2;
stuff(prog_name);
point = tag1+diff1;
stuff(prog_name);
point = tag1+2;
}
/* Input parameters in recursive edit mode. A-<cr> exits */
major_mode = strsave("PROGRAM parameters (A-<cr> to exit)");
strcpy(mode, major_mode);
recursive_edit();
check_abort();
/* Set point to beginning of next block, and tag location */
nl_forward();
nl_forward();
tag1 = point;
/* Insert CONST declaration block, and delete if C-H is input */
insert('\n');
--point;
stuff("CONST\n");
pas_tabify();
stuff(";\n");
point -= 2;
major_mode = strsave("PROGRAM CONST block (BACKSPACE to delete)");
strcpy(mode, major_mode);
maybe_refresh();
getkey();
if (key == CTRL('G'))
error("Aborted.");
if ((key == CTRL('H'))||(key == GREYBACK)) {
delete(tag1,point+3);
}
else {
ungot_key = key;
delete(point,point+1);
major_mode = strsave("PROGRAM CONST block (A-<cr> to exit)");
strcpy(mode, major_mode);
recursive_edit();
check_abort();
nl_forward();
nl_forward();
tag1 = point;
}
/* Insert TYPE declaration block, and delete if C-H is input */
insert('\n');
--point;
stuff("TYPE\n");
pas_tabify();
stuff(";\n");
point -= 2;
major_mode = strsave("PROGRAM TYPE block (BACKSPACE to delete)");
strcpy(mode, major_mode);
maybe_refresh();
getkey();
if (key == CTRL('G'))
error("Aborted.");
if ((key == CTRL('H'))||(key == GREYBACK)) {
delete(tag1,point+3);
}
else {
ungot_key = key;
delete(point,point+1);
major_mode = strsave("PROGRAM TYPE block (A-<cr> to exit)");
strcpy(mode, major_mode);
recursive_edit();
check_abort();
nl_forward();
nl_forward();
tag1 = point;
}
/* Insert VAR declaration block, and delete if C-H is input */
insert('\n');
--point;
stuff("VAR\n");
pas_tabify();
stuff(";\n");
point -= 2;
major_mode = strsave("PROGRAM VAR block (BACKSPACE to delete)");
strcpy(mode, major_mode);
maybe_refresh();
getkey();
if (key == CTRL('G'))
error("Aborted.");
if ((key == CTRL('H'))||(key == GREYBACK)) {
delete(tag1,point+3);
}
else {
ungot_key = key;
delete(point,point+1);
major_mode = strsave("PROGRAM VAR block (A-<cr> to exit)");
strcpy(mode, major_mode);
recursive_edit();
check_abort();
nl_forward();
nl_forward();
tag1 = point;
}
/* Restore keys */
major_mode = strsave("Pascal");
make_mode();
pas_tab[CTRL(ALT('j'))] = orig_alt_ret;
reg_tab[CTRL('G')] = find_index("abort");
pas_tab[CTRL('G')] = bell_key;
top_level = old_level;
/* Move point to beginning of program body */
nl_forward();
to_end_line();
}
pas_var_param()
{
stuff("VAR ");
}
pas_procedure() on pas_ext_tab[CTRL('P')]
{
jmp_buf this_level, *old_level = top_level;
int i, tag1, tag2, diff1, diff2, left = current_column();
char proc_name[40];
short orig_ret = pas_tab[CTRL('J')],
orig_alt_ret = pas_tab[CTRL(ALT('j'))];
/* Set up abort trap to unbind keys */
top_level = &this_level;
bell_key = pas_tab[CTRL('G')];
if (setjmp(top_level)) {
major_mode = strsave("Pascal");
make_mode();
say("Aborted.");
pas_tab[CTRL(ALT('j'))] = orig_alt_ret;
reg_tab[CTRL('G')] = find_index("abort");
pas_tab[CTRL('G')] = bell_key;
top_level = old_level;
return;
}
/* Insert PROCEDURE, BEGIN/END block, label with procedure name */
bprintf("PROCEDURE ();\n\n");
to_column(left);
stuff("BEGIN");
if (end_comments)
stuff(" (* *)");
tag1 = point-3;
insert('\n');
to_column(left);
pas_tabify();
insert('\n');
to_column(left);
stuff("END;");
if (end_comments) {
stuff(" (* *)");
tag2 = point-3;
}
insert('\n');
for (i=1; i++<=5; nl_reverse())
;
point -= 4;
/* tag BEGIN and END comments for inserting procedure name */
if (end_comments) {
diff1 = tag1-point;
diff2 = tag2-point;
}
/* Input procedure name in recursive edit mode.
<cr>, A-<cr> and space exit from recursion */
pas_tab[CTRL(ALT('j'))] = find_index("exit-level");
pas_tab[CTRL('J')] = find_index("exit-level");
pas_tab[' '] = find_index("exit-level");
pas_tab[CTRL('G')] = find_index("p-abort");
reg_tab[CTRL('G')] = find_index("p-abort");
major_mode = strsave("PROCEDURE name (<cr> to exit)");
strcpy(mode, major_mode);
recursive_edit();
pas_tab[' '] = find_index("normal-character");
pas_tab[CTRL('J')] = orig_ret;
check_abort();
/* Grab the procedure name and insert it in BEGIN and END comments */
tag1 = point;
if (end_comments) {
backward_word();
grab(point,tag1,proc_name);
point = tag1+diff2;
stuff(proc_name);
point = tag1+diff1;
stuff(proc_name);
}
point = tag1+2;
/* Input parameters in recursive edit mode. A-<cr> exits,
^V inserts the string "VAR " */
pas_tab[CTRL('V')] = (short) pas_var_param;
major_mode = strsave("PROCEDURE parameters (A-<cr> to exit)");
strcpy(mode, major_mode);
recursive_edit();
pas_tab[CTRL('V')] = find_index("next-page");
check_abort();
/* Set point to beginning of next block, and tag location */
nl_forward();
nl_forward();
tag1 = point;
/* Insert TYPE declaration block, and delete if C-H is input */
insert('\n');
--point;
to_column(left);
stuff("TYPE\n");
to_column(left);
pas_tabify();
stuff(";\n");
point -= 2;
major_mode = strsave("PROCEDURE TYPE block (BACKSPACE to delete)");
strcpy(mode, major_mode);
maybe_refresh();
getkey();
if (key == CTRL('G'))
error("Aborted.");
if ((key == CTRL('H'))||(key == GREYBACK)) {
delete(tag1,point+3);
}
else {
ungot_key = key;
delete(point,point+1);
major_mode = strsave("PROCEDURE TYPE block (A-<cr> to exit)");
strcpy(mode, major_mode);
recursive_edit();
check_abort();
nl_forward();
nl_forward();
tag1 = point;
}
/* Insert VAR declaration block, and delete if C-H is input */
insert('\n');
--point;
to_column(left);
stuff("VAR\n");
to_column(left);
pas_tabify();
stuff(";\n");
point -= 2;
major_mode = strsave("PROCEDURE VAR block (BACKSPACE to delete)");
strcpy(mode, major_mode);
maybe_refresh();
getkey();
if (key == CTRL('G'))
error("Aborted.");
if ((key == CTRL('H'))||(key == GREYBACK)) {
delete(tag1,point+3);
}
else {
ungot_key = key;
delete(point,point+1);
major_mode = strsave("PROCEDURE VAR block (A-<cr> to exit)");
strcpy(mode, major_mode);
recursive_edit();
check_abort();
nl_forward();
nl_forward();
tag1 = point;
}
/* Restore keys */
major_mode = strsave("Pascal");
make_mode();
reg_tab[CTRL('G')] = find_index("abort");
pas_tab[CTRL('G')] = bell_key;
pas_tab[CTRL(ALT('j'))] = orig_alt_ret;
top_level = old_level;
/* Move point to beginning of procedure body */
nl_forward();
to_end_line();
}
pas_function() on pas_ext_tab['f']
{
jmp_buf this_level, *old_level = top_level;
int i, tag1, tag2, diff1, diff2, left = current_column();
char func_name[40];
short orig_ret = pas_tab[CTRL('J')],
orig_alt_ret = pas_tab[CTRL(ALT('j'))];
/* Set up abort trap to unbind keys */
top_level = &this_level;
bell_key = pas_tab[CTRL('G')];
if (setjmp(top_level)) {
major_mode = strsave("Pascal");
make_mode();
say("Aborted.");
pas_tab[CTRL(ALT('j'))] = orig_alt_ret;
reg_tab[CTRL('G')] = find_index("abort");
pas_tab[CTRL('G')] = bell_key;
top_level = old_level;
return;
}
/* Insert FUNCTION, BEGIN/END block, label with function name */
bprintf("FUNCTION (): ;\n\n");
to_column(left);
stuff("BEGIN");
if (end_comments)
stuff(" (* *)");
tag1 = point-3;
insert('\n');
to_column(left);
pas_tabify();
insert('\n');
to_column(left);
stuff("END;");
if (end_comments) {
stuff(" (* *)");
tag2 = point-3;
}
insert('\n');
for (i=1; i++<=5; nl_reverse())
;
point -= 6;
/* tag BEGIN and END comments for inserting function name */
if (end_comments) {
diff1 = tag1-point;
diff2 = tag2-point;
}
/* Input function name in recursive edit mode.
<cr>, A-<cr> and space exit from recursion */
pas_tab[CTRL(ALT('j'))] = find_index("exit-level");
pas_tab[CTRL('J')] = find_index("exit-level");
pas_tab[' '] = find_index("exit-level");
pas_tab[CTRL('G')] = find_index("p-abort");
reg_tab[CTRL('G')] = find_index("p-abort");
major_mode = strsave("FUNCTION name (<cr> to exit)");
strcpy(mode, major_mode);
recursive_edit();
pas_tab[' '] = find_index("normal-character");
pas_tab[CTRL('J')] = orig_ret;
check_abort();
/* Grab the function name and insert it in BEGIN and END comments */
tag1 = point;
if (end_comments) {
backward_word();
grab(point,tag1,func_name);
point = tag1+diff2;
stuff(func_name);
point = tag1+diff1;
stuff(func_name);
}
point = tag1+2;
/* Input parameters in recursive edit mode. A-<cr> exits,
^V inserts the string "VAR " */
pas_tab[CTRL('V')] = (short) pas_var_param;
major_mode = strsave("FUNCTION parameters (A-<cr> to exit)");
strcpy(mode, major_mode);
recursive_edit();
pas_tab[CTRL('V')] = find_index("next-page");
check_abort();
/* Input function type in recursive edit mode.
<cr> or A-<cr> exits. */
search(1,":");
++point;
pas_tab[CTRL('J')] = find_index("exit-level");
major_mode = strsave("FUNCTION type (<cr> to exit)");
strcpy(mode, major_mode);
recursive_edit();
pas_tab[CTRL('J')] = orig_ret;
check_abort();
/* Set point to beginning of next block, and tag location */
nl_forward();
nl_forward();
tag1 = point;
/* Insert TYPE declaration block, and delete if C-H is input */
insert('\n');
--point;
to_column(left);
stuff("TYPE\n");
to_column(left);
pas_tabify();
stuff(";\n");
point -= 2;
major_mode = strsave("FUNCTION TYPE block (BACKSPACE to delete)");
strcpy(mode, major_mode);
maybe_refresh();
getkey();
if (key == CTRL('G'))
error("Aborted.");
if ((key == CTRL('H'))||(key == GREYBACK)) {
delete(tag1,point+3);
}
else {
ungot_key = key;
delete(point,point+1);
major_mode = strsave("FUNCTION TYPE block (A-<cr> to exit)");
strcpy(mode, major_mode);
recursive_edit();
check_abort();
nl_forward();
nl_forward();
tag1 = point;
}
/* Insert VAR declaration block, and delete if C-H is input */
insert('\n');
--point;
to_column(left);
stuff("VAR\n");
to_column(left);
pas_tabify();
stuff(";\n");
point -= 2;
major_mode = strsave("FUNCTION VAR block (BACKSPACE to delete)");
strcpy(mode, major_mode);
maybe_refresh();
getkey();
if (key == CTRL('G'))
error("Aborted.");
if ((key == CTRL('H'))||(key == GREYBACK)) {
delete(tag1,point+3);
}
else {
ungot_key = key;
delete(point,point+1);
major_mode = strsave("FUNCTION VAR block (A-<cr> to exit)");
strcpy(mode, major_mode);
recursive_edit();
check_abort();
nl_forward();
nl_forward();
tag1 = point;
}
/* Restore keys */
major_mode = strsave("Pascal");
make_mode();
reg_tab[CTRL('G')] = find_index("abort");
pas_tab[CTRL('G')] = bell_key;
pas_tab[CTRL(ALT('j'))] = orig_alt_ret;
top_level = old_level;
/* Move point to beginning of function body */
nl_forward();
to_end_line();
}
pas_var() on pas_ext_tab[CTRL('V')]
{
stuff("VAR\n");
pas_indenter();
pas_tabify();
}
pas_type() on pas_ext_tab[CTRL('T')]
{
stuff("TYPE\n");
pas_indenter();
pas_tabify();
}
pas_record() on pas_ext_tab['r']
{
int left ,exit;
/* Insert RECORD */
stuff("RECORD\n");
point -= 7;
/* Check for new indentation */
exit = 0;
say("Set indentation (TAB or BACKSPACE)");
do {
refresh();
getkey();
switch (key) {
case CTRL('H') : ;
case GREYBACK : {
pas_delete_tab();
break;
}
case CTRL('I') : ;
case GREYTAB : {
pas_tabify();
break;
}
default : exit = 1;
}
} while (!exit);
say("");
check_abort();
left = current_column();
/* Insert END */
nl_forward();
to_column(left);
pas_tabify();
insert('\n');
to_column(left);
stuff("END;");
if (end_comments)
stuff(" (* RECORD *)");
nl_reverse();
insert(';');
--point;
maybe_refresh();
getkey();
check_abort();
ungot_key = key;
delete(point,point+1);
}
pas_while() on pas_ext_tab[CTRL('W')]
{
int tag1,tag2;
short orig_ret = pas_tab[CTRL('J')],
orig_eq = pas_tab['='],
orig_alt_ret = pas_tab[CTRL(ALT('j'))];
bell_key = pas_tab[CTRL('G')];
/* Insert WHILE DO */
stuff("WHILE DO\n");
point -= 4;
/* Input condition in recursive edit mode. A-<cr> or <cr> exits */
pas_tab[CTRL(ALT('j'))] = find_index("exit-level");
pas_tab['='] = find_index("normal-character");
pas_tab[CTRL('J')] = find_index("exit-level");
pas_tab[CTRL('G')] = find_index("p-abort");
reg_tab[CTRL('G')] = find_index("p-abort");
major_mode = strsave("WHILE condition (<cr> to exit)");
strcpy(mode, major_mode);
recursive_edit();
major_mode = strsave("Pascal");
make_mode();
pas_tab[CTRL('J')] = orig_ret;
pas_tab['='] = orig_eq;
pas_tab[CTRL(ALT('j'))] = orig_alt_ret;
reg_tab[CTRL('G')] = find_index("abort");
pas_tab[CTRL('G')] = bell_key;
check_abort();
/* Insert BEGIN/END pair, delete if CTRL('H') is entered */
to_end_line();
tag1 = point;
stuff(" BEGIN");
nl_forward();
pas_indenter();
pas_tabify();
insert('\n');
pas_indenter();
pas_tabify();
stuff("END;");
if (end_comments)
stuff(" (* WHILE *)");
tag2 = point;
nl_reverse();
insert(';');
--point;
maybe_refresh();
getkey();
if (key == CTRL('G'))
error("Aborted.");
if ((key == CTRL('H'))||(key == GREYBACK)) {
delete(point,tag2+1);
delete(tag1,tag1+6);
}
else {
ungot_key = key;
delete(point,point+1);
}
}
pas_for() on pas_ext_tab[CTRL('F')]
{
jmp_buf this_level, *old_level = top_level;
int tag1,tag2;
short orig_ret = pas_tab[CTRL('J')],
orig_alt_ret = pas_tab[CTRL(ALT('j'))];
/* Set up abort trap to unbind keys */
top_level = &this_level;
bell_key = pas_tab[CTRL('G')];
if (setjmp(top_level)) {
major_mode = strsave("Pascal");
make_mode();
say("Aborted.");
pas_tab[CTRL('J')] = orig_ret;
pas_tab[CTRL(ALT('j'))] = orig_alt_ret;
reg_tab[CTRL('G')] = find_index("abort");
pas_tab[CTRL('G')] = bell_key;
top_level = old_level;
return;
}
/* Insert FOR TO DO */
stuff("FOR := TO DO\n");
point -= 12;
/* Input index in recursive edit mode. A-<cr> or <cr> exits */
pas_tab[CTRL(ALT('j'))] = find_index("exit-level");
pas_tab[CTRL('J')] = find_index("exit-level");
pas_tab[CTRL('G')] = find_index("p-abort");
reg_tab[CTRL('G')] = find_index("p-abort");
major_mode = strsave("FOR index (<cr> to exit)");
strcpy(mode, major_mode);
recursive_edit();
check_abort();
/* find ":=" on this line */
to_begin_line();
search(1,":=");
/* Input start in recursive edit mode. A-<cr> or <cr> exits */
++point;
major_mode = strsave("FOR start (<cr> to exit)");
strcpy(mode, major_mode);
recursive_edit();
check_abort();
/* Change TO to DOWNTO on 'd' or 'D' */
re_search(1,"( )*");
stuff("down");
point -= 4;
major_mode = strsave("FOR downTO (d for DOWNTO)");
strcpy(mode, major_mode);
maybe_refresh();
delete(point,point+4);
getkey();
if (key == CTRL('G'))
error("Aborted.");
if (toupper(key) == 'D')
stuff("DOWN");
/* Input end in recursive edit mode. A-<cr> or <cr> exits */
point += 3;
major_mode = strsave("FOR end (<cr> to exit)");
strcpy(mode, major_mode);
recursive_edit();
pas_tab[CTRL('J')] = orig_ret;
pas_tab[CTRL(ALT('j'))] = orig_alt_ret;
reg_tab[CTRL('G')] = find_index("abort");
pas_tab[CTRL('G')] = bell_key;
top_level = old_level;
check_abort();
/* Insert BEGIN/END pair, delete if CTRL('H') is entered */
to_end_line();
tag1 = point;
stuff(" BEGIN");
nl_forward();
pas_indenter();
pas_tabify();
insert('\n');
pas_indenter();
pas_tabify();
stuff("END;");
if (end_comments)
stuff(" (* FOR *)");
tag2 = point;
nl_reverse();
insert(';');
--point;
major_mode = strsave("FOR body (BACKSPACE to delete)");
strcpy(mode, major_mode);
maybe_refresh();
getkey();
if (key == CTRL('G'))
error("Aborted.");
if ((key == CTRL('H'))||(key == GREYBACK)) {
delete(point,tag2+1);
delete(tag1,tag1+6);
}
else {
ungot_key = key;
delete(point,point+1);
}
major_mode = strsave("Pascal");
make_mode();
}
pas_with() on pas_ext_tab['w']
{
int tag1,tag2;
short orig_ret = pas_tab[CTRL('J')],
orig_eq = pas_tab['='],
orig_alt_ret = pas_tab[CTRL(ALT('j'))];
bell_key = pas_tab[CTRL('G')];
/* Insert WITH DO */
stuff("WITH DO\n");
point -= 4;
/* Input condition in recursive edit mode. A-<cr> or <cr> exits */
pas_tab[CTRL(ALT('j'))] = find_index("exit-level");
pas_tab['='] = find_index("normal-character");
pas_tab[CTRL('J')] = find_index("exit-level");
pas_tab[CTRL('G')] = find_index("p-abort");
reg_tab[CTRL('G')] = find_index("p-abort");
major_mode = strsave("WHILE condition (<cr> to exit)");
strcpy(mode, major_mode);
recursive_edit();
major_mode = strsave("Pascal");
make_mode();
pas_tab[CTRL('J')] = orig_ret;
pas_tab['='] = orig_eq;
pas_tab[CTRL(ALT('j'))] = orig_alt_ret;
reg_tab[CTRL('G')] = find_index("abort");
pas_tab[CTRL('G')] = bell_key;
check_abort();
/* Insert BEGIN/END pair, delete if CTRL('H') is entered */
to_end_line();
tag1 = point;
stuff(" BEGIN");
nl_forward();
pas_indenter();
pas_tabify();
insert('\n');
pas_indenter();
pas_tabify();
stuff("END;");
if (end_comments)
stuff(" (* WITH *)");
tag2 = point;
nl_reverse();
insert(';');
--point;
maybe_refresh();
getkey();
if (key == CTRL('G'))
error("Aborted.");
if ((key == CTRL('H'))||(key == GREYBACK)) {
delete(point,tag2+1);
delete(tag1,tag1+6);
}
else {
ungot_key = key;
delete(point,point+1);
}
}
pas_if() on pas_ext_tab[CTRL('I')]
{
int tag1,tag2;
short orig_ret = pas_tab[CTRL('J')],
orig_eq = pas_tab['='],
orig_alt_ret = pas_tab[CTRL(ALT('j'))];
bell_key = pas_tab[CTRL('G')];
/* Insert IF THEN */
stuff("IF THEN\n");
point -= 6;
/* Input condition in recursive edit mode. A-<cr> or <cr> exits */
pas_tab[CTRL(ALT('j'))] = find_index("exit-level");
pas_tab['='] = find_index("normal-character");
pas_tab[CTRL('J')] = find_index("exit-level");
pas_tab[CTRL('G')] = find_index("p-abort");
reg_tab[CTRL('G')] = find_index("p-abort");
major_mode = strsave("IF condition (<cr> to exit)");
strcpy(mode, major_mode);
recursive_edit();
major_mode = strsave("Pascal");
make_mode();
pas_tab[CTRL('J')] = orig_ret;
pas_tab['='] = orig_eq;
pas_tab[CTRL(ALT('j'))] = orig_alt_ret;
reg_tab[CTRL('G')] = find_index("abort");
pas_tab[CTRL('G')] = bell_key;
check_abort();
/* Insert BEGIN/END pair, delete if CTRL('H') is entered */
to_end_line();
tag1 = point;
stuff(" BEGIN");
nl_forward();
pas_indenter();
pas_tabify();
insert('\n');
pas_indenter();
pas_tabify();
stuff("END;");
if (end_comments)
stuff(" (* THEN *)");
tag2 = point;
nl_reverse();
insert(';');
--point;
maybe_refresh();
getkey();
if (key == CTRL('G'))
error("Aborted.");
if ((key == CTRL('H'))||(key == GREYBACK)) {
delete(point,tag2+1);
delete(tag1,tag1+6);
}
else {
ungot_key = key;
delete(point,point+1);
}
}
pas_else() on pas_ext_tab[CTRL('E')]
{
int tag1,tag2;
short exit;
/* delete half-tab */
pas_delete_tab();
/* Insert ELSE */
stuff("ELSE\n");
/* Delete ; on previous line */
--point;
nl_reverse();
re_search(-1,P_SKIP);
if (character(point-1) == ';')
delete(point-1,point);
nl_forward();
nl_forward();
point -= 5;
/* Check for new indentation */
exit = 0;
say("Set indentation (TAB or BACKSPACE)");
do {
refresh();
getkey();
switch (key) {
case CTRL('H') : ;
case GREYBACK : {
pas_delete_tab();
break;
}
case CTRL('I') : ;
case GREYTAB : {
pas_tabify();
break;
}
default : exit = 1;
}
} while (!exit);
say("");
check_abort();
/* Insert BEGIN/END pair, delete if CTRL('H') is entered */
to_end_line();
tag1 = point;
stuff(" BEGIN");
nl_forward();
pas_indenter();
pas_tabify();
insert('\n');
pas_indenter();
pas_tabify();
stuff("END;");
if (end_comments)
stuff(" (* ELSE *)");
tag2 = point;
nl_reverse();
insert(';');
--point;
maybe_refresh();
getkey();
check_abort();
if ((key == CTRL('H'))||(key == GREYBACK)) {
delete(point,tag2+1);
delete(tag1,tag1+6);
}
else {
ungot_key = key;
delete(point,point+1);
}
}
pas_repeat() on pas_ext_tab[CTRL('R')]
{
short exit, orig_ret = pas_tab[CTRL('J')],
orig_eq = pas_tab['='],
orig_alt_ret = pas_tab[CTRL(ALT('j'))];
bell_key = pas_tab[CTRL('G')];
/* Insert REPEAT */
stuff("REPEAT\n");
point -= 7;
/* Check for new indentation */
exit = 0;
say("Set indentation (TAB or BACKSPACE)");
do {
refresh();
getkey();
switch (key) {
case CTRL('H') : ;
case GREYBACK : {
pas_delete_tab();
break;
}
case CTRL('I') : ;
case GREYTAB : {
pas_tabify();
break;
}
default : exit = 1;
}
} while (!exit);
say("");
check_abort();
/* Insert UNTIL */
nl_forward();
insert('\n');
pas_indenter();
stuff("UNTIL ;");
--point;
/* Input condition in recursive edit mode. A-<cr> or <cr> exits */
pas_tab[CTRL(ALT('j'))] = find_index("exit-level");
pas_tab['='] = find_index("normal-character");
pas_tab[CTRL('J')] = find_index("exit-level");
pas_tab[CTRL('G')] = find_index("p-abort");
reg_tab[CTRL('G')] = find_index("p-abort");
major_mode = strsave("UNTIL condition (<cr> to exit)");
strcpy(mode, major_mode);
recursive_edit();
major_mode = strsave("Pascal");
make_mode();
pas_tab[CTRL('J')] = orig_ret;
pas_tab['='] = orig_eq;
pas_tab[CTRL(ALT('j'))] = orig_alt_ret;
reg_tab[CTRL('G')] = find_index("abort");
pas_tab[CTRL('G')] = bell_key;
check_abort();
/* go to indentation of loop body */
nl_reverse();
pas_indenter();
pas_tabify();
}
pas_case() on pas_ext_tab[CTRL('C')]
{
short orig_ret = pas_tab[CTRL('J')],
orig_alt_ret = pas_tab[CTRL(ALT('j'))];
bell_key = pas_tab[CTRL('G')];
/* Insert CASE OF */
stuff("CASE OF\n");
point -= 4;
/* Input case expression in recursive edit mode.
A-<cr> or <cr> exits */
pas_tab[CTRL(ALT('j'))] = find_index("exit-level");
pas_tab[CTRL('J')] = find_index("exit-level");
pas_tab[CTRL('G')] = find_index("p-abort");
reg_tab[CTRL('G')] = find_index("p-abort");
major_mode = strsave("CASE expression (<cr> to exit)");
strcpy(mode, major_mode);
recursive_edit();
major_mode = strsave("Pascal");
make_mode();
reg_tab[CTRL('G')] = find_index("abort");
pas_tab[CTRL('G')] = bell_key;
pas_tab[CTRL('J')] = orig_ret;
pas_tab[CTRL(ALT('j'))] = orig_alt_ret;
check_abort();
/* Insert END */
to_end_line();
nl_forward();
pas_indenter();
pas_tabify();
insert('\n');
pas_indenter();
pas_tabify();
stuff("END;");
if (end_comments)
stuff(" (* CASE *)");
nl_reverse();
insert(' :');
point-=2;
}
/* Commands to prompt for and complete names of pas- routines */
/* Requires modified COMPLETE.E file */
/*
/char *psub_match(s, start)
/char *s;
/{
/int i;
/
/for (; i = name_match(s, start); start = 0)
/ switch (name_type(i)) {
/ case NT_COMMAND: case NT_SUBR:
/ return name_name(i);
/ }
/return 0;
/}
/
/get_psub(res, pr)
/char *res, *pr;
/{
/strcpy(res,"pas-");
/comp_read(res, pr, psub_match, 0);
/}
/
/get_psub_index(pr)
/char *pr;
/{
/char psub[80];
/int name_index;
/
/get_psub(psub, pr);
/name_index = find_index(psub);
/if (name_index && (name_type(name_index) == NT_SUBR ||
/ name_type(name_index) == NT_COMMAND))
/ return name_index;
/error("There's no Pascal command named '%.50s'.",psub);
/return 0;
/}
/
/command pas_named() on pas_tab[ALT(']')], pas_tab[FALT(2)]
/{
/char msg[40];
/int index;
/
/if (has_arg)
/ sprintf(msg, "%d Pascal Command: ", iter);
/else
/ sprintf(msg, "Pascal Command: ");
/if (index = get_psub_index(msg))
/ do_command(index);
/}
*/
when_loading()
{
int i;
pas_tab[CTRL(']')] = find_index("pas-ext-tab");
for (i = 'A'; i <= 'Z'; i++) {
if (pas_ext_tab[ALT(i)] <= 0)
pas_ext_tab[ALT(i)] = find_index("case-indirect");
if (pas_ext_tab[i] <= 0)
pas_ext_tab[i] = find_index("case-indirect");
}
pas_ext_tab[CTRL('H')] = find_index("pas-delete-tab");
}
******************************************************************
pas_load.e follows
******************************************************************
/************************************************************************
* "Epsilon", "EEL" and "Lugaru" are trademarks of Lugaru Software, Ltd. *
* *
* Copyright (C) 1985 Lugaru Software Ltd. All rights reserved. *
* *
* Limited permission is hereby granted to reproduce and modify this *
* copyrighted material provided that the resulting code is used only in *
* conjunction with Lugaru products and that this notice is retained in *
* any such reproduction or modification. *
************************************************************************/
/* Developed by James S. Storey */
#include "eel.h"
/* This mode auto-loads from files PAS_MODE and PAS_EXT */
#define PAS_MODE "pas_mode"
#define PAS_EXT "pas_ext"
/* Format buffer for Pascal programs.
This command puts the current buffer in the Pascal mode,
appropriate for editing programs written in Pascal.
Command names are of the form pas-COMMAND. A series of
statement commands automatically insert a template for most
Pascal statements. These statement commands are bound to keys
prefixed by the C-] key.
By default, the find-file command automatically turns on
Pascal mode for files with the extensions .p or .pas. */
command pas_mode()
{
char *_pas_tab = "pas-tab", *_ind_ptr = "pas-indenter";
short *_pas_ptr;
if (!find_index("pas-tab")) {
sayput("Loading Pascal mode commands. . .");
load_commands(PAS_MODE);
load_commands(PAS_EXT);
say("");
}
_pas_ptr=index_table(find_index(_pas_tab));
mode_keys = _pas_ptr;
major_mode = strsave("Pascal");
make_mode();
(short) indenter = find_index(_ind_ptr);
auto_indent = 1;
}
/* make this the default mode for .p and .pas files */
suffix_p() { pas_mode(); }
suffix_pas() { pas_mode(); }
******************************************************************
pas_menu follows
******************************************************************
^B begin ^H del tabs ^T type
^C case ^I if w with
^E else ^P procedure ^W while
e end p program ^V var
^F for r record
f function ^R repeat
******************************************************************
pas_mode.e follows
******************************************************************
/* Written by James S. Storey */
/* Subroutines and commands for Pascal mode.
These commands are read in when Pascal mode is invoked for the
first time */
#include "eel.h"
/* define an RE matching Pascal comments or whitespace */
#define P_LSKIP "((%(%*([^*]|%*[^)])*%*%))|{([^}])*}|[ \t\n])*"
/* define an RE matching Pascal comments or whitespace, on same line */
#define P_SKIP "((%(%*([^*\n]|%*[^)\n])*%*%))|{([^}\n])*}|[ \t])*"
int Matchdelim = 1; /* 1 for showing matching ')' */
keytable pas_tab; /* key table for Pascal mode */
buffer short bell_key;
p_abort()
{
pas_tab[BELL] = bell_key;
reg_tab[BELL] = find_index("abort");
if (recursion_level>0)
exit_level();
user_abort = 1;
}
/* backward-kill-spaces(back) Delete up to BACK spaces preceding point */
backward_kill_spaces(back)
int back;
{
int orig = point;
re_search(-1,"( )*");
if (point <= orig-back) {
point = orig;
delete(point-back,point);
}
else {
delete(point,orig);
}
}
/* pas-tabify Indent by half-tabs.
If the point is in the current line's indentation, a half-tab is
added to the indentation. Otherwise, a half-tab is added before
the point.
When adding half-tabs, if the point is preceded by 1/2 a tab or
more spaces, the spaces following the last tab-stop are deleted
and a tab is added. Otherwise, spaces are added up to 1/2 a tab
past the last tab stop. */
#define HALF_TAB tab_size/2
command pas_tabify() on pas_tab[CTRL('I')]
{
int orig = point, excess, lack;
/* skip leading blanks */
to_begin_line();
if (!re_search(1, "[^ \t]") || point > orig) { /* skip blanks */
point = orig;
to_indentation();
}
else /* restore point */
point = orig;
/* Insert half tab */
excess = (current_column()%tab_size);
lack = HALF_TAB-excess;
if (lack > 0) { /* between tab and half-tab stops */
for (; lack-- > 0; insert(' ')) ;
}
else { /* between half-tab and tab stops */
backward_kill_spaces(excess);
insert('\t');
}
}
/* pas-delete-tab Delete a half tab preceding the point, hacking full
tabs. */
pas_delete_tab() /* on pas_ext_tab[CTRL('H')] */
{
int excess, i;
excess = (current_column()%tab_size);
if (excess == 0) { /* at a tab stop */
if (character(point-1) == '\t') {
/* delete previous tab, insert half tab */
delete(point-1,point);
for( i=1 ; i++ <=HALF_TAB ; insert(' ')) ;
}
else /* delete to last non-space or half tab stop */
backward_kill_spaces(HALF_TAB);
}
else {
if (excess <= HALF_TAB) /* Between tab and half tab */
backward_kill_spaces(excess);
else /* Between half tab and tab */
backward_kill_spaces(excess-HALF_TAB);
}
}
/* pas-comment Insert a pascal comment. */
command pas_comment() on pas_tab[ALT(';')]
{
#define L_COMMENT "(*"
#define R_COMMENT "*)"
int com_size;
short orig_alt_ret = pas_tab[CTRL(ALT('j'))];
bell_key = pas_tab[BELL];
com_size = strlen(R_COMMENT);
bprintf("%s %s",L_COMMENT,R_COMMENT);
point -= com_size+1;
major_mode = strsave("COMMENT body (BACKSPACE to delete)");
strcpy(mode, major_mode);
maybe_refresh();
getkey();
if (((key == CTRL('H'))||(key == GREYBACK))||(key == CTRL('G'))) {
delete(point-com_size-1,point+com_size+1);
major_mode = strsave("Pascal");
strcpy(mode, major_mode);
}
else {
ungot_key = key;
pas_tab[BELL] = find_index("p-abort");
reg_tab[BELL] = find_index("p-abort");
pas_tab[CTRL(ALT('j'))] = find_index("exit-level");
major_mode = strsave("COMMENT body (A-<cr> to exit)");
strcpy(mode, major_mode);
recursive_edit();
major_mode = strsave("Pascal");
strcpy(mode, major_mode);
pas_tab[CTRL(ALT('j'))] = orig_alt_ret;
check_abort();
reg_tab[BELL] = find_index("abort");
pas_tab[BELL] = bell_key;
point += com_size+1;
}
}
/* pas_indenter Like the command indent previous, but gives no indentation
if the previous line is not indented. */
command pas_indenter() on pas_tab[ALT('i')]
{
int orig_column, prev_indent;
int orig = point;
orig_column = current_column(); /* point's column */
to_begin_line();
if (re_search(-1, "[^ \t\n]")) { /* find previous non-blank line */
to_indentation();
prev_indent = current_column();
}
else
prev_indent = 0;
point = orig;
to_indentation(); /* go to current line's indent */
to_column(prev_indent); /* indentation as previous */
}
/* pas-return Insert a ';' if necessary, then return. */
pas_return() on pas_tab[CTRL('J')]
{
int orig = point;
char prev,comm[3];
to_end_line();
if (point == orig) {
re_search(-1,P_SKIP);
if (point>0) {
prev = character(point-1);
if ( (prev!=';') && (prev!='\n') ) {
grab(point-2,point,comm);
if ( (strncmp(comm,"*)",2)) &&
(prev!='}')) {
insert(';');
++orig;
}
}
}
}
point = orig;
insert('\n');
pas_indenter();
}
/* norm-return Normal return. */
norm_return() on pas_tab[CTRL(ALT('j'))],pas_tab[ALT('j')]
{
insert('\n');
pas_indenter();
}
/* pas-equal Inserts " := " */
pas_equal() on pas_tab['=']
{
stuff(" := ");
}
normal_equal() on pas_tab[ALT('=')]
{
insert('=');
}
when_loading()
{
int i;
pas_tab[CTRL('M')] = find_index("newline");
pas_tab[CTRL('H')] = find_index("delete-hacking-tabs");
for (i = 'A'; i <= 'Z'; i++)
if (pas_tab[ALT(i)] <= 0)
pas_tab[ALT(i)] = find_index("case-indirect");
if (Matchdelim)
pas_tab[')'] = pas_tab[']'] =
find_index("show-matching-delimiter");
}
******************************************************************
this completes all *.e files
******************************************************************
p.s. to editor... I know I should have put all this into an *.arc
file but I don't know how to mail binaries, although I do know how
to retrieve binaries from simtel.
-------