Mercurial > hg > xemacs-beta

comparison src/fileio.c @ 209:41ff10fd062f r20-4b3

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-4b3
author cvs
date Mon, 13 Aug 2007 10:04:58 +0200
parents a2f645c6b9f8
children 78478c60bfcd
comparison
equal deleted inserted replaced
208:f427b8ec4379 209:41ff10fd062f
79 this holds the annotations made by the previous functions. */ 79 this holds the annotations made by the previous functions. */
80 Lisp_Object Vwrite_region_annotations_so_far; 80 Lisp_Object Vwrite_region_annotations_so_far;
81 81
82 /* File name in which we write a list of all our auto save files. */ 82 /* File name in which we write a list of all our auto save files. */
83 Lisp_Object Vauto_save_list_file_name; 83 Lisp_Object Vauto_save_list_file_name;
84
85 /* On VMS, nonzero means write new files with record format stmlf.
86 Zero means use var format. */
87 int vms_stmlf_recfm;
88 84
89 int disable_auto_save_when_buffer_shrinks; 85 int disable_auto_save_when_buffer_shrinks;
90 86
91 Lisp_Object Qfile_name_handler_alist; 87 Lisp_Object Qfile_name_handler_alist;
92 88
394 390
395 DEFUN ("file-name-directory", Ffile_name_directory, 1, 1, 0, /* 391 DEFUN ("file-name-directory", Ffile_name_directory, 1, 1, 0, /*
396 Return the directory component in file name NAME. 392 Return the directory component in file name NAME.
397 Return nil if NAME does not include a directory. 393 Return nil if NAME does not include a directory.
398 Otherwise return a directory spec. 394 Otherwise return a directory spec.
399 Given a Unix syntax file name, returns a string ending in slash; 395 Given a Unix syntax file name, returns a string ending in slash.
400 on VMS, perhaps instead a string ending in `:', `]' or `>'.
401 */ 396 */
402 (file)) 397 (file))
403 { 398 {
404 /* This function can GC. GC checked 1997.04.06. */ 399 /* This function can GC. GC checked 1997.04.06. */
405 Bufbyte *beg; 400 Bufbyte *beg;
418 file = FILE_SYSTEM_CASE (file); 413 file = FILE_SYSTEM_CASE (file);
419 #endif 414 #endif
420 beg = XSTRING_DATA (file); 415 beg = XSTRING_DATA (file);
421 p = beg + XSTRING_LENGTH (file); 416 p = beg + XSTRING_LENGTH (file);
422 417
423 while (p != beg && !IS_ANY_SEP (p[-1]) 418 while (p != beg && !IS_ANY_SEP (p[-1]))
424 #ifdef VMS 419 p--;
425 && p[-1] != ':' && p[-1] != ']' && p[-1] != '>'
426 #endif /* VMS */
427 ) p--;
428 420
429 if (p == beg) 421 if (p == beg)
430 return Qnil; 422 return Qnil;
431 #ifdef DOS_NT 423 #ifdef DOS_NT
432 /* Expansion of "c:" to drive and default directory. */ 424 /* Expansion of "c:" to drive and default directory. */
481 return call2_check_string (handler, Qfile_name_nondirectory, file); 473 return call2_check_string (handler, Qfile_name_nondirectory, file);
482 474
483 beg = XSTRING_DATA (file); 475 beg = XSTRING_DATA (file);
484 end = p = beg + XSTRING_LENGTH (file); 476 end = p = beg + XSTRING_LENGTH (file);
485 477
486 while (p != beg && !IS_ANY_SEP (p[-1]) 478 while (p != beg && !IS_ANY_SEP (p[-1]))
487 #ifdef VMS 479 p--;
488 && p[-1] != ':' && p[-1] != ']' && p[-1] != '>'
489 #endif /* VMS */
490 ) p--;
491 480
492 return make_string (p, end - p); 481 return make_string (p, end - p);
493 } 482 }
494 483
495 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory, 1, 1, 0, /* 484 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory, 1, 1, 0, /*
522 { 511 {
523 int size = strlen (in) - 1; 512 int size = strlen (in) - 1;
524 513
525 strcpy (out, in); 514 strcpy (out, in);
526 515
527 #ifdef VMS
528 /* Is it already a directory string? */
529 if (in[size] == ':' || in[size] == ']' || in[size] == '>')
530 return out;
531 /* Is it a VMS directory file name? If so, hack VMS syntax. */
532 else if (! strchr (in, '/')
533 && ((size > 3 && ! strcmp (&in[size - 3], ".DIR"))
534 || (size > 3 && ! strcmp (&in[size - 3], ".dir"))
535 || (size > 5 && (! strncmp (&in[size - 5], ".DIR", 4)
536 || ! strncmp (&in[size - 5], ".dir", 4))
537 && (in[size - 1] == '.' || in[size - 1] == ';')
538 && in[size] == '1')))
539 {
540 char *p, *dot;
541 char brack;
542
543 /* x.dir -> [.x]
544 dir:x.dir --> dir:[x]
545 dir:[x]y.dir --> dir:[x.y] */
546 p = in + size;
547 while (p != in && *p != ':' && *p != '>' && *p != ']') p--;
548 if (p != in)
549 {
550 strncpy (out, in, p - in);
551 out[p - in] = '\0';
552 if (*p == ':')
553 {
554 brack = ']';
555 strcat (out, ":[");
556 }
557 else
558 {
559 brack = *p;
560 strcat (out, ".");
561 }
562 p++;
563 }
564 else
565 {
566 brack = ']';
567 strcpy (out, "[.");
568 }
569 dot = strchr (p, '.');
570 if (dot)
571 {
572 /* blindly remove any extension */
573 size = strlen (out) + (dot - p);
574 strncat (out, p, dot - p);
575 }
576 else
577 {
578 strcat (out, p);
579 size = strlen (out);
580 }
581 out[size++] = brack;
582 out[size] = '\0';
583 }
584 #else /* not VMS */
585 /* For Unix syntax, Append a slash if necessary */ 516 /* For Unix syntax, Append a slash if necessary */
586 if (!IS_ANY_SEP (out[size])) 517 if (!IS_ANY_SEP (out[size]))
587 { 518 {
588 out[size + 1] = DIRECTORY_SEP; 519 out[size + 1] = DIRECTORY_SEP;
589 out[size + 2] = '\0'; 520 out[size + 2] = '\0';
590 } 521 }
591 #endif /* not VMS */
592 return out; 522 return out;
593 } 523 }
594 524
595 DEFUN ("file-name-as-directory", Ffile_name_as_directory, 1, 1, 0, /* 525 DEFUN ("file-name-as-directory", Ffile_name_as_directory, 1, 1, 0, /*
596 Return a string representing file FILENAME interpreted as a directory. 526 Return a string representing file FILENAME interpreted as a directory.
597 This operation exists because a directory is also a file, but its name as 527 This operation exists because a directory is also a file, but its name as
598 a directory is different from its name as a file. 528 a directory is different from its name as a file.
599 The result can be used as the value of `default-directory' 529 The result can be used as the value of `default-directory'
600 or passed as second argument to `expand-file-name'. 530 or passed as second argument to `expand-file-name'.
601 For a Unix-syntax file name, just appends a slash. 531 For a Unix-syntax file name, just appends a slash.
602 On VMS, converts "[X]FOO.DIR" to "[X.FOO]", etc.
603 */ 532 */
604 (file)) 533 (file))
605 { 534 {
606 /* This function can GC. GC checked 1997.04.06. */ 535 /* This function can GC. GC checked 1997.04.06. */
607 char *buf; 536 char *buf;
620 (buf, (char *) XSTRING_DATA (file))); 549 (buf, (char *) XSTRING_DATA (file)));
621 } 550 }
622 551
623 /* 552 /*
624 * Convert from directory name to filename. 553 * Convert from directory name to filename.
625 * On VMS:
626 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
627 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
628 * On UNIX, it's simple: just make sure there is a terminating / 554 * On UNIX, it's simple: just make sure there is a terminating /
629 555
630 * Value is nonzero if the string output is different from the input. 556 * Value is nonzero if the string output is different from the input.
631 */ 557 */
632 558
633 static int 559 static int
634 directory_file_name (CONST char *src, char *dst) 560 directory_file_name (CONST char *src, char *dst)
635 { 561 {
636 long slen; 562 long slen;
637 #ifdef VMS
638 long rlen;
639 char * ptr, * rptr;
640 char bracket;
641 struct FAB fab = cc$rms_fab;
642 struct NAM nam = cc$rms_nam;
643 char esa[NAM$C_MAXRSS];
644 #endif /* VMS */
645 563
646 slen = strlen (src); 564 slen = strlen (src);
647 #ifdef VMS
648 if (! strchr (src, '/')
649 && (src[slen - 1] == ']'
650 || src[slen - 1] == ':'
651 || src[slen - 1] == '>'))
652 {
653 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
654 fab.fab$l_fna = src;
655 fab.fab$b_fns = slen;
656 fab.fab$l_nam = &nam;
657 fab.fab$l_fop = FAB$M_NAM;
658
659 nam.nam$l_esa = esa;
660 nam.nam$b_ess = sizeof esa;
661 nam.nam$b_nop |= NAM$M_SYNCHK;
662
663 /* We call SYS$PARSE to handle such things as [--] for us. */
664 if (SYS$PARSE(&fab, 0, 0) == RMS$_NORMAL)
665 {
666 slen = nam.nam$b_esl;
667 if (esa[slen - 1] == ';' && esa[slen - 2] == '.')
668 slen -= 2;
669 esa[slen] = '\0';
670 src = esa;
671 }
672 if (src[slen - 1] != ']' && src[slen - 1] != '>')
673 {
674 /* what about when we have logical_name:???? */
675 if (src[slen - 1] == ':')
676 { /* Xlate logical name and see what we get */
677 ptr = strcpy (dst, src); /* upper case for getenv */
678 while (*ptr)
679 {
680 *ptr = toupper ((unsigned char) *ptr);
681 ptr++;
682 }
683 dst[slen - 1] = 0; /* remove colon */
684 if (!(src = egetenv (dst)))
685 return 0;
686 /* should we jump to the beginning of this procedure?
687 Good points: allows us to use logical names that xlate
688 to Unix names,
689 Bad points: can be a problem if we just translated to a device
690 name...
691 For now, I'll punt and always expect VMS names, and hope for
692 the best! */
693 slen = strlen (src);
694 if (src[slen - 1] != ']' && src[slen - 1] != '>')
695 { /* no recursion here! */
696 strcpy (dst, src);
697 return 0;
698 }
699 }
700 else
701 { /* not a directory spec */
702 strcpy (dst, src);
703 return 0;
704 }
705 }
706 bracket = src[slen - 1];
707
708 /* If bracket is ']' or '>', bracket - 2 is the corresponding
709 opening bracket. */
710 ptr = strchr (src, bracket - 2);
711 if (ptr == 0)
712 { /* no opening bracket */
713 strcpy (dst, src);
714 return 0;
715 }
716 if (!(rptr = strrchr (src, '.')))
717 rptr = ptr;
718 slen = rptr - src;
719 strncpy (dst, src, slen);
720 dst[slen] = '\0';
721 if (*rptr == '.')
722 {
723 dst[slen++] = bracket;
724 dst[slen] = '\0';
725 }
726 else
727 {
728 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
729 then translate the device and recurse. */
730 if (dst[slen - 1] == ':'
731 && dst[slen - 2] != ':' /* skip decnet nodes */
732 && strcmp(src + slen, "[000000]") == 0)
733 {
734 dst[slen - 1] = '\0';
735 if ((ptr = egetenv (dst))
736 && (rlen = strlen (ptr) - 1) > 0
737 && (ptr[rlen] == ']' || ptr[rlen] == '>')
738 && ptr[rlen - 1] == '.')
739 {
740 char * buf = (char *) alloca (strlen (ptr) + 1);
741 strcpy (buf, ptr);
742 buf[rlen - 1] = ']';
743 buf[rlen] = '\0';
744 return directory_file_name (buf, dst);
745 }
746 else
747 dst[slen - 1] = ':';
748 }
749 strcat (dst, "[000000]");
750 slen += 8;
751 }
752 rptr++;
753 rlen = strlen (rptr) - 1;
754 strncat (dst, rptr, rlen);
755 dst[slen + rlen] = '\0';
756 strcat (dst, ".DIR.1");
757 return 1;
758 }
759 #endif /* VMS */
760 /* Process as Unix format: just remove any final slash. 565 /* Process as Unix format: just remove any final slash.
761 But leave "/" unchanged; do not change it to "". */ 566 But leave "/" unchanged; do not change it to "". */
762 strcpy (dst, src); 567 strcpy (dst, src);
763 #ifdef APOLLO 568 #ifdef APOLLO
764 /* Handle // as root for apollo's. */ 569 /* Handle // as root for apollo's. */
781 Return the file name of the directory named DIR. 586 Return the file name of the directory named DIR.
782 This is the name of the file that holds the data for the directory DIR. 587 This is the name of the file that holds the data for the directory DIR.
783 This operation exists because a directory is also a file, but its name as 588 This operation exists because a directory is also a file, but its name as
784 a directory is different from its name as a file. 589 a directory is different from its name as a file.
785 In Unix-syntax, this function just removes the final slash. 590 In Unix-syntax, this function just removes the final slash.
786 On VMS, given a VMS-syntax directory name such as "[X.Y]",
787 it returns a file name such as "[X]Y.DIR.1".
788 */ 591 */
789 (directory)) 592 (directory))
790 { 593 {
791 /* This function can GC. GC checked 1997.04.06. */ 594 /* This function can GC. GC checked 1997.04.06. */
792 char *buf; 595 char *buf;
802 /* If the file name has special constructs in it, 605 /* If the file name has special constructs in it,
803 call the corresponding file handler. */ 606 call the corresponding file handler. */
804 handler = Ffind_file_name_handler (directory, Qdirectory_file_name); 607 handler = Ffind_file_name_handler (directory, Qdirectory_file_name);
805 if (!NILP (handler)) 608 if (!NILP (handler))
806 return call2_check_string (handler, Qdirectory_file_name, directory); 609 return call2_check_string (handler, Qdirectory_file_name, directory);
807 #ifdef VMS
808 /* 20 extra chars is insufficient for VMS, since we might perform a
809 logical name translation. an equivalence string can be up to 255
810 chars long, so grab that much extra space... - sss */
811 buf = (char *) alloca (XSTRING_LENGTH (directory) + 20 + 255);
812 #else
813 buf = (char *) alloca (XSTRING_LENGTH (directory) + 20); 610 buf = (char *) alloca (XSTRING_LENGTH (directory) + 20);
814 #endif
815 directory_file_name ((char *) XSTRING_DATA (directory), buf); 611 directory_file_name ((char *) XSTRING_DATA (directory), buf);
816 return build_string (buf); 612 return build_string (buf);
817 } 613 }
818 614
819 DEFUN ("make-temp-name", Fmake_temp_name, 1, 1, 0, /* 615 DEFUN ("make-temp-name", Fmake_temp_name, 1, 1, 0, /*
860 656
861 Bufbyte *newdir, *p, *o; 657 Bufbyte *newdir, *p, *o;
862 int tlen; 658 int tlen;
863 Bufbyte *target; 659 Bufbyte *target;
864 struct passwd *pw; 660 struct passwd *pw;
865 #ifdef VMS
866 Bufbyte * colon = 0;
867 Bufbyte * close = 0;
868 Bufbyte * slash = 0;
869 Bufbyte * brack = 0;
870 int lbrack = 0, rbrack = 0;
871 int dots = 0;
872 #endif /* VMS */
873 #ifdef DOS_NT 661 #ifdef DOS_NT
874 /* Demacs 1.1.2 91/10/20 Manabu Higashida */ 662 /* Demacs 1.1.2 91/10/20 Manabu Higashida */
875 int drive = -1; 663 int drive = -1;
876 int relpath = 0; 664 int relpath = 0;
877 Bufbyte *tmp, *defdir; 665 Bufbyte *tmp, *defdir;
934 GCPRO1 (default_); /* may be current_buffer->directory */ 722 GCPRO1 (default_); /* may be current_buffer->directory */
935 default_ = Fexpand_file_name (default_, Qnil); 723 default_ = Fexpand_file_name (default_, Qnil);
936 UNGCPRO; 724 UNGCPRO;
937 } 725 }
938 726
939 #ifdef VMS
940 /* Filenames on VMS are always upper case. */
941 name = Fupcase (name, Fcurrent_buffer ());
942 #endif
943 #ifdef FILE_SYSTEM_CASE 727 #ifdef FILE_SYSTEM_CASE
944 name = FILE_SYSTEM_CASE (name); 728 name = FILE_SYSTEM_CASE (name);
945 #endif 729 #endif
946 730
947 /* #### dmoore - this is ugly, clean this up. Looks like nm 731 /* #### dmoore - this is ugly, clean this up. Looks like nm
1002 } 786 }
1003 #endif 787 #endif
1004 788
1005 /* If nm is absolute, flush ...// and detect /./ and /../. 789 /* If nm is absolute, flush ...// and detect /./ and /../.
1006 If no /./ or /../ we can return right away. */ 790 If no /./ or /../ we can return right away. */
1007 if ( 791 if (IS_DIRECTORY_SEP (nm[0]))
1008 IS_DIRECTORY_SEP (nm[0])
1009 #ifdef VMS
1010 || strchr (nm, ':')
1011 #endif /* VMS */
1012 )
1013 { 792 {
1014 /* If it turns out that the filename we want to return is just a 793 /* If it turns out that the filename we want to return is just a
1015 suffix of FILENAME, we don't need to go through and edit 794 suffix of FILENAME, we don't need to go through and edit
1016 things; we just need to construct a new string using data 795 things; we just need to construct a new string using data
1017 starting at the middle of FILENAME. If we set lose to a 796 starting at the middle of FILENAME. If we set lose to a
1031 && (IS_DIRECTORY_SEP (p[2]) 810 && (IS_DIRECTORY_SEP (p[2])
1032 || p[2] == 0 811 || p[2] == 0
1033 || (p[2] == '.' && (IS_DIRECTORY_SEP (p[3]) 812 || (p[2] == '.' && (IS_DIRECTORY_SEP (p[3])
1034 || p[3] == 0)))) 813 || p[3] == 0))))
1035 lose = 1; 814 lose = 1;
1036 #ifdef VMS
1037 if (p[0] == '\\')
1038 lose = 1;
1039 if (p[0] == '/') {
1040 /* if dev:[dir]/, move nm to / */
1041 if (!slash && p > nm && (brack || colon)) {
1042 nm = (brack ? brack + 1 : colon + 1);
1043 lbrack = rbrack = 0;
1044 brack = 0;
1045 colon = 0;
1046 }
1047 slash = p;
1048 }
1049 if (p[0] == '-')
1050 #ifndef VMS4_4
1051 /* VMS pre V4.4,convert '-'s in filenames. */
1052 if (lbrack == rbrack)
1053 {
1054 if (dots < 2) /* this is to allow negative version numbers */
1055 p[0] = '_';
1056 }
1057 else
1058 #endif /* VMS4_4 */
1059 if (lbrack > rbrack &&
1060 ((p[-1] == '.' || p[-1] == '[' || p[-1] == '<') &&
1061 (p[1] == '.' || p[1] == ']' || p[1] == '>')))
1062 lose = 1;
1063 #ifndef VMS4_4
1064 else
1065 p[0] = '_';
1066 #endif /* VMS4_4 */
1067 /* count open brackets, reset close bracket pointer */
1068 if (p[0] == '[' || p[0] == '<')
1069 lbrack++, brack = 0;
1070 /* count close brackets, set close bracket pointer */
1071 if (p[0] == ']' || p[0] == '>')
1072 rbrack++, brack = p;
1073 /* detect ][ or >< */
1074 if ((p[0] == ']' || p[0] == '>') && (p[1] == '[' || p[1] == '<'))
1075 lose = 1;
1076 if ((p[0] == ':' || p[0] == ']' || p[0] == '>') && p[1] == '~')
1077 nm = p + 1, lose = 1;
1078 if (p[0] == ':' && (colon || slash))
1079 /* if dev1:[dir]dev2:, move nm to dev2: */
1080 if (brack)
1081 {
1082 nm = brack + 1;
1083 brack = 0;
1084 }
1085 /* if /pathname/dev:, move nm to dev: */
1086 else if (slash)
1087 nm = slash + 1;
1088 /* if node::dev:, move colon following dev */
1089 else if (colon && colon[-1] == ':')
1090 colon = p;
1091 /* if dev1:dev2:, move nm to dev2: */
1092 else if (colon && colon[-1] != ':')
1093 {
1094 nm = colon + 1;
1095 colon = 0;
1096 }
1097 if (p[0] == ':' && !colon)
1098 {
1099 if (p[1] == ':')
1100 p++;
1101 colon = p;
1102 }
1103 if (lbrack == rbrack)
1104 if (p[0] == ';')
1105 dots = 2;
1106 else if (p[0] == '.')
1107 dots++;
1108 #endif /* VMS */
1109 p++; 815 p++;
1110 } 816 }
1111 if (!lose) 817 if (!lose)
1112 { 818 {
1113 #ifdef VMS
1114 if (strchr (nm, '/'))
1115 return build_string (sys_translate_unix (nm));
1116 #endif /* VMS */
1117 #ifndef DOS_NT 819 #ifndef DOS_NT
1118 if (nm == XSTRING_DATA (name)) 820 if (nm == XSTRING_DATA (name))
1119 return name; 821 return name;
1120 return build_string ((char *) nm); 822 return build_string ((char *) nm);
1121 #endif /* not DOS_NT */ 823 #endif /* not DOS_NT */
1127 newdir = 0; 829 newdir = 0;
1128 830
1129 if (nm[0] == '~') /* prefix ~ */ 831 if (nm[0] == '~') /* prefix ~ */
1130 { 832 {
1131 if (IS_DIRECTORY_SEP (nm[1]) 833 if (IS_DIRECTORY_SEP (nm[1])
1132 #ifdef VMS
1133 || nm[1] == ':'
1134 #endif /* VMS */
1135 || nm[1] == 0) /* ~ by itself */ 834 || nm[1] == 0) /* ~ by itself */
1136 { 835 {
1137 if (!(newdir = (Bufbyte *) egetenv ("HOME"))) 836 if (!(newdir = (Bufbyte *) egetenv ("HOME")))
1138 newdir = (Bufbyte *) ""; 837 newdir = (Bufbyte *) "";
1139 #ifdef DOS_NT 838 #ifdef DOS_NT
1142 if (newdir[1] == ':') 841 if (newdir[1] == ':')
1143 drive = newdir[0]; 842 drive = newdir[0];
1144 dostounix_filename (newdir); 843 dostounix_filename (newdir);
1145 #endif /* DOS_NT */ 844 #endif /* DOS_NT */
1146 nm++; 845 nm++;
1147 #ifdef VMS
1148 nm++; /* Don't leave the slash in nm. */
1149 #endif /* VMS */
1150 } 846 }
1151 else /* ~user/filename */ 847 else /* ~user/filename */
1152 { 848 {
1153 for (p = nm; *p && (!IS_DIRECTORY_SEP (*p) 849 for (p = nm; *p && (!IS_DIRECTORY_SEP (*p)); p++);
1154 #ifdef VMS
1155 && *p != ':'
1156 #endif /* VMS */
1157 ); p++);
1158 o = (Bufbyte *) alloca (p - nm + 1); 850 o = (Bufbyte *) alloca (p - nm + 1);
1159 memcpy (o, (char *) nm, p - nm); 851 memcpy (o, (char *) nm, p - nm);
1160 o [p - nm] = 0; 852 o [p - nm] = 0;
1161 853
1162 #ifdef WINDOWSNT 854 #ifdef WINDOWSNT
1176 pw = (struct passwd *) getpwnam ((char *) o + 1); 868 pw = (struct passwd *) getpwnam ((char *) o + 1);
1177 speed_up_interrupts (); 869 speed_up_interrupts ();
1178 if (pw) 870 if (pw)
1179 { 871 {
1180 newdir = (Bufbyte *) pw -> pw_dir; 872 newdir = (Bufbyte *) pw -> pw_dir;
1181 #ifdef VMS
1182 nm = p + 1; /* skip the terminator */
1183 #else
1184 nm = p; 873 nm = p;
1185 #endif /* VMS */
1186 } 874 }
1187 #endif /* not WINDOWSNT */ 875 #endif /* not WINDOWSNT */
1188 876
1189 /* If we don't find a user of that name, leave the name 877 /* If we don't find a user of that name, leave the name
1190 unchanged; don't move nm forward to p. */ 878 unchanged; don't move nm forward to p. */
1191 } 879 }
1192 } 880 }
1193 881
1194 if (!IS_ANY_SEP (nm[0]) 882 if (!IS_ANY_SEP (nm[0])
1195 #ifdef VMS
1196 && !strchr (nm, ':')
1197 #endif /* not VMS */
1198 #ifdef DOS_NT 883 #ifdef DOS_NT
1199 && drive == -1 884 && drive == -1
1200 #endif /* DOS_NT */ 885 #endif /* DOS_NT */
1201 && !newdir 886 && !newdir
1202 && STRINGP (default_)) 887 && STRINGP (default_))
1242 #endif /* not DOS_NT */ 927 #endif /* not DOS_NT */
1243 *target = 0; 928 *target = 0;
1244 929
1245 if (newdir) 930 if (newdir)
1246 { 931 {
1247 #ifndef VMS
1248 if (nm[0] == 0 || IS_DIRECTORY_SEP (nm[0])) 932 if (nm[0] == 0 || IS_DIRECTORY_SEP (nm[0]))
1249 strcpy ((char *) target, (char *) newdir); 933 strcpy ((char *) target, (char *) newdir);
1250 else 934 else
1251 #endif
1252 file_name_as_directory ((char *) target, (char *) newdir); 935 file_name_as_directory ((char *) target, (char *) newdir);
1253 } 936 }
1254 937
1255 strcat ((char *) target, (char *) nm); 938 strcat ((char *) target, (char *) nm);
1256 #ifdef VMS
1257 if (strchr (target, '/'))
1258 strcpy (target, sys_translate_unix (target));
1259 #endif /* VMS */
1260 939
1261 /* Now canonicalize by removing /. and /foo/.. if they appear. */ 940 /* Now canonicalize by removing /. and /foo/.. if they appear. */
1262 941
1263 p = target; 942 p = target;
1264 o = target; 943 o = target;
1265 944
1266 while (*p) 945 while (*p)
1267 { 946 {
1268 #ifdef VMS
1269 if (*p != ']' && *p != '>' && *p != '-')
1270 {
1271 if (*p == '\\')
1272 p++;
1273 *o++ = *p++;
1274 }
1275 else if ((p[0] == ']' || p[0] == '>') && p[0] == p[1] + 2)
1276 /* brackets are offset from each other by 2 */
1277 {
1278 p += 2;
1279 if (*p != '.' && *p != '-' && o[-1] != '.')
1280 /* convert [foo][bar] to [bar] */
1281 while (o[-1] != '[' && o[-1] != '<')
1282 o--;
1283 else if (*p == '-' && *o != '.')
1284 *--p = '.';
1285 }
1286 else if (p[0] == '-' && o[-1] == '.' &&
1287 (p[1] == '.' || p[1] == ']' || p[1] == '>'))
1288 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1289 {
1290 do
1291 o--;
1292 while (o[-1] != '.' && o[-1] != '[' && o[-1] != '<');
1293 if (p[1] == '.') /* foo.-.bar ==> bar. */
1294 p += 2;
1295 else if (o[-1] == '.') /* '.foo.-]' ==> ']' */
1296 p++, o--;
1297 /* else [foo.-] ==> [-] */
1298 }
1299 else
1300 {
1301 #ifndef VMS4_4
1302 if (*p == '-' &&
1303 o[-1] != '[' && o[-1] != '<' && o[-1] != '.' &&
1304 p[1] != ']' && p[1] != '>' && p[1] != '.')
1305 *p = '_';
1306 #endif /* VMS4_4 */
1307 *o++ = *p++;
1308 }
1309 #else /* not VMS */
1310 if (!IS_DIRECTORY_SEP (*p)) 947 if (!IS_DIRECTORY_SEP (*p))
1311 { 948 {
1312 *o++ = *p++; 949 *o++ = *p++;
1313 } 950 }
1314 else if (IS_DIRECTORY_SEP (p[0]) && IS_DIRECTORY_SEP (p[1]) 951 else if (IS_DIRECTORY_SEP (p[0]) && IS_DIRECTORY_SEP (p[1])
1352 } 989 }
1353 else 990 else
1354 { 991 {
1355 *o++ = *p++; 992 *o++ = *p++;
1356 } 993 }
1357 #endif /* not VMS */
1358 } 994 }
1359 995
1360 #ifdef DOS_NT 996 #ifdef DOS_NT
1361 /* at last, set drive name. */ 997 /* at last, set drive name. */
1362 if (target[1] != ':' 998 if (target[1] != ':'
1406 UNGCPRO; 1042 UNGCPRO;
1407 1043
1408 if (!NILP (handler)) 1044 if (!NILP (handler))
1409 return call2_check_string (handler, Qfile_truename, expanded_name); 1045 return call2_check_string (handler, Qfile_truename, expanded_name);
1410 1046
1411 #ifdef VMS
1412 return expanded_name;
1413 #else
1414 { 1047 {
1415 char resolved_path[MAXPATHLEN]; 1048 char resolved_path[MAXPATHLEN];
1416 char path[MAXPATHLEN]; 1049 char path[MAXPATHLEN];
1417 char *p = path; 1050 char *p = path;
1418 int elen = XSTRING_LENGTH (expanded_name); 1051 int elen = XSTRING_LENGTH (expanded_name);
1446 *p = '/'; 1079 *p = '/';
1447 else 1080 else
1448 break; 1081 break;
1449 1082
1450 } 1083 }
1451 else if (errno == ENOENT) 1084 else if (errno == ENOENT || errno == EACCES)
1452 { 1085 {
1453 /* Failed on this component. Just tack on the rest of 1086 /* Failed on this component. Just tack on the rest of
1454 the string and we are done. */ 1087 the string and we are done. */
1455 int rlen = strlen (resolved_path); 1088 int rlen = strlen (resolved_path);
1456 1089
1486 goto toolong; 1119 goto toolong;
1487 resolved_path[rlen] = '/'; 1120 resolved_path[rlen] = '/';
1488 resolved_path[rlen + 1] = 0; 1121 resolved_path[rlen + 1] = 0;
1489 rlen = rlen + 1; 1122 rlen = rlen + 1;
1490 } 1123 }
1491 return make_string ((Bufbyte *) resolved_path, rlen); 1124 return make_ext_string ((Bufbyte *) resolved_path, rlen, FORMAT_BINARY);
1492 } 1125 }
1493 1126
1494 toolong: 1127 toolong:
1495 errno = ENAMETOOLONG; 1128 errno = ENAMETOOLONG;
1496 goto lose; 1129 goto lose;
1497 lose: 1130 lose:
1498 report_file_error ("Finding truename", list1 (expanded_name)); 1131 report_file_error ("Finding truename", list1 (expanded_name));
1499 } 1132 }
1500 return Qnil; /* suppress compiler warning */ 1133 return Qnil; /* suppress compiler warning */
1501 #endif /* not VMS */
1502 } 1134 }
1503 1135
1504 1136
1505 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name, 1, 1, 0, /* 1137 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name, 1, 1, 0, /*
1506 Substitute environment variables referred to in FILENAME. 1138 Substitute environment variables referred to in FILENAME.
1508 the value of that variable. The variable name should be terminated 1140 the value of that variable. The variable name should be terminated
1509 with a character not a letter, digit or underscore; otherwise, enclose 1141 with a character not a letter, digit or underscore; otherwise, enclose
1510 the entire variable name in braces. 1142 the entire variable name in braces.
1511 If `/~' appears, all of FILENAME through that `/' is discarded. 1143 If `/~' appears, all of FILENAME through that `/' is discarded.
1512 1144
1513 On VMS, `$' substitution is not done; this function does little and only
1514 duplicates what `expand-file-name' does.
1515 */ 1145 */
1516 (string)) 1146 (string))
1517 { 1147 {
1518 /* This function can GC. GC checked 1997.04.06. */ 1148 /* This function can GC. GC checked 1997.04.06. */
1519 Bufbyte *nm; 1149 Bufbyte *nm;
1556 p[0] == '/' 1186 p[0] == '/'
1557 #endif /* not WINDOWSNT */ 1187 #endif /* not WINDOWSNT */
1558 #endif /* not APOLLO */ 1188 #endif /* not APOLLO */
1559 ) 1189 )
1560 && p != nm 1190 && p != nm
1561 && (0 1191 && (IS_DIRECTORY_SEP (p[-1])))
1562 #ifdef VMS
1563 || p[-1] == ':' || p[-1] == ']' || p[-1] == '>'
1564 #endif /* VMS */
1565 || IS_DIRECTORY_SEP (p[-1])))
1566 { 1192 {
1567 nm = p; 1193 nm = p;
1568 substituted = 1; 1194 substituted = 1;
1569 } 1195 }
1570 #ifdef DOS_NT 1196 #ifdef DOS_NT
1573 nm = p; 1199 nm = p;
1574 substituted = 1; 1200 substituted = 1;
1575 } 1201 }
1576 #endif /* DOS_NT */ 1202 #endif /* DOS_NT */
1577 } 1203 }
1578
1579 #ifdef VMS
1580 return build_string (nm);
1581 #else
1582 1204
1583 /* See if any variables are substituted into the string 1205 /* See if any variables are substituted into the string
1584 and find the total length of their values in `total' */ 1206 and find the total length of their values in `total' */
1585 1207
1586 for (p = nm; p != endp;) 1208 for (p = nm; p != endp;)
1716 error ("Substituting nonexistent environment variable \"%s\"", 1338 error ("Substituting nonexistent environment variable \"%s\"",
1717 target); 1339 target);
1718 1340
1719 /* NOTREACHED */ 1341 /* NOTREACHED */
1720 return Qnil; /* suppress compiler warning */ 1342 return Qnil; /* suppress compiler warning */
1721 #endif /* not VMS */
1722 } 1343 }
1723 1344
1724 /* (directory-file-name (expand-file-name FOO)) */ 1345 /* (directory-file-name (expand-file-name FOO)) */
1725 1346
1726 Lisp_Object 1347 Lisp_Object
1730 Lisp_Object abspath; 1351 Lisp_Object abspath;
1731 struct gcpro gcpro1; 1352 struct gcpro gcpro1;
1732 1353
1733 abspath = Fexpand_file_name (filename, defdir); 1354 abspath = Fexpand_file_name (filename, defdir);
1734 GCPRO1 (abspath); 1355 GCPRO1 (abspath);
1735 #ifdef VMS
1736 {
1737 Bufbyte c =
1738 XSTRING_BYTE (abspath, XSTRING_LENGTH (abspath) - 1);
1739 if (c == ':' || c == ']' || c == '>')
1740 abspath = Fdirectory_file_name (abspath);
1741 }
1742 #else
1743 /* Remove final slash, if any (unless path is root). 1356 /* Remove final slash, if any (unless path is root).
1744 stat behaves differently depending! */ 1357 stat behaves differently depending! */
1745 if (XSTRING_LENGTH (abspath) > 1 1358 if (XSTRING_LENGTH (abspath) > 1
1746 && IS_DIRECTORY_SEP (XSTRING_BYTE (abspath, XSTRING_LENGTH (abspath) - 1)) 1359 && IS_DIRECTORY_SEP (XSTRING_BYTE (abspath, XSTRING_LENGTH (abspath) - 1))
1747 && !IS_DEVICE_SEP (XSTRING_BYTE (abspath, XSTRING_LENGTH (abspath) - 2))) 1360 && !IS_DEVICE_SEP (XSTRING_BYTE (abspath, XSTRING_LENGTH (abspath) - 2)))
1748 /* We cannot take shortcuts; they might be wrong for magic file names. */ 1361 /* We cannot take shortcuts; they might be wrong for magic file names. */
1749 abspath = Fdirectory_file_name (abspath); 1362 abspath = Fdirectory_file_name (abspath);
1750 #endif
1751 UNGCPRO; 1363 UNGCPRO;
1752 return abspath; 1364 return abspath;
1753 } 1365 }
1754 1366
1755 /* Signal an error if the file ABSNAME already exists. 1367 /* Signal an error if the file ABSNAME already exists.
1911 report_file_error ("Non-regular file", Fcons (filename, Qnil)); 1523 report_file_error ("Non-regular file", Fcons (filename, Qnil));
1912 } 1524 }
1913 } 1525 }
1914 #endif /* S_ISREG && S_ISLNK */ 1526 #endif /* S_ISREG && S_ISLNK */
1915 1527
1916 #ifdef VMS
1917 /* Create the copy file with the same record format as the input file */
1918 ofd = sys_creat ((char *) XSTRING_DATA (newname), 0666, ifd);
1919 #else
1920 #ifdef MSDOS 1528 #ifdef MSDOS
1921 /* System's default file type was set to binary by _fmode in emacs.c. */ 1529 /* System's default file type was set to binary by _fmode in emacs.c. */
1922 ofd = creat ((char *) XSTRING_DATA (newname), S_IREAD | S_IWRITE); 1530 ofd = creat ((char *) XSTRING_DATA (newname), S_IREAD | S_IWRITE);
1923 #else /* not MSDOS */ 1531 #else /* not MSDOS */
1924 ofd = creat ((char *) XSTRING_DATA (newname), 0666); 1532 ofd = creat ((char *) XSTRING_DATA (newname), 0666);
1925 #endif /* not MSDOS */ 1533 #endif /* not MSDOS */
1926 #endif /* VMS */
1927 if (ofd < 0) 1534 if (ofd < 0)
1928 report_file_error ("Opening output file", list1 (newname)); 1535 report_file_error ("Opening output file", list1 (newname));
1929 1536
1930 { 1537 {
1931 Lisp_Object ofd_locative = noseeum_cons (make_int (ofd), Qnil); 1538 Lisp_Object ofd_locative = noseeum_cons (make_int (ofd), Qnil);
2006 dirname_)); 1613 dirname_));
2007 } 1614 }
2008 strncpy (dir, (char *) XSTRING_DATA (dirname_), 1615 strncpy (dir, (char *) XSTRING_DATA (dirname_),
2009 XSTRING_LENGTH (dirname_) + 1); 1616 XSTRING_LENGTH (dirname_) + 1);
2010 1617
2011 #ifndef VMS
2012 if (dir [XSTRING_LENGTH (dirname_) - 1] == '/') 1618 if (dir [XSTRING_LENGTH (dirname_) - 1] == '/')
2013 dir [XSTRING_LENGTH (dirname_) - 1] = 0; 1619 dir [XSTRING_LENGTH (dirname_) - 1] = 0;
2014 #endif
2015 1620
2016 #ifdef WINDOWSNT 1621 #ifdef WINDOWSNT
2017 if (mkdir (dir) != 0) 1622 if (mkdir (dir) != 0)
2018 #else 1623 #else
2019 if (mkdir (dir, 0777) != 0) 1624 if (mkdir (dir, 0777) != 0)
2293 UNGCPRO; 1898 UNGCPRO;
2294 return Qnil; 1899 return Qnil;
2295 } 1900 }
2296 #endif /* S_IFLNK */ 1901 #endif /* S_IFLNK */
2297 1902
2298 #ifdef VMS
2299
2300 DEFUN ("define-logical-name", Fdefine_logical_name, 2, 2,
2301 "sDefine logical name: \nsDefine logical name %s as: ", /*
2302 Define the job-wide logical name NAME to have the value STRING.
2303 If STRING is nil or a null string, the logical name NAME is deleted.
2304 */
2305 (varname, string))
2306 {
2307 CHECK_STRING (varname);
2308 if (NILP (string))
2309 delete_logical_name ((char *) XSTRING_DATA (varname));
2310 else
2311 {
2312 CHECK_STRING (string);
2313
2314 if (XSTRING_LENGTH (string) == 0)
2315 delete_logical_name ((char *) XSTRING_DATA (varname));
2316 else
2317 define_logical_name ((char *) XSTRING_DATA (varname), (char *) XSTRING_DATA (string));
2318 }
2319
2320 return string;
2321 }
2322 #endif /* VMS */
2323
2324 #ifdef HPUX_NET 1903 #ifdef HPUX_NET
2325 1904
2326 DEFUN ("sysnetunam", Fsysnetunam, 2, 2, 0, /* 1905 DEFUN ("sysnetunam", Fsysnetunam, 2, 2, 0, /*
2327 Open a network connection to PATH using LOGIN as the login string. 1906 Open a network connection to PATH using LOGIN as the login string.
2328 */ 1907 */
2362 Bufbyte *ptr; 1941 Bufbyte *ptr;
2363 1942
2364 CHECK_STRING (filename); 1943 CHECK_STRING (filename);
2365 ptr = XSTRING_DATA (filename); 1944 ptr = XSTRING_DATA (filename);
2366 if (IS_DIRECTORY_SEP (*ptr) || *ptr == '~' 1945 if (IS_DIRECTORY_SEP (*ptr) || *ptr == '~'
2367 #ifdef VMS
2368 /* ??? This criterion is probably wrong for '<'. */
2369 || strchr (ptr, ':') || strchr (ptr, '<')
2370 || (*ptr == '[' && (ptr[1] != '-' || (ptr[2] != '.' && ptr[2] != ']'))
2371 && ptr[1] != '.')
2372 #endif /* VMS */
2373 #ifdef DOS_NT 1946 #ifdef DOS_NT
2374 || (*ptr != 0 && ptr[1] == ':' && (ptr[2] == '/' || ptr[2] == '\\')) 1947 || (*ptr != 0 && ptr[1] == ':' && (ptr[2] == '/' || ptr[2] == '\\'))
2375 #endif 1948 #endif
2376 ) 1949 )
2377 return Qt; 1950 return Qt;
2548 2121
2549 2122
2550 GCPRO1 (abspath); 2123 GCPRO1 (abspath);
2551 dir = Ffile_name_directory (abspath); 2124 dir = Ffile_name_directory (abspath);
2552 UNGCPRO; 2125 UNGCPRO;
2553 #if defined (VMS) || defined (MSDOS) 2126 #ifdef MSDOS
2554 if (!NILP (dir)) 2127 if (!NILP (dir))
2555 { 2128 {
2556 GCPRO1(dir); 2129 GCPRO1(dir);
2557 dir = Fdirectory_file_name (dir); 2130 dir = Fdirectory_file_name (dir);
2558 UNGCPRO; 2131 UNGCPRO;
2559 } 2132 }
2560 #endif /* VMS or MSDOS */ 2133 #endif /* MSDOS */
2561 return (check_writable (!NILP (dir) ? (char *) XSTRING_DATA (dir) 2134 return (check_writable (!NILP (dir) ? (char *) XSTRING_DATA (dir)
2562 : "") 2135 : "")
2563 ? Qt : Qnil); 2136 ? Qt : Qnil);
2564 } 2137 }
2565 2138
2795 umask (mode); 2368 umask (mode);
2796 2369
2797 return make_int ((~ mode) & 0777); 2370 return make_int ((~ mode) & 0777);
2798 } 2371 }
2799 2372
2800 #ifndef VMS
2801 DEFUN ("unix-sync", Funix_sync, 0, 0, "", /* 2373 DEFUN ("unix-sync", Funix_sync, 0, 0, "", /*
2802 Tell Unix to finish all pending disk updates. 2374 Tell Unix to finish all pending disk updates.
2803 */ 2375 */
2804 ()) 2376 ())
2805 { 2377 {
2806 #ifndef WINDOWSNT 2378 #ifndef WINDOWSNT
2807 sync (); 2379 sync ();
2808 #endif 2380 #endif
2809 return Qnil; 2381 return Qnil;
2810 } 2382 }
2811 #endif /* !VMS */
2812 2383
2813 2384
2814 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p, 2, 2, 0, /* 2385 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p, 2, 2, 0, /*
2815 Return t if file FILE1 is newer than file FILE2. 2386 Return t if file FILE1 is newer than file FILE2.
2816 If FILE1 does not exist, the answer is nil; 2387 If FILE1 does not exist, the answer is nil;
2959 st.st_mtime = -1; 2530 st.st_mtime = -1;
2960 goto notfound; 2531 goto notfound;
2961 } 2532 }
2962 2533
2963 #ifdef S_IFREG 2534 #ifdef S_IFREG
2964 /* This code will need to be changed in order to work on named 2535 /* Signal an error if we are accessing a non-regular file, with
2965 pipes, and it's probably just not worth it. So we should at 2536 REPLACE, BEG or END being non-nil. */
2966 least signal an error. */
2967 if (!S_ISREG (st.st_mode)) 2537 if (!S_ISREG (st.st_mode))
2968 { 2538 {
2969 not_regular = 1; 2539 not_regular = 1;
2970 2540
2971 if (!NILP (visit)) 2541 if (!NILP (visit))
2988 beg = Qzero; 2558 beg = Qzero;
2989 2559
2990 if (!NILP (end)) 2560 if (!NILP (end))
2991 CHECK_INT (end); 2561 CHECK_INT (end);
2992 2562
2563 /* Here, we should call some form of interruptable_open, so the user
2564 can quit gracefully when opening named pipes. interruptable_open
2565 should be just like sys_open in sysdep.c, only it would call QUIT
2566 if interrupted by EINTR. */
2993 if (fd < 0) 2567 if (fd < 0)
2994 if ((fd = open ((char *) XSTRING_DATA (filename), O_RDONLY, 0)) < 0) 2568 if ((fd = open ((char *) XSTRING_DATA (filename), O_RDONLY, 0)) < 0)
2995 goto badopen; 2569 goto badopen;
2996 2570
2997 /* Replacement should preserve point as it preserves markers. */ 2571 /* Replacement should preserve point as it preserves markers. */
3368 int failure; 2942 int failure;
3369 int save_errno = 0; 2943 int save_errno = 0;
3370 struct stat st; 2944 struct stat st;
3371 Lisp_Object fn; 2945 Lisp_Object fn;
3372 int speccount = specpdl_depth (); 2946 int speccount = specpdl_depth ();
3373 #ifdef VMS
3374 unsigned char *fname = 0; /* If non-0, original filename (must rename) */
3375 #endif /* VMS */
3376 int visiting_other = STRINGP (visit); 2947 int visiting_other = STRINGP (visit);
3377 int visiting = (EQ (visit, Qt) || visiting_other); 2948 int visiting = (EQ (visit, Qt) || visiting_other);
3378 int quietly = (!visiting && !NILP (visit)); 2949 int quietly = (!visiting && !NILP (visit));
3379 Lisp_Object visit_file = Qnil; 2950 Lisp_Object visit_file = Qnil;
3380 Lisp_Object annotations = Qnil; 2951 Lisp_Object annotations = Qnil;
3483 #else /* not DOS_NT */ 3054 #else /* not DOS_NT */
3484 desc = open ((char *) XSTRING_DATA (fn), O_WRONLY, 0); 3055 desc = open ((char *) XSTRING_DATA (fn), O_WRONLY, 0);
3485 #endif /* not DOS_NT */ 3056 #endif /* not DOS_NT */
3486 3057
3487 if (desc < 0) 3058 if (desc < 0)
3488 #ifndef VMS
3489 { 3059 {
3490 #ifdef DOS_NT 3060 #ifdef DOS_NT
3491 desc = open ((char *) XSTRING_DATA (fn), 3061 desc = open ((char *) XSTRING_DATA (fn),
3492 (O_WRONLY | O_TRUNC | O_CREAT | O_BINARY), 3062 (O_WRONLY | O_TRUNC | O_CREAT | O_BINARY),
3493 (S_IREAD | S_IWRITE)); 3063 (S_IREAD | S_IWRITE));
3494 #else /* not DOS_NT */ 3064 #else /* not DOS_NT */
3495 desc = creat ((char *) XSTRING_DATA (fn), 3065 desc = creat ((char *) XSTRING_DATA (fn),
3496 ((auto_saving) ? auto_save_mode_bits : 0666)); 3066 ((auto_saving) ? auto_save_mode_bits : 0666));
3497 #endif /* DOS_NT */ 3067 #endif /* DOS_NT */
3498 } 3068 }
3499 #else /* VMS */
3500 {
3501 if (auto_saving) /* Overwrite any previous version of autosave file */
3502 {
3503 char *fn_data = XSTRING_DATA (fn);
3504 /* if fn exists, truncate to zero length */
3505 vms_truncate (fn_data);
3506 desc = open (fn_data, O_RDWR, 0);
3507 if (desc < 0)
3508 desc = creat_copy_attrs ((STRINGP (current_buffer->filename)
3509 ? (char *)
3510 XSTRING_DATA (current_buffer->filename)
3511 : 0),
3512 fn_data);
3513 }
3514 else /* Write to temporary name and rename if no errors */
3515 {
3516 Lisp_Object temp_name;
3517
3518 struct gcpro gcpro1, gcpro2, gcpro3;
3519 GCPRO3 (start, filename, visit_file);
3520 {
3521 struct gcpro gcpro1, gcpro2, gcpro3; /* Don't have GCPRO6 */
3522
3523 GCPRO3 (fn, fname, annotations);
3524
3525 temp_name = Ffile_name_directory (filename);
3526
3527 if (NILP (temp_name))
3528 desc = creat ((char *) XSTRING_DATA (fn), 0666);
3529 else
3530 {
3531 temp_name =
3532 Fmake_temp_name (concat2 (temp_name,
3533 build_string ("$$SAVE$$")));
3534 fname = filename;
3535 fn = temp_name;
3536 desc = creat_copy_attrs (fname,
3537 (char *) XSTRING_DATA (fn));
3538 if (desc < 0)
3539 {
3540 char *fn_data;
3541 /* If we can't open the temporary file, try creating a new
3542 version of the original file. VMS "creat" creates a
3543 new version rather than truncating an existing file. */
3544 fn = fname;
3545 fname = Qnil;
3546 fn_data = XSTRING_DATA (fn);
3547 desc = creat (fn_data, 0666);
3548 #if 0 /* This can clobber an existing file and fail
3549 to replace it, if the user runs out of
3550 space. */
3551 if (desc < 0)
3552 {
3553 /* We can't make a new version;
3554 try to truncate and rewrite existing version if any.
3555 */
3556 vms_truncate (fn_data);
3557 desc = open (fn_data, O_RDWR, 0);
3558 }
3559 #endif /* 0 */
3560 }
3561 }
3562 UNGCPRO;
3563 }
3564 UNGCPRO;
3565 }
3566 }
3567 #endif /* VMS */
3568 3069
3569 if (desc < 0) 3070 if (desc < 0)
3570 { 3071 {
3571 #ifdef CLASH_DETECTION 3072 #ifdef CLASH_DETECTION
3572 save_errno = errno; 3073 save_errno = errno;
3595 #endif /* CLASH_DETECTION */ 3096 #endif /* CLASH_DETECTION */
3596 report_file_error ("Lseek error", 3097 report_file_error ("Lseek error",
3597 list1 (filename)); 3098 list1 (filename));
3598 } 3099 }
3599 } 3100 }
3600
3601 #ifdef VMS
3602 /*
3603 * Kludge Warning: The VMS C RTL likes to insert carriage returns
3604 * if we do writes that don't end with a carriage return. Furthermore
3605 * it cannot handle writes of more then 16K. The modified
3606 * version of "sys_write" in SYSDEP.C (see comment there) copes with
3607 * this EXCEPT for the last record (iff it doesn't end with a carriage
3608 * return). This implies that if your buffer doesn't end with a carriage
3609 * return, you get one free... tough. However it also means that if
3610 * we make two calls to sys_write (a la the following code) you can
3611 * get one at the gap as well. The easiest way to fix this (honest)
3612 * is to move the gap to the next newline (or the end of the buffer).
3613 * Thus this change.
3614 *
3615 * Yech!
3616 */
3617 you lose -- fix this
3618 if (GPT > BUF_BEG (current_buffer) && *GPT_ADDR[-1] != '\n')
3619 move_gap (find_next_newline (current_buffer, GPT, 1));
3620 #endif /* VMS */
3621 3101
3622 failure = 0; 3102 failure = 0;
3623 3103
3624 /* Note: I tried increasing the buffering size, along with 3104 /* Note: I tried increasing the buffering size, along with
3625 various other tricks, but nothing seemed to make much of 3105 various other tricks, but nothing seemed to make much of
3702 XCAR (desc_locative) = Qnil; 3182 XCAR (desc_locative) = Qnil;
3703 unbind_to (speccount, Qnil); 3183 unbind_to (speccount, Qnil);
3704 } 3184 }
3705 3185
3706 3186
3707 #ifdef VMS
3708 /* If we wrote to a temporary name and had no errors, rename to real name. */
3709 if (!NILP (fname))
3710 {
3711 if (!failure)
3712 {
3713 failure = (rename ((char *) XSTRING_DATA (fn),
3714 (char *) XSTRING_DATA (fname))
3715 != 0);
3716 save_errno = errno;
3717 }
3718 fn = fname;
3719 }
3720 #endif /* VMS */
3721
3722 #if 1 /* defined (VMS) || defined (APOLLO) */ 3187 #if 1 /* defined (VMS) || defined (APOLLO) */
3723 stat ((char *) XSTRING_DATA (fn), &st); 3188 stat ((char *) XSTRING_DATA (fn), &st);
3724 #endif 3189 #endif
3725 3190
3726 #ifdef CLASH_DETECTION 3191 #ifdef CLASH_DETECTION
4636 DEFSUBR (Frename_file); 4101 DEFSUBR (Frename_file);
4637 DEFSUBR (Fadd_name_to_file); 4102 DEFSUBR (Fadd_name_to_file);
4638 #ifdef S_IFLNK 4103 #ifdef S_IFLNK
4639 DEFSUBR (Fmake_symbolic_link); 4104 DEFSUBR (Fmake_symbolic_link);
4640 #endif /* S_IFLNK */ 4105 #endif /* S_IFLNK */
4641 #ifdef VMS
4642 DEFSUBR (Fdefine_logical_name);
4643 #endif /* VMS */
4644 #ifdef HPUX_NET 4106 #ifdef HPUX_NET
4645 DEFSUBR (Fsysnetunam); 4107 DEFSUBR (Fsysnetunam);
4646 #endif /* HPUX_NET */ 4108 #endif /* HPUX_NET */
4647 DEFSUBR (Ffile_name_absolute_p); 4109 DEFSUBR (Ffile_name_absolute_p);
4648 DEFSUBR (Ffile_exists_p); 4110 DEFSUBR (Ffile_exists_p);
4688 If it is t, which is the default, auto-save files are written in the 4150 If it is t, which is the default, auto-save files are written in the
4689 same format as a regular save would use. 4151 same format as a regular save would use.
4690 */ ); 4152 */ );
4691 Vauto_save_file_format = Qt; 4153 Vauto_save_file_format = Qt;
4692 4154
4693 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm /*
4694 *Non-nil means write new files with record format `stmlf'.
4695 nil means use format `var'. This variable is meaningful only on VMS.
4696 */ );
4697 vms_stmlf_recfm = 0;
4698
4699 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist /* 4155 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist /*
4700 *Alist of elements (REGEXP . HANDLER) for file names handled specially. 4156 *Alist of elements (REGEXP . HANDLER) for file names handled specially.
4701 If a file name matches REGEXP, then all I/O on that file is done by calling 4157 If a file name matches REGEXP, then all I/O on that file is done by calling
4702 HANDLER. 4158 HANDLER.
4703 4159