Article View: gnu.emacs.bug
Article #99836Improvements for VMS Emacs 18.55
From: Alfred Nathaniel
Date: Wed, 18 Apr 1990 12:30
Date: Wed, 18 Apr 1990 12:30
1405 lines
41945 bytes
41945 bytes
Hi,
I made some improvements to the VMS version of GNU Emacs which required
extensive changes to fileio.c and sysdep.c. The changes concern the
construction of buffer names and reading DECnet files.
My starting point was version 18.52 to which I applied the patches to bring
it to version 18.55.
In the original 18.55 there is a big danger that one edits the same file
under different buffernames. E.g. the buffernames "makefile" and "makefile."
may be connected to the same file. Another problem are logical names.
If "DEFINE EMACSSRC [USER.EMACS.SRC]" is done then "[.emacs.src]fileio.c"
and "emacssrc:fileio.c" will again lead to the same file in different buffers.
The first problem is easy to solve by stripping of the dot at the end of the
filename. The second one is more diffcult. I have to translate the devicename
which may contain another logical name and a directory path. Some translations
start with an underscore, for reasons I don't understand, and I strip "_DUA0"
down to "DUA0". The translation normally recurses until the physical disk name
is reached. Excepted are HSC disks in a cluster. There the translation of e.g.
"DISK$V6" to "$3$DUA20" is too much. Therefore it stops if the translation
starts with a dollarsign. That scheme works allright as long as there are no
multiple translations. It fails e.g. when reading include files which can be
accessed via "SYS$SHARE" or "SYS$COMMON".
The next improvement is the possibility to read, insert, and do filename
expansions for files on remote DECnet nodes. It works for VMS and Ultrix
nodes and even for an IBM VM/CMS system which runs a DECnet emulator.
The runtime library function stat() and fstat() cannot supply all structure
fields for DECnet files. They are rather give up than returning the information
available. I had to emulate these functions using RMS calls to fill in the
data actually used by Emacs. To allow DECnet access to Ultrix nodes I had to
change the filename parsing. Traditionally are filenames where converted to
lowercase. That I had to suppress for foreign filespecs enclosed in double
quotes, e.g. node::"/user/me/Makefile".
There are a few more minor modifications. I wonder if the compatibility to
VMS version 4.4 and below is still needed. In add-log.el I propose to use the
same default file name "ChangeLog" for VMS as well and to allow to use the
old name "$CHANGE_LOG$.TXT" by changing a Lisp variable. In loaddefs.el
the extensions .for (VMS) and .ftn (Apollo) should be included to switch to
Fortran-mode. In startup.el (getenv "PWD") should not be executed for VMS
or one gets surprised if a Unixish symbol like "PWD :== SHOW DEFAULT" is
defined.
At last I added termcap entries for VT300 and the French minitel terminal.
*** /u/gnu/emacs-18.55/src/fileio.c Mon Nov 27 13:54:06 1989
--- /u/gnu/emacs/src/fileio.c Thu Dec 7 17:35:06 1989
***************
*** 50,55 ****
--- 50,58 ----
#include <rmsdef.h>
#include <fab.h>
#include <nam.h>
+ #include <descrip.h>
+ #include <lnmdef.h>
+ #include <ssdef.h>
#endif
#ifdef HAVE_TIMEVAL
***************
*** 112,117 ****
--- 115,125 ----
{
register unsigned char *beg;
register unsigned char *p;
+ register int len;
+ #ifdef VMS
+ unsigned char *copy;
+ int quoted;
+ #endif /* VMS */
CHECK_STRING (file, 0);
***************
*** 118,123 ****
--- 126,135 ----
beg = XSTRING (file)->data;
p = beg + XSTRING (file)->size;
+ #ifdef VMS
+ quoted = (p[-1] == '"');
+ #endif /* VMS */
+
while (p != beg && p[-1] != '/'
#ifdef VMS
&& p[-1] != ':' && p[-1] != ']' && p[-1] != '>'
***************
*** 124,132 ****
#endif /* VMS */
) p--;
! if (p == beg)
return Qnil;
! return make_string (beg, p - beg);
}
DEFUN ("file-name-nondirectory", Ffile_name_nondirectory, Sfile_name_nondirectory,
--- 136,152 ----
#endif /* VMS */
) p--;
! if (!(len = p - beg))
return Qnil;
! #ifdef VMS
! if (quoted) {
! /* keep closing quote in Decnet file spec */
! copy = (char *) alloca (++len);
! beg = strncpy (copy, beg, len - 1);
! beg[len - 1] = '"';
! }
! #endif
! return make_string (beg, len);
}
DEFUN ("file-name-nondirectory", Ffile_name_nondirectory, Sfile_name_nondirectory,
***************
*** 143,149 ****
CHECK_STRING (file, 0);
beg = XSTRING (file)->data;
! end = p = beg + XSTRING (file)->size;
while (p != beg && p[-1] != '/'
#ifdef VMS
--- 163,174 ----
CHECK_STRING (file, 0);
beg = XSTRING (file)->data;
! end = beg + XSTRING (file)->size;
! #ifdef VMS
! if (end != beg && end[-1] == '"')
! end--;
! #endif /* VMS */
! p = end;
while (p != beg && p[-1] != '/'
#ifdef VMS
***************
*** 378,383 ****
--- 403,413 ----
/* Process as Unix format: just remove any final slash.
But leave "/" unchanged; do not change it to "". */
strcpy (dst, src);
+ #ifdef VMS
+ /* Keep closing quote around Decnet file spec */
+ if (dst[slen] == '"' && dst[slen - 1] == '/' && slen > 2)
+ dst[slen] = 0, dst[slen - 1] = '"';
+ #endif /* VMS */
if (dst[slen] == '/' && slen > 1)
dst[slen] = 0;
return 1;
***************
*** 431,463 ****
int tlen;
unsigned char *target;
struct passwd *pw;
int lose;
! #ifdef VMS
unsigned char * colon = 0;
- unsigned char * close = 0;
unsigned char * slash = 0;
unsigned char * brack = 0;
int lbrack = 0, rbrack = 0;
! int dots = 0;
#endif /* VMS */
CHECK_STRING (name, 0);
#ifdef VMS
! /* Filenames on VMS are always upper case. */
! name = Fupcase (name);
#endif
! nm = XSTRING (name)->data;
/* If nm is absolute, flush ...// and detect /./ and /../.
If no /./ or /../ we can return right away. */
! if (
! nm[0] == '/'
! #ifdef VMS
! || index (nm, ':')
! #endif /* VMS */
! )
{
p = nm;
lose = 0;
--- 461,666 ----
int tlen;
unsigned char *target;
struct passwd *pw;
+ #ifndef VMS
int lose;
! #else
unsigned char * colon = 0;
unsigned char * slash = 0;
unsigned char * brack = 0;
+ #ifndef VMS4_4
int lbrack = 0, rbrack = 0;
! #endif
! unsigned char * lquote = 0;
! unsigned char * rquote = 0;
! int quoted = 0;
! int ulen;
! $DESCRIPTOR(tabnam,"LNM$DCL_LOGICAL");
! struct dsc$descriptor_s lognam;
! char logtrl[256];
! short lentrl;
! int max_index;
! struct item {
! short buf_len;
! short item_code;
! char *buf_addr;
! short *ret_len;
! };
! struct {
! struct item itemlist[2];
! int listend;
! } itmlst = { sizeof (logtrl) - 1, LNM$_STRING, logtrl, &lentrl,
! sizeof (max_index), LNM$_MAX_INDEX, &max_index, 0,
! 0 };
#endif /* VMS */
CHECK_STRING (name, 0);
+ nm = XSTRING (name)->data;
#ifdef VMS
! /* Filenames on VMS are always upper case, except in quoted strings. */
! p = (char *) alloca (strlen (nm) + 2);
! nm = strcpy (p, nm);
! for (p = nm; p[0]; p++ ) {
! if (p[0] == '"')
! quoted = !quoted;
! else if (!quoted)
! switch (p[0]) {
! case '<': p[0] = '['; break;
! case '>': p[0] = ']'; break;
! default: p[0] = UPCASE (p[0]);
! }
! }
! if (quoted) {
! /* append matching " if missing */
! *p++ = '"';
! *p = '\0';
! }
! if (p[-1] == '.')
! /* shorted "FILE." to "FILE" */
! p[-1] = '\0';
!
! /* find in nm the last occurence of a file specification in any of the forms:
! node::"/pathname"
! node::dev:[dir]file.type
! dev:[dir]file.type
! [dir]file.type
! /pathname
! ~user/pathname
! */
!
! for (p = nm; p[0]; p++) {
! if (lquote && rquote) {
! /* if "..."..., move nm following closing " */
! nm = p;
! lquote = 0;
! rquote = 0;
! }
! switch (p[0]) {
! case '"':
! if (lquote)
! rquote = p;
! else {
! /* if dev:node::"...", move nm to node:: */
! if (colon && colon > nm)
! nm = colon + 1;
! colon = 0;
! /* if [dir]node::"...", move nm to node:: */
! if (brack && brack > nm)
! nm = brack + 1;
! brack = 0;
! #ifndef VMS4_4
! lbrack = rbrack = 0;
#endif
+ /* if /pathname/node::"...", move nm to node:: */
+ if (slash && slash > nm)
+ nm = slash + 1;
+ slash = 0;
+ lquote = p;
+ }
+ break;
+ case ':':
+ if (!lquote) { /* don't interprete quoted part */
+ /* if dev:node:: or dev1:dev2:, move nm to node:: or dev2: */
+ if (colon && colon > nm)
+ nm = colon + 1;
+ colon = 0;
+ /* if [dir]node:: or [dir]dev:, move nm to node:: or dev: */
+ if (brack && brack > nm)
+ nm = brack + 1;
+ brack = 0;
+ #ifndef VMS4_4
+ lbrack = rbrack = 0;
+ #endif
+ /* if /path/node:: or /path/dev:, move nm to node:: or dev: */
+ if (slash && slash > nm)
+ nm = slash + 1;
+ slash = 0;
+ if (p[1] == ':')
+ p++; /* skip second colon in node:: */
+ else
+ colon = p; /* set colon to dev: */
+ }
+ break;
+ case '[':
+ if (!lquote) { /* don't interprete quoted part */
+ /* if [], discard previous part and use current directory lateron */
+ if (p[1] == ']') {
+ nm = p;
+ brack = 0;
+ #ifndef VMS4_4
+ lbrack = rbrack = 0;
+ #endif
+ colon = 0;
+ slash = 0;
+ }
+ #ifndef VMS4_4
+ lbrack++;
+ #endif
+ }
+ break;
+ case ']':
+ if (!lquote) { /* don't interprete quoted part */
+ brack = p;
+ rbrack++;
+ }
+ break;
+ case '~':
+ if (!lquote) { /* don't interprete quoted part */
+ /* if ...~, move nm to ~ */
+ colon = 0;
+ brack = 0;
+ #ifndef VMS4_4
+ lbrack = rbrack = 0;
+ #endif
+ slash = 0;
+ }
+ break;
+ case '/':
+ if (lquote) {
+ /* if node::"/pathname//, remove /pathname/ */
+ if (p[1] == '/')
+ p = strcpy (lquote + 1, p + 1);
+ }
+ else {
+ /* if dev:/, move nm to / */
+ if (colon && colon > nm)
+ nm = colon + 1;
+ colon = 0;
+ /* if [dir]/, move nm to / */
+ if (brack && brack > nm)
+ nm = brack + 1;
+ brack = 0;
+ #ifndef VMS4_4
+ lbrack = rbrack = 0;
+ #endif
+ /* if /pathname//, move nm to last / */
+ if (p[1] == '/')
+ nm = ++p;
+ slash = p;
+ }
+ break;
+ #ifndef VMS4_4
+ case '-':
+ if (!lquote) {
+ /* VMS pre V4.4, convert '-'s in filenames. */
+ if (lbrack == rbrack && p[-1] != ';')
+ p[0] == '_';
+ }
+ break;
+ #endif /* VMS4_4 */
+ }
+ }
! /* if node::..., return immediately */
! if ((p = index (nm, ':')) && p[1] == ':')
! return build_string (nm);
+ #else /* not VMS */
+
/* If nm is absolute, flush ...// and detect /./ and /../.
If no /./ or /../ we can return right away. */
!
! if (nm[0] == '/')
{
p = nm;
lose = 0;
***************
*** 470,562 ****
#endif /* APOLLO */
)
nm = p + 1;
! if (p[0] == '/' && p[1] == '~')
! nm = p + 1, lose = 1;
if (p[0] == '/' && p[1] == '.'
&& (p[2] == '/' || p[2] == 0
|| (p[2] == '.' && (p[3] == '/' || p[3] == 0))))
lose = 1;
- #ifdef VMS
- if (p[0] == '\\')
- lose = 1;
- if (p[0] == '/') {
- /* if dev:[dir]/, move nm to / */
- if (!slash && p > nm && (brack || colon)) {
- nm = (brack ? brack + 1 : colon + 1);
- lbrack = rbrack = 0;
- brack = 0;
- colon = 0;
- }
- slash = p;
- }
- if (p[0] == '-')
- #ifndef VMS4_4
- /* VMS pre V4.4,convert '-'s in filenames. */
- if (lbrack == rbrack)
- {
- if (dots < 2) /* this is to allow negative version numbers */
- p[0] = '_';
- }
- else
- #endif /* VMS4_4 */
- if (lbrack > rbrack &&
- ((p[-1] == '.' || p[-1] == '[' || p[-1] == '<') &&
- (p[1] == '.' || p[1] == ']' || p[1] == '>')))
- lose = 1;
- #ifndef VMS4_4
- else
- p[0] = '_';
- #endif /* VMS4_4 */
- /* count open brackets, reset close bracket pointer */
- if (p[0] == '[' || p[0] == '<')
- lbrack++, brack = 0;
- /* count close brackets, set close bracket pointer */
- if (p[0] == ']' || p[0] == '>')
- rbrack++, brack = p;
- /* detect ][ or >< */
- if ((p[0] == ']' || p[0] == '>') && (p[1] == '[' || p[1] == '<'))
- lose = 1;
- if ((p[0] == ':' || p[0] == ']' || p[0] == '>') && p[1] == '~')
- nm = p + 1, lose = 1;
- if (p[0] == ':' && (colon || slash))
- /* if dev1:[dir]dev2:, move nm to dev2: */
- if (brack)
- {
- nm = brack + 1;
- brack = 0;
- }
- /* if /pathname/dev:, move nm to dev: */
- else if (slash)
- nm = slash + 1;
- /* if node::dev:, move colon following dev */
- else if (colon && colon[-1] == ':')
- colon = p;
- /* if dev1:dev2:, move nm to dev2: */
- else if (colon && colon[-1] != ':')
- {
- nm = colon + 1;
- colon = 0;
- }
- if (p[0] == ':' && !colon)
- {
- if (p[1] == ':')
p++;
- colon = p;
}
- if (lbrack == rbrack)
- if (p[0] == ';')
- dots = 2;
- else if (p[0] == '.')
- dots++;
- #endif /* VMS */
- p++;
- }
if (!lose)
{
- #ifdef VMS
- if (index (nm, '/'))
- return build_string (sys_translate_unix (nm));
- #endif /* VMS */
if (nm == XSTRING (name)->data)
return name;
return build_string (nm);
--- 673,690 ----
#endif /* APOLLO */
)
nm = p + 1;
! if (p[0] == '~') {
! if (p > nm && p[-1] == '/')
! nm = p, lose = 1;
! }
if (p[0] == '/' && p[1] == '.'
&& (p[2] == '/' || p[2] == 0
|| (p[2] == '.' && (p[3] == '/' || p[3] == 0))))
lose = 1;
p++;
}
if (!lose)
{
if (nm == XSTRING (name)->data)
return name;
return build_string (nm);
***************
*** 563,573 ****
}
}
/* Now determine directory to start with and put it in newdir */
newdir = 0;
! if (nm[0] == '~') /* prefix ~ */
if (nm[1] == '/'
#ifdef VMS
|| nm[1] == ':'
--- 691,703 ----
}
}
+ #endif /* VMS */
+
/* Now determine directory to start with and put it in newdir */
newdir = 0;
! if (nm[0] == '~') { /* prefix ~ */
if (nm[1] == '/'
#ifdef VMS
|| nm[1] == ':'
***************
*** 577,585 ****
if (!(newdir = (unsigned char *) egetenv ("HOME")))
newdir = (unsigned char *) "";
nm++;
- #ifdef VMS
- nm++; /* Don't leave the slash in nm. */
- #endif /* VMS */
}
else /* ~user/filename */
{
--- 707,712 ----
***************
*** 596,609 ****
if (!pw)
error ("\"%s\" isn't a registered user", o + 1);
- #ifdef VMS
- nm = p + 1; /* skip the terminator */
- #else
nm = p;
- #endif /* VMS */
newdir = (unsigned char *) pw -> pw_dir;
}
if (nm[0] != '/'
#ifdef VMS
&& !index (nm, ':')
--- 723,753 ----
if (!pw)
error ("\"%s\" isn't a registered user", o + 1);
nm = p;
newdir = (unsigned char *) pw -> pw_dir;
}
+ #ifdef VMS
+ if (nm[0]) /* nm was not ~ alone */
+ if (index (nm + 1, '/')) {
+ nm--;
+ nm[0] = '.';
+ nm[1] = '/';
+ }
+ else
+ nm++;
+ #endif /* VMS */
+ }
+ #ifdef VMS
+ if (nm[0] == '[' && nm[1] == ']') {
+ /* if [], use current device and directory */
+ p = egetenv ("PATH");
+ newdir = (char *) alloca (strlen (p) + 1);
+ strcpy (newdir, p);
+ nm += 2;
+ }
+ #endif
+
if (nm[0] != '/'
#ifdef VMS
&& !index (nm, ':')
***************
*** 633,641 ****
}
strcat (target, nm);
#ifdef VMS
! if (index (target, '/'))
! strcpy (target, sys_translate_unix (target));
#endif /* VMS */
/* Now canonicalize by removing /. and /foo/.. if they appear */
--- 777,826 ----
}
strcat (target, nm);
+
#ifdef VMS
! if (index (target, '/')) {
! p = sys_translate_unix (target);
! ulen = strlen (p) + 1;
! if (ulen > tlen) {
! tlen = ulen;
! target = (char *) alloca (tlen);
! }
! strcpy (target, p);
! }
!
! for (p = target; p[0]; p++)
! p[0] = UPCASE (p[0]); /* getenv returned lower case "HOME" and "PATH" */
!
! /* recursive logical name translation of device names until
! * file spec contains node name or
! * no translation exists or
! * name has multiple translations or
! * translation would be a HSC disk, e.g. $3$DUA20
! */
! while ((p = index (target, ':')) && p != target && p[1] != ':') {
! lognam.dsc$w_length = p - target;
! lognam.dsc$b_dtype = DSC$K_DTYPE_T;
! lognam.dsc$b_class = DSC$K_CLASS_S;
! lognam.dsc$a_pointer = target;
! if (sys$trnlnm (0, &tabnam, &lognam, 0, &itmlst) != SS$_NORMAL)
! break; /* no translation */
! if (max_index != 0)
! break; /* more than one translation */
! logtrl[lentrl] = '\0';
! if (!index (logtrl, ':'))
! break; /* translation is not a device name */
! o = logtrl;
! while (o[0] == '_')
! o++; /* don't discriminate between DUA0 and _DUA0 */
! if (o[0] == '$')
! break; /* don't go as far as HSC names */
! /* replace dev: by translation */
! tlen = strlen (o) + strlen (p + 1) + 1;
! target = (char *) alloca (tlen);
! strcpy (target, o);
! strcat (target, p + 1);
! }
#endif /* VMS */
/* Now canonicalize by removing /. and /foo/.. if they appear */
***************
*** 646,675 ****
while (*p)
{
#ifdef VMS
! if (*p != ']' && *p != '>' && *p != '-')
{
if (*p == '\\')
p++;
*o++ = *p++;
}
! else if ((p[0] == ']' || p[0] == '>') && p[0] == p[1] + 2)
! /* brackets are offset from each other by 2 */
{
p += 2;
if (*p != '.' && *p != '-' && o[-1] != '.')
/* convert [foo][bar] to [bar] */
! while (o[-1] != '[' && o[-1] != '<')
o--;
else if (*p == '-' && *o != '.')
*--p = '.';
}
else if (p[0] == '-' && o[-1] == '.' &&
! (p[1] == '.' || p[1] == ']' || p[1] == '>'))
! /* flush .foo.- ; leave - if stopped by '[' or '<' */
{
do
o--;
! while (o[-1] != '.' && o[-1] != '[' && o[-1] != '<');
if (p[1] == '.') /* foo.-.bar ==> bar*/
p += 2;
else if (o[-1] == '.') /* '.foo.-]' ==> ']' */
--- 831,859 ----
while (*p)
{
#ifdef VMS
! if (*p != ']' && *p != '-')
{
if (*p == '\\')
p++;
*o++ = *p++;
}
! else if (p[0] == ']' && p[1] == '[')
{
p += 2;
if (*p != '.' && *p != '-' && o[-1] != '.')
/* convert [foo][bar] to [bar] */
! while (o[-1] != '[')
o--;
else if (*p == '-' && *o != '.')
*--p = '.';
}
else if (p[0] == '-' && o[-1] == '.' &&
! (p[1] == '.' || p[1] == ']'))
! /* flush .foo.- ; leave - if stopped by '[' */
{
do
o--;
! while (o[-1] != '.' && o[-1] != '[');
if (p[1] == '.') /* foo.-.bar ==> bar*/
p += 2;
else if (o[-1] == '.') /* '.foo.-]' ==> ']' */
***************
*** 680,687 ****
{
#ifndef VMS4_4
if (*p == '-' &&
! o[-1] != '[' && o[-1] != '<' && o[-1] != '.' &&
! p[1] != ']' && p[1] != '>' && p[1] != '.')
*p = '_';
#endif /* VMS4_4 */
*o++ = *p++;
--- 864,871 ----
{
#ifndef VMS4_4
if (*p == '-' &&
! o[-1] != '[' && o[-1] != '.' &&
! p[1] != ']' && p[1] != '.')
*p = '_';
#endif /* VMS4_4 */
*o++ = *p++;
***************
*** 727,732 ****
--- 911,917 ----
#endif /* not VMS */
}
+
return make_string (target, o - target);
}
***************
*** 748,753 ****
--- 933,941 ----
int total = 0;
int substituted = 0;
unsigned char *xnm;
+ #ifdef VMS
+ int quoted = 0;
+ #endif /* VMS */
CHECK_STRING (string, 0);
***************
*** 758,763 ****
--- 946,957 ----
for (p = nm; p != endp; p++)
{
+ #ifdef VMS
+ if (p[0] == '"')
+ quoted = !quoted;
+ if (quoted)
+ continue; /* don't play games with quoted strings */
+ #endif /* VMS */
if ((p[0] == '~' ||
#ifdef APOLLO
/* // at start of file name is meaningful in Apollo system */
***************
*** 1486,1492 ****
--- 1680,1690 ----
fd = -1;
#ifndef APOLLO
+ #ifndef VMS
if (stat (XSTRING (filename)->data, &st) < 0
+ #else
+ if (decnet_stat (XSTRING (filename)->data, &st) < 0
+ #endif /* not VMS */
|| (fd = open (XSTRING (filename)->data, 0)) < 0)
#else
if ((fd = open (XSTRING (filename)->data, 0)) < 0
***************
*** 1751,1757 ****
--- 1949,1966 ----
if (fname)
{
if (!failure)
+ {
+ char *fnnv;
+ if ((fnnv = index (fname, ';')))
+ {
+ /* chop off the version number before renaming */
+ int lnv = fnnv - fname;
+ fnnv = (char *) alloca (lnv + 1);
+ fname = strncpy (fnnv, fname, lnv);
+ fname[lnv] = '\0';
+ }
failure = (rename (fn, fname) != 0);
+ }
fn = fname;
}
#endif /* VMS */
***************
*** 1841,1847 ****
--- 2050,2060 ----
if (XTYPE (b->filename) != Lisp_String) return Qt;
if (b->modtime == 0) return Qt;
+ #ifndef VMS
if (stat (XSTRING (b->filename)->data, &st) < 0)
+ #else
+ if (decnet_stat (XSTRING (b->filename)->data, &st) < 0)
+ #endif
{
/* If the file doesn't exist now and didn't exist before,
we say that it isn't modified, provided the error is a tame one. */
***************
*** 2079,2084 ****
--- 2292,2303 ----
dir = bf_cur->directory;
if (NULL (defalt))
defalt = bf_cur->filename;
+
+ #ifdef VMS
+ count = XSTRING (dir)->size - 1;
+ if (XSTRING (dir)->data[count] == '"')
+ dir = make_string (XSTRING (dir)->data, count);
+ #endif /* VMS */
/* If dir starts with user's homedir, change that to ~. */
homedir = (char *) egetenv ("HOME");
*** /u/gnu/emacs-18.55/src/sysdep.c Mon Nov 27 13:54:11 1989
--- /u/gnu/emacs/src/sysdep.c Thu Dec 7 17:35:06 1989
***************
*** 1405,1410 ****
--- 1405,1411 ----
if ((end = index (sp, ':')) != 0)
*end = '\0';
+ if (sp[0] == '_') sp++; /* translation may go too deep */
}
strcpy (system_name_saved, sp);
#else /* not VMS */
***************
*** 2252,2260 ****
--- 2253,2264 ----
char *filename; /* name of directory */
{
register DIR *dirp; /* -> malloc'ed storage */
+ #ifndef VMS
register int fd; /* file descriptor for read */
struct stat sbuf; /* result of fstat() */
+ #endif
+ #ifndef VMS
fd = sys_open (filename, 0);
if (fd < 0)
return 0;
***************
*** 2269,2275 ****
--- 2273,2314 ----
dirp->dd_fd = fd;
dirp->dd_loc = dirp->dd_size = 0; /* refill needed */
+ #else /* VMS */
+ if ((dirp = (DIR *) malloc (sizeof (DIR))) == 0)
+ return 0;
+ dirp->dd_loc = 0;
+ dirp->dd_size = strlen (filename);
+ if (filename[dirp->dd_size - 1] == '"') {
+ /* expand node::"/pathname" to node ::"/pathname/.*"
+ wildcard * does not find names starting with dot!?! */
+ strcpy (dirp->dd_buf, filename);
+ dirp->dd_buf[dirp->dd_size - 1] = '/';
+ dirp->dd_buf[dirp->dd_size] = '.'; dirp->dd_size++;
+ dirp->dd_buf[dirp->dd_size] = '*'; dirp->dd_size++;
+ dirp->dd_buf[dirp->dd_size] = '"'; dirp->dd_size++;
+ dirp->dd_buf[dirp->dd_size] = '\0';
+ }
+ else {
+ /* expand dev:[dir]sub.dir to dev:[dir.sub]*.* */
+ file_name_as_directory (dirp->dd_buf, filename);
+ strcat (dirp->dd_buf, "*.*");
+ dirp->dd_size = strlen (dirp->dd_buf);
+ }
+
+ /* If we don't find a file either the directory does not exist
+ or it is empty; in the second case on Unix opendir() would
+ succeed. For our application this incompatibility is allright. */
+ if (!readdir (dirp)) {
+ closedir (dirp);
+ return 0;
+ }
+
+ /* clear the internal fields used by RMS */
+ lib$find_file_end (&dirp->dd_loc);
+ dirp->dd_loc = 0;
+ #endif /* VMS */
+
return dirp;
}
***************
*** 2277,2283 ****
--- 2316,2326 ----
closedir (dirp)
register DIR *dirp; /* stream from opendir() */
{
+ #ifndef VMS
sys_close (dirp->dd_fd);
+ #else
+ lib$find_file_end (&dirp->dd_loc);
+ #endif
free ((char *) dirp);
}
***************
*** 2293,2298 ****
--- 2336,2416 ----
struct direct dir_static; /* simulated directory contents */
+ #ifdef VMS
+ /* readdir_vms does the real work for readdir and readdirver */
+
+ struct direct *
+ readdir_vms (dirp, flag)
+ register DIR *dirp; /* stream from opendir() */
+ register int flag; /* 0: only last version; 1: all versions */
+ {
+ register char *p;
+ struct dsc$descriptor_s dsc_in, dsc_out;
+ int quoted = (dirp->dd_buf [dirp->dd_size - 1] == '"');
+
+ /* append version wildcard when first called */
+ if (flag && !dirp->dd_loc && !quoted) {
+ dirp->dd_buf [dirp->dd_size] = ';'; dirp->dd_size++;
+ dirp->dd_buf [dirp->dd_size] = '*'; dirp->dd_size++;
+ dirp->dd_buf [dirp->dd_size] = '\0';
+ }
+
+ /* build descriptor for wildcard string */
+ dsc_in.dsc$w_length = dirp->dd_size;
+ dsc_in.dsc$a_pointer = dirp->dd_buf;
+ dsc_in.dsc$b_class = DSC$K_CLASS_S;
+ dsc_in.dsc$b_dtype = DSC$K_DTYPE_T;
+
+ /* build descriptor for next matching file */
+ dsc_out.dsc$w_length = 0;
+ dsc_out.dsc$a_pointer = 0;
+ dsc_out.dsc$b_class = DSC$K_CLASS_D;
+ dsc_out.dsc$b_dtype = DSC$K_DTYPE_T;
+
+ if (lib$find_file (&dsc_in, &dsc_out, &dirp->dd_loc, 0, 0, 0, 0) != RMS$_NORMAL) {
+ if (quoted && dirp->dd_buf [dirp->dd_size - 3] == '.') {
+ /* There is no wildcard construct too find all files in a Ultrix directory
+ via Decnet. `node::"/pathname/.*"' gets all files starting with a dot
+ and `node::"/pathname/*"' gets the rest.
+ When the `.*' pattern set in opendir runs out we continue with `*' */
+ dirp->dd_size--;
+ dirp->dd_buf [dirp->dd_size] = '\0';
+ dirp->dd_buf [dirp->dd_size - 1] = '"';
+ dirp->dd_buf [dirp->dd_size - 2] = '*';
+ lib$find_file_end (&dirp->dd_loc);
+ dirp->dd_loc = 0;
+ return readdir_vms (dirp, flag);
+ }
+ return 0;
+ }
+
+ strncpy (dir_static.d_name, dsc_out.dsc$a_pointer, dsc_out.dsc$w_length);
+ dir_static.d_name [dsc_out.dsc$w_length] = '\0';
+
+ if ((p = rindex (dir_static.d_name, '/'))) {
+ /* extract filename from node::"/pathname/filename" */
+ strcpy (dir_static.d_name, p + 1);
+ dir_static.d_namlen = strlen (dir_static.d_name);
+ if (dir_static.d_name [dir_static.d_namlen - 1] == '"') {
+ dir_static.d_name [dir_static.d_namlen - 1] = '\0';
+ dir_static.d_namlen--;
+ }
+ }
+ else if ((p = index (dir_static.d_name, ']'))
+ || (p = index (dir_static.d_name, '>'))
+ || (p = rindex (dir_static.d_name, ':'))) {
+ /* extract file.ext;version */
+ strcpy (dir_static.d_name, p + 1);
+ if (!flag && (p = index (dir_static.d_name, ';')))
+ *p = '\0'; /* remove ;version */
+ dir_static.d_namlen = strlen (dir_static.d_name);
+ }
+
+ dir_static.d_ino = 1;
+ return &dir_static;
+ }
+ #endif /* VMS */
+
/* ARGUSED */
struct direct *
readdir (dirp)
***************
*** 2300,2309 ****
{
#ifndef VMS
register struct olddir *dp; /* -> directory data */
- #else /* VMS */
- register struct dir$_name *dp; /* -> directory data */
- register struct dir$_version *dv; /* -> version data */
- #endif /* VMS */
for (; ;)
{
--- 2418,2423 ----
***************
*** 2314,2320 ****
&& (dirp->dd_size = sys_read (dirp->dd_fd, dirp->dd_buf, DIRBLKSIZ)) <= 0)
return 0;
- #ifndef VMS
dp = (struct olddir *) &dirp->dd_buf[dirp->dd_loc];
dirp->dd_loc += sizeof (struct olddir);
--- 2428,2433 ----
***************
*** 2329,2351 ****
+ dir_static.d_namlen - dir_static.d_namlen % 4;
return &dir_static; /* -> simulated structure */
}
#else /* VMS */
! dp = (struct dir$_name *) dirp->dd_buf;
! if (dirp->dd_loc == 0)
! dirp->dd_loc = (dp->dir$b_namecount&1) ? dp->dir$b_namecount + 1
! : dp->dir$b_namecount;
! dv = (struct dir$_version *)&dp->dir$t_name[dirp->dd_loc];
! dir_static.d_ino = dv->dir$w_fid_num;
! dir_static.d_namlen = dp->dir$b_namecount;
! dir_static.d_reclen = sizeof (struct direct)
! - MAXNAMLEN + 3
! + dir_static.d_namlen - dir_static.d_namlen % 4;
! strncpy (dir_static.d_name, dp->dir$t_name, dp->dir$b_namecount);
! dir_static.d_name[dir_static.d_namlen] = '\0';
! dirp->dd_loc = dirp->dd_size; /* only one record at a time */
! return &dir_static;
#endif /* VMS */
- }
}
#ifdef VMS
--- 2442,2451 ----
+ dir_static.d_namlen - dir_static.d_namlen % 4;
return &dir_static; /* -> simulated structure */
}
+ }
#else /* VMS */
! return readdir_vms (dirp, 0);
#endif /* VMS */
}
#ifdef VMS
***************
*** 2357,2387 ****
readdirver (dirp)
register DIR *dirp; /* stream from opendir() */
{
! register struct dir$_name *dp; /* -> directory data */
! register struct dir$_version *dv; /* -> version data */
!
! if (dirp->dd_loc >= dirp->dd_size - sizeof (struct dir$_name))
! dirp->dd_loc = dirp->dd_size = 0;
!
! if (dirp->dd_size == 0 /* refill buffer */
! && (dirp->dd_size = sys_read (dirp->dd_fd, dirp->dd_buf, DIRBLKSIZ)) <= 0)
! return 0;
!
! dp = (struct dir$_name *) dirp->dd_buf;
! if (dirp->dd_loc == 0)
! dirp->dd_loc = (dp->dir$b_namecount & 1) ? dp->dir$b_namecount + 1
! : dp->dir$b_namecount;
! dv = (struct dir$_version *) &dp->dir$t_name[dirp->dd_loc];
! strncpy (dir_static.d_name, dp->dir$t_name, dp->dir$b_namecount);
! sprintf (&dir_static.d_name[dp->dir$b_namecount], ";%d", dv->dir$w_version);
! dir_static.d_namlen = strlen (dir_static.d_name);
! dir_static.d_ino = dv->dir$w_fid_num;
! dir_static.d_reclen = sizeof (struct direct) - MAXNAMLEN + 3
! + dir_static.d_namlen - dir_static.d_namlen % 4;
! dirp->dd_loc = ((char *) (++dv) - dp->dir$t_name);
! return &dir_static;
}
-
#endif /* VMS */
#endif /* NONSYSTEM_DIR_LIBRARY */
--- 2457,2464 ----
readdirver (dirp)
register DIR *dirp; /* stream from opendir() */
{
! return readdir_vms (dirp, 1);
}
#endif /* VMS */
#endif /* NONSYSTEM_DIR_LIBRARY */
***************
*** 2450,2455 ****
--- 2527,2533 ----
{
static char *user = NULL;
char dir_fn[512];
+ struct stat sbuf;
/* translate possible directory spec into .DIR file name, so brain-dead
* access() can treat the directory like a file. */
***************
*** 2456,2463 ****
if (directory_file_name (path, dir_fn))
path = dir_fn;
! if (mode == F_OK)
! return access (path, mode);
if (user == NULL && (user = getenv ("USER")) == NULL)
return -1;
{
--- 2534,2569 ----
if (directory_file_name (path, dir_fn))
path = dir_fn;
! if (!access (path, mode))
! return 0;
!
! /* access() does not deal with Decnet files. For file existance and
! read access we can work around it and for the rest we don't care. */
!
! if (mode == F_OK) { /* try to find the file */
! struct dsc$descriptor_s dsc_in, dsc_out;
! int context = 0;
! int status;
!
! dsc_in.dsc$w_length = strlen (path);
! dsc_in.dsc$a_pointer = path;
! dsc_in.dsc$b_class = DSC$K_CLASS_S;
! dsc_in.dsc$b_dtype = DSC$K_DTYPE_T;
!
! dsc_out.dsc$w_length = 0;
! dsc_out.dsc$a_pointer = 0;
! dsc_out.dsc$b_class = DSC$K_CLASS_D;
! dsc_out.dsc$b_dtype = DSC$K_DTYPE_T;
!
! status = lib$find_file (&dsc_in, &dsc_out, &context, 0, 0, 0, 0);
! lib$find_file_end (&context);
!
! return (status == RMS$_NORMAL ? 0 : -1);
! }
!
! if (mode == R_OK) /* try to open the file */
! return decnet_stat (path, &sbuf);
!
if (user == NULL && (user = getenv ("USER")) == NULL)
return -1;
{
***************
*** 3516,3521 ****
--- 3622,3741 ----
srandom (seed)
{
srand (seed);
+ }
+
+ /* emulation of stat() which works also for Decnet files */
+ int
+ decnet_stat (path, info)
+ char *path;
+ struct stat *info;
+ {
+ /* try stat() from runtime library first */
+ if (stat (path, info) == 0)
+ return 0;
+
+ {
+ struct FAB fab = cc$rms_fab;
+ struct NAM nam = cc$rms_nam;
+ struct XABDAT xabdat = cc$rms_xabdat;
+ struct XABFHC xabfhc = cc$rms_xabfhc;
+ struct XABPRO xabpro = cc$rms_xabpro;
+ char rsa[NAM$C_MAXRSS];
+ char *p;
+ int l;
+ int prot, mode;
+
+ fab.fab$l_fna = path;
+ fab.fab$b_fns = strlen (path);
+ fab.fab$l_nam = &nam;
+ nam.nam$l_rsa = rsa;
+ nam.nam$b_rss = NAM$C_MAXRSS;
+ fab.fab$l_xab = &xabdat;
+ xabdat.xab$l_nxt = &xabfhc;
+ xabfhc.xab$l_nxt = &xabpro;
+
+ if (sys$open (&fab, 0, 0) != RMS$_NORMAL)
+ return 0;
+
+ /* The information for st_dev comes from nam.nam$t_dvi which is not filled
+ for Decnet files. We could fill in the device name from the resultant
+ file specification. But this would introduce a storage leak by using
+ malloc(). Hopefully nobody wants to refer to this field. */
+ info->st_dev = "";
+
+ info->st_ino[0] = nam.nam$w_fid[0];
+ info->st_ino[1] = nam.nam$w_fid[1];
+ info->st_ino[2] = nam.nam$w_fid[2];
+
+ /* There is (to my knowledge) no save way to find out if a Decnet file is
+ a directory. We assume that nobody will give extension ".DIR" to a
+ regular file. Don't care about non-file entities. */
+ mode = (nam.nam$b_type == 4 && strncmp (nam.nam$l_type,".DIR",4) == 0) ? S_IFDIR : S_IFREG;
+
+ /* reshuffle the VMS protection to Unix mode
+ (ignore System and Delete permissions):
+
+ -----------------------------------------
+ | World | Group | Owner | System | VMS protection mask
+ | D E W R | D E W R | D E W R | D E W R | ( 1 means access denied )
+ -----------------------------------------
+
+ -------------------------
+ | Owner | Group | World | Unix protection mask
+ | r w x | r w x | r w x | ( 1 means access allowed )
+ -------------------------
+ */
+ prot = ~ xabpro.xab$w_pro;
+ if (prot>>14 & 1) mode |= 1<<0;
+ if (prot>>13 & 1) mode |= 1<<1;
+ if (prot>>12 & 1) mode |= 1<<2;
+ if (prot>>10 & 1) mode |= 1<<3;
+ if (prot>> 9 & 1) mode |= 1<<4;
+ if (prot>> 8 & 1) mode |= 1<<5;
+ if (prot>> 6 & 1) mode |= 1<<6;
+ if (prot>> 5 & 1) mode |= 1<<7;
+ if (prot>> 4 & 1) mode |= 1<<8;
+ info->st_mode = mode;
+
+ info->st_nlink = 0;
+ info->st_uid = xabpro.xab$l_uic;
+ info->st_gid = xabpro.xab$l_uic >> 16;
+ info->st_rdev = 0;
+
+ /* Unfortunately RMS does not return the size of a disk block.
+ For VMS it is 512 bytes and from xab$l_ebk and xab$w_ffb we can compute
+ the exact size.
+ For an IBM-VM/CMS host connected via Interlink (`<' replaces `[' as
+ directory delimiters) we have to assume the largest possible block size
+ and let read() run into end-of-file. */
+ info->st_size = (nam.nam$b_dir != 0 && nam.nam$l_dir[0] == '<') ?
+ xabfhc.xab$l_hbk * 4096 : (xabfhc.xab$l_ebk - 1) * 512 + xabfhc.xab$w_ffb;
+
+ info->st_atime = SHELL$FIX_TIME (&xabdat.xab$q_rdt);
+ info->st_mtime = SHELL$FIX_TIME (&xabdat.xab$q_rdt);
+ info->st_ctime = SHELL$FIX_TIME (&xabdat.xab$q_cdt);
+
+ info->st_fab_rfm = fab.fab$b_rfm;
+ info->st_fab_rat = fab.fab$b_rat;
+ info->st_fab_fsz = fab.fab$b_fsz;
+ info->st_fab_mrs = fab.fab$w_mrs;
+
+ sys$close (&fab, 0, 0);
+ }
+ return 0;
+ }
+
+ int
+ decnet_fstat (fd, info)
+ int fd;
+ struct stat *info;
+ {
+ char path[L_nettmpnam];
+
+ if (fstat (fd, info) == 0)
+ return 0;
+
+ return decnet_stat(getname (fd, path), info);
}
#endif /* VMS */
*** /u/gnu/emacs-18.55/lisp/add-log.el Mon Nov 27 13:41:17 1989
--- /u/gnu/emacs/lisp/add-log.el Wed Nov 29 02:13:43 1989
***************
*** 19,24 ****
--- 19,27 ----
;; and this notice must be preserved on all copies.
+ (defvar change-log-default-file "ChangeLog"
+ "*Default file name used by add-change-log-entry.")
+
(defun add-change-log-entry (whoami file-name &optional other-window)
"Find change log file and add an entry for today.
First arg (interactive prefix) non-nil means prompt for user name and site.
***************
*** 26,38 ****
Optional third arg OTHER-WINDOW non-nil means visit in other window."
(interactive
(list current-prefix-arg
! (let ((default
! (if (eq system-type 'vax-vms) "$CHANGE_LOG$.TXT" "ChangeLog")))
(expand-file-name
(read-file-name (format "Log file (default %s): " default)
nil default)))))
! (let* ((default
! (if (eq system-type 'vax-vms) "$CHANGE_LOG$.TXT" "ChangeLog"))
(full-name (if whoami
(read-input "Full name: " (user-full-name))
(user-full-name)))
--- 29,39 ----
Optional third arg OTHER-WINDOW non-nil means visit in other window."
(interactive
(list current-prefix-arg
! (let ((default change-log-default-file))
(expand-file-name
(read-file-name (format "Log file (default %s): " default)
nil default)))))
! (let* ((default change-log-default-file)
(full-name (if whoami
(read-input "Full name: " (user-full-name))
(user-full-name)))
*** /u/gnu/emacs-18.55/lisp/loaddefs.el Mon Nov 27 13:41:21 1989
--- /u/gnu/emacs/lisp/loaddefs.el Wed Nov 29 02:13:43 1989
***************
*** 195,200 ****
--- 195,202 ----
("\\.y$" . c-mode)
("\\.cc$" . c-mode)
("\\.scm.[0-9]*$" . scheme-mode)
+ ("\\.for$" . fortran-mode) ; Vax Fortran
+ ("\\.ftn$" . fortran-mode) ; Apollo
;; .emacs following a directory delimiter
;; in either Unix or VMS syntax.
("[]>:/]\\..*emacs" . emacs-lisp-mode)
*** /u/gnu/emacs-18.55/lisp/startup.el Mon Nov 27 13:41:22 1989
--- /u/gnu/emacs/lisp/startup.el Wed Nov 29 02:13:43 1989
***************
*** 80,86 ****
(message "Back to top level.")
(setq command-line-processed t)
;; In presence of symlinks, switch to cleaner form of default directory.
! (if (getenv "PWD")
(setq default-directory (file-name-as-directory (getenv "PWD"))))
(unwind-protect
(command-line)
--- 80,86 ----
(message "Back to top level.")
(setq command-line-processed t)
;; In presence of symlinks, switch to cleaner form of default directory.
! (if (and (not (eq system-type 'vax-vms)) (getenv "PWD"))
(setq default-directory (file-name-as-directory (getenv "PWD"))))
(unwind-protect
(command-line)
*** /u/gnu/emacs-18.55/etc/termcap.dat Mon Nov 27 14:06:47 1989
--- /u/gnu/emacs/etc/termcap.dat Wed Apr 18 12:41:03 1990
***************
*** 480,485 ****
--- 480,501 ----
d0|vt132|vt132-80|dec vt132 with 80 columns:\
:al=99\E[L:dl=99\E[M:ip=7:dc=7\E[P:ei=\E[4l:im=\E[4h:xn:dN#30:tc=vt100:
+ db|vt300|dec vt300:\
+ :hs:\
+ :es:\
+ :is=\E[62;1"p\E[12h\E[?3l\E[?7h\E[2$":\
+ :ts=\E[1$}\E[;H\E[K:\
+ :fs=\E[0$}:\
+ :ds=\E[1$}\E[;H\E[K\E[0$}:\
+ :tc=vt200:
+ db|vt300-w|dec vt300-wide:\
+ :hs:\
+ :es:\
+ :ts=\E[1$}\E[;H\E[K:\
+ :fs=\E[0$}:\
+ :ds=\E[1$}\E[;H\E[K\E[0$}:\
+ :tc=vt200-w:
+
dw|vt52|vt52-80|dec vt52:\
:cr=^M:do=^J:nl=^J:bl=^G:\
:le=^H:bs:cd=\EJ:ce=\EK:cl=\EH\EJ:cm=\EY%+ %+ :co#80:li#24:nd=\EC:\
***************
*** 1199,1204 ****
--- 1215,1224 ----
:am:bs:cd=^K:ce=^]:cl=^L:cm=^^%r%+ %.:co#80:ho=^Y:\
:ku=^_:kd=^J:kl=^H:kr=^\:kh=^Y:\
:li#24:nd=^\:up=^_:xn:ma=^\ ^_^P^YH:pt:
+ fm|minitel|French Minitel almost VT100:\
+ :AL=\E[%dL:DC=\E[%dP:DL=\E[%dM:\
+ :al=\E[L:cs@:dc=\E[P:dl=\E[M:\
+ :ei=\E[4l:im=\E[4h:tc=vt100:
#
# ----
# Convention: First entry is two chars, first char is manufacturer,
Technical Details
Message-ID:
<9004181230.AA24424@cernvax.cern.ch>Path:
arc1-ca.pugleaf.net!gmdzi!unido!mcsun!uunet!tut.cis.ohio-state.edu!relay.eu.net!cernvax!nathShow Full Headers
Complete Article Headers
X-Google-Language: ENGLISH,ASCII-7-bit X-Google-Thread: fb2f1,28ac9d405b6d59df,start X-Google-Attributes: gidfb2f1,public X-Google-ArrivalTime: 1990-04-18 10:59:46 PST Path: arc1-ca.pugleaf.net!gmdzi!unido!mcsun!uunet!tut.cis.ohio-state.edu!relay.eu.net!cernvax!nath From: cernvax!nath@relay.eu.net (Alfred Nathaniel) Newsgroups: gnu.emacs.bug Subject: Improvements for VMS Emacs 18.55 Message-ID: <9004181230.AA24424@cernvax.cern.ch> Date: 18 Apr 90 12:30:02 GMT Sender: daemon@tut.cis.ohio-state.edu Distribution: gnu Organization: GNUs Not Usenet Lines: 1405 Posted: Wed Apr 18 13:30:02 1990