#include <config.h>
#include "lisp.h"
-#ifdef HAVE_UNISTD_H
-#include <unistd.h>
-#endif
#include "buffer.h"
#include "commands.h"
#include "frame.h"
#include "insdel.h"
#include "window.h"
+#include "casetab.h"
#include "chartab.h"
#include "line-number.h"
if ((p = getenv ("NAME")))
/* I don't think it's the right thing to do the ampersand
modification on NAME. Not that it matters anymore... -hniksic */
- Vuser_full_name = build_ext_string (p, FORMAT_OS);
+ Vuser_full_name = build_ext_string (p, Qnative);
else
Vuser_full_name = Fuser_full_name (Qnil);
}
\f
DEFUN ("char-to-string", Fchar_to_string, 1, 1, 0, /*
-Convert arg CH to a one-character string containing that character.
+Convert CHARACTER to a one-character string containing that character.
*/
- (ch))
+ (character))
{
Bytecount len;
Bufbyte str[MAX_EMCHAR_LEN];
- if (EVENTP (ch))
+ if (EVENTP (character))
{
- Lisp_Object ch2 = Fevent_to_character (ch, Qt, Qnil, Qnil);
+ Lisp_Object ch2 = Fevent_to_character (character, Qt, Qnil, Qnil);
if (NILP (ch2))
return
signal_simple_continuable_error
- ("character has no ASCII equivalent:", Fcopy_event (ch, Qnil));
- ch = ch2;
+ ("character has no ASCII equivalent:", Fcopy_event (character, Qnil));
+ character = ch2;
}
- CHECK_CHAR_COERCE_INT (ch);
+ CHECK_CHAR_COERCE_INT (character);
- len = set_charptr_emchar (str, XCHAR (ch));
+ len = set_charptr_emchar (str, XCHAR (character));
return make_string (str, len);
}
Convert arg STRING to a character, the first character of that string.
An empty string will return the constant `nil'.
*/
- (str))
+ (string))
{
- struct Lisp_String *p;
- CHECK_STRING (str);
+ Lisp_String *p;
+ CHECK_STRING (string);
- p = XSTRING (str);
+ p = XSTRING (string);
if (string_length (p) != 0)
return make_char (string_char (p, 0));
else
return make_char (BUF_FETCH_CHAR (b, n));
}
+#if !defined(WINDOWSNT) && !defined(MSDOS)
+#include <sys/stat.h>
+#include <fcntl.h>
+#include <errno.h>
+#include <limits.h>
+#endif
\f
DEFUN ("temp-directory", Ftemp_directory, 0, 0, 0, /*
Return the pathname to the directory to use for temporary files.
-On NT/MSDOS, this is obtained from the TEMP or TMP environment variables,
+On MS Windows, this is obtained from the TEMP or TMP environment variables,
defaulting to / if they are both undefined.
-On Unix it is obtained from TMPDIR, with /tmp as the default
+On Unix it is obtained from TMPDIR, with /tmp as the default.
*/
())
{
char *tmpdir;
-#if defined(WINDOWSNT) || defined(MSDOS)
+#if defined(WIN32_NATIVE)
tmpdir = getenv ("TEMP");
if (!tmpdir)
tmpdir = getenv ("TMP");
if (!tmpdir)
tmpdir = "/";
-#else /* WINDOWSNT || MSDOS */
+#else /* WIN32_NATIVE */
tmpdir = getenv ("TMPDIR");
if (!tmpdir)
+ {
+ struct stat st;
+ int myuid = getuid();
+ static char path[5 /* strlen ("/tmp/") */ + 1 + _POSIX_PATH_MAX];
+
+ strcpy (path, "/tmp/");
+ strncat (path, user_login_name (NULL), _POSIX_PATH_MAX);
+ if (lstat(path, &st) < 0 && errno == ENOENT)
+ {
+ mkdir(path, 0700); /* ignore retval -- checked next anyway. */
+ }
+ if (lstat(path, &st) == 0 && st.st_uid == myuid && S_ISDIR(st.st_mode))
+ {
+ tmpdir = path;
+ }
+ else
+ {
+ strcpy(path, getenv("HOME")); strncat(path, "/tmp/", _POSIX_PATH_MAX);
+ if (stat(path, &st) < 0 && errno == ENOENT)
+ {
+ int fd;
+ char warnpath[1+_POSIX_PATH_MAX];
+ mkdir(path, 0700); /* ignore retvals */
+ strcpy(warnpath, path);
+ strncat(warnpath, ".created_by_xemacs", _POSIX_PATH_MAX);
+ if ((fd = open(warnpath, O_WRONLY|O_CREAT, 0644)) > 0)
+ {
+ write(fd, "XEmacs created this directory because /tmp/<yourname> was unavailable -- \nPlease check !\n", 89);
+ close(fd);
+ }
+ }
+ if (stat(path, &st) == 0 && S_ISDIR(st.st_mode))
+ {
+ tmpdir = path;
+ }
+ else
+ {
tmpdir = "/tmp";
+ }
+ }
+ }
#endif
- return build_ext_string (tmpdir, FORMAT_FILENAME);
+ return build_ext_string (tmpdir, Qfile_name);
}
DEFUN ("user-login-name", Fuser_login_name, 0, 1, 0, /*
char *user_name = getenv ("LOGNAME");
if (!user_name)
user_name = getenv (
-#ifdef WINDOWSNT
+#ifdef WIN32_NATIVE
"USERNAME" /* it's USERNAME on NT */
#else
"USER"
else
{
struct passwd *pw = getpwuid (geteuid ());
-#ifdef __CYGWIN32__
+#ifdef CYGWIN
/* Since the Cygwin environment may not have an /etc/passwd,
return "unknown" instead of the null if the username
cannot be determined.
struct passwd *pw = getpwuid (getuid ());
/* #### - I believe this should return nil instead of "unknown" when pw==0 */
-#ifdef MSDOS
- /* We let the real user name default to "root" because that's quite
- accurate on MSDOG and because it lets Emacs find the init file.
- (The DVX libraries override the Djgpp libraries here.) */
- Lisp_Object tem = build_string (pw ? pw->pw_name : "root");/* no gettext */
-#else
Lisp_Object tem = build_string (pw ? pw->pw_name : "unknown");/* no gettext */
-#endif
return tem;
}
user_name = (STRINGP (user) ? user : Fuser_login_name (user));
if (!NILP (user_name)) /* nil when nonexistent UID passed as arg */
{
- CONST char *user_name_ext;
+ const char *user_name_ext;
/* Fuck me. getpwnam() can call select() and (under IRIX at least)
things get wedged if a SIGIO arrives during this time. */
- GET_C_STRING_OS_DATA_ALLOCA (user_name, user_name_ext);
+ TO_EXTERNAL_FORMAT (LISP_STRING, user_name,
+ C_STRING_ALLOCA, user_name_ext,
+ Qnative);
slow_down_interrupts ();
pw = (struct passwd *) getpwnam (user_name_ext);
speed_up_interrupts ();
/* #### - Stig sez: this should return nil instead of "unknown" when pw==0 */
/* Ben sez: bad idea because it's likely to break something */
#ifndef AMPERSAND_FULL_NAME
- p = ((pw) ? USER_FULL_NAME : "unknown"); /* don't gettext */
+ p = pw ? USER_FULL_NAME : "unknown"; /* don't gettext */
q = strchr (p, ',');
#else
- p = ((pw) ? USER_FULL_NAME : "unknown"); /* don't gettext */
+ p = pw ? USER_FULL_NAME : "unknown"; /* don't gettext */
q = strchr (p, ',');
#endif
tem = ((!NILP (user) && !pw)
? Qnil
: make_ext_string ((Extbyte *) p, (q ? q - p : strlen (p)),
- FORMAT_OS));
+ Qnative));
#ifdef AMPERSAND_FULL_NAME
if (!NILP (tem))
return tem;
}
-static char *cached_home_directory;
+static Extbyte *cached_home_directory;
void
uncache_home_directory (void)
of a few bytes */
}
+/* !!#### not Mule correct. */
+
/* Returns the home directory, in external format */
-char *
+Extbyte *
get_home_directory (void)
{
+ /* !!#### this is hopelessly bogus. Rule #1: Do not make any assumptions
+ about what format an external string is in. Could be Unicode, for all
+ we know, and then all the operations below are totally bogus.
+ Instead, convert all data to internal format *right* at the juncture
+ between XEmacs and the outside world, the very moment we first get
+ the data. --ben */
int output_home_warning = 0;
if (cached_home_directory == NULL)
{
- if ((cached_home_directory = getenv("HOME")) == NULL)
+ if ((cached_home_directory = (Extbyte *) getenv("HOME")) == NULL)
{
-#if defined(WINDOWSNT) && !defined(__CYGWIN32__)
- char *homedrive, *homepath;
+#if defined(WIN32_NATIVE)
+ char *homedrive, *homepath;
if ((homedrive = getenv("HOMEDRIVE")) != NULL &&
(homepath = getenv("HOMEPATH")) != NULL)
{
cached_home_directory =
- (char *) xmalloc(strlen(homedrive) + strlen(homepath) + 1);
- sprintf(cached_home_directory, "%s%s", homedrive, homepath);
+ (Extbyte *) xmalloc (strlen (homedrive) +
+ strlen (homepath) + 1);
+ sprintf((char *) cached_home_directory, "%s%s",
+ homedrive,
+ homepath);
}
else
{
-# if 1
+# if 0 /* changed by ben. This behavior absolutely stinks, and the
+ possibility being addressed here occurs quite commonly.
+ Using the current directory makes absolutely no sense. */
/*
* Use the current directory.
* This preserves the existing XEmacs behavior, but is different
*/
if (initial_directory[0] != '\0')
{
- cached_home_directory = initial_directory;
+ cached_home_directory = (Extbyte*) initial_directory;
}
else
{
/* This will probably give the wrong value */
- cached_home_directory = getcwd (NULL, 0);
+ cached_home_directory = (Extbyte*) getcwd (NULL, 0);
}
# else
/*
* This is NT Emacs behavior
*/
- cached_home_directory = "C:\\";
+ cached_home_directory = (Extbyte *) "C:\\";
output_home_warning = 1;
# endif
}
-#else /* !WINDOWSNT */
+#else /* !WIN32_NATIVE */
/*
* Unix, typically.
* Using "/" isn't quite right, but what should we do?
* We probably should try to extract pw_dir from /etc/passwd,
* before falling back to this.
*/
- cached_home_directory = "/";
+ cached_home_directory = (Extbyte *) "/";
output_home_warning = 1;
-#endif /* !WINDOWSNT */
+#endif /* !WIN32_NATIVE */
}
if (initialized && output_home_warning)
{
*/
())
{
- char *path = get_home_directory ();
+ Extbyte *path = get_home_directory ();
return path == NULL ? Qnil :
Fexpand_file_name (Fsubstitute_in_file_name
- (build_ext_string (path, FORMAT_FILENAME)),
+ (build_ext_string ((char *) path, Qfile_name)),
Qnil);
}
return Fcons (make_int (item >> 16), make_int (item & 0xffff));
}
-size_t emacs_strftime (char *string, size_t max, CONST char *format,
- CONST struct tm *tm);
-static long difftm (CONST struct tm *a, CONST struct tm *b);
+size_t emacs_strftime (char *string, size_t max, const char *format,
+ const struct tm *tm);
+static long difftm (const struct tm *a, const struct tm *b);
DEFUN ("format-time-string", Fformat_time_string, 1, 2, 0, /*
char *buf = (char *) alloca (size);
*buf = 1;
if (emacs_strftime (buf, size,
- (CONST char *) XSTRING_DATA (format_string),
+ (const char *) XSTRING_DATA (format_string),
localtime (&value))
|| !*buf)
- return build_ext_string (buf, FORMAT_BINARY);
+ return build_ext_string (buf, Qbinary);
/* If buffer was too small, make it bigger. */
size *= 2;
}
(specified_time))
{
time_t value;
- char buf[30];
- char *tem;
+ char *the_ctime;
+ size_t len;
if (! lisp_to_time (specified_time, &value))
value = -1;
- tem = (char *) ctime (&value);
+ the_ctime = ctime (&value);
- strncpy (buf, tem, 24);
- buf[24] = 0;
+ /* ctime is documented as always returning a "\n\0"-terminated
+ 26-byte American time string, but let's be careful anyways. */
+ for (len = 0; the_ctime[len] != '\n' && the_ctime[len] != '\0'; len++)
+ ;
- return build_ext_string (buf, FORMAT_BINARY);
+ return make_ext_string ((Extbyte *) the_ctime, len, Qbinary);
}
#define TM_YEAR_ORIGIN 1900
/* Yield A - B, measured in seconds. */
static long
-difftm (CONST struct tm *a, CONST struct tm *b)
+difftm (const struct tm *a, const struct tm *b)
{
int ay = a->tm_year + (TM_YEAR_ORIGIN - 1);
int by = b->tm_year + (TM_YEAR_ORIGIN - 1);
\f
DEFUN ("insert-char", Finsert_char, 1, 4, 0, /*
-Insert COUNT (second arg) copies of CHR (first arg).
+Insert COUNT copies of CHARACTER into BUFFER.
Point and all markers are affected as in the function `insert'.
COUNT defaults to 1 if omitted.
The optional third arg IGNORED is INHERIT under FSF Emacs.
The optional fourth arg BUFFER specifies the buffer to insert the
text into. If BUFFER is nil, the current buffer is assumed.
*/
- (chr, count, ignored, buffer))
+ (character, count, ignored, buffer))
{
/* This function can GC */
REGISTER Bufbyte *string;
struct buffer *b = decode_buffer (buffer, 1);
int cou;
- CHECK_CHAR_COERCE_INT (chr);
+ CHECK_CHAR_COERCE_INT (character);
if (NILP (count))
cou = 1;
else
cou = XINT (count);
}
- charlen = set_charptr_emchar (str, XCHAR (chr));
+ charlen = set_charptr_emchar (str, XCHAR (character));
n = cou * charlen;
if (n <= 0)
return Qnil;
and what the function does is probably good enough for what the
user-code will typically want to use it for. */
DEFUN ("buffer-substring-no-properties", Fbuffer_substring_no_properties, 0, 3, 0, /*
-Return the text from BEG to END, as a string, without copying the extents.
+Return the text from START to END as a string, without copying the extents.
*/
(start, end, buffer))
{
REGISTER Charcount len1, len2, length, i;
struct buffer *bp1, *bp2;
Lisp_Object trt = ((!NILP (current_buffer->case_fold_search)) ?
- current_buffer->case_canon_table : Qnil);
+ XCASE_TABLE_CANON (current_buffer->case_table) : Qnil);
/* Find the first buffer and its substring. */
mc_count = begin_multiple_change (buf, pos, stop);
if (STRINGP (table))
{
- struct Lisp_String *stable = XSTRING (table);
+ Lisp_String *stable = XSTRING (table);
Charcount size = string_char_length (stable);
#ifdef MULE
/* Under Mule, string_char(n) is O(n), so for large tables or
&& (XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_GENERIC
|| XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_CHAR))
{
- struct Lisp_Char_Table *ctable = XCHAR_TABLE (table);
+ Lisp_Char_Table *ctable = XCHAR_TABLE (table);
for (; pos < stop && (oc = BUF_FETCH_CHAR (buf, pos), 1); pos++)
{
DEFUN ("delete-region", Fdelete_region, 2, 3, "r", /*
Delete the text between point and mark.
-When called from a program, expects two arguments,
-positions (integers or markers) specifying the stretch to be deleted.
-If BUFFER is nil, the current buffer is assumed.
+When called from a program, expects two arguments START and END
+\(integers or markers) specifying the stretch to be deleted.
+If optional third arg BUFFER is nil, the current buffer is assumed.
*/
- (b, e, buffer))
+ (start, end, buffer))
{
/* This function can GC */
- Bufpos start, end;
+ Bufpos bp_start, bp_end;
struct buffer *buf = decode_buffer (buffer, 1);
- get_buffer_range_char (buf, b, e, &start, &end, 0);
- buffer_delete_range (buf, start, end, 0);
+ get_buffer_range_char (buf, start, end, &bp_start, &bp_end, 0);
+ buffer_delete_range (buf, bp_start, bp_end, 0);
zmacs_region_stays = 0;
return Qnil;
}
When calling from a program, pass two arguments; positions (integers
or markers) bounding the text that should remain visible.
*/
- (b, e, buffer))
+ (start, end, buffer))
{
- Bufpos start, end;
+ Bufpos bp_start, bp_end;
struct buffer *buf = decode_buffer (buffer, 1);
Bytind bi_start, bi_end;
- get_buffer_range_char (buf, b, e, &start, &end, GB_ALLOW_PAST_ACCESSIBLE);
- bi_start = bufpos_to_bytind (buf, start);
- bi_end = bufpos_to_bytind (buf, end);
-
- SET_BOTH_BUF_BEGV (buf, start, bi_start);
- SET_BOTH_BUF_ZV (buf, end, bi_end);
- if (BUF_PT (buf) < start)
- BUF_SET_PT (buf, start);
- if (BUF_PT (buf) > end)
- BUF_SET_PT (buf, end);
+ get_buffer_range_char (buf, start, end, &bp_start, &bp_end,
+ GB_ALLOW_PAST_ACCESSIBLE);
+ bi_start = bufpos_to_bytind (buf, bp_start);
+ bi_end = bufpos_to_bytind (buf, bp_end);
+
+ SET_BOTH_BUF_BEGV (buf, bp_start, bi_start);
+ SET_BOTH_BUF_ZV (buf, bp_end, bi_end);
+ if (BUF_PT (buf) < bp_start)
+ BUF_SET_PT (buf, bp_start);
+ if (BUF_PT (buf) > bp_end)
+ BUF_SET_PT (buf, bp_end);
MARK_CLIP_CHANGED;
/* Changing the buffer bounds invalidates any recorded current column. */
invalidate_current_column ();
Case is ignored if `case-fold-search' is non-nil in BUFFER.
If BUFFER is nil, the current buffer is assumed.
*/
- (c1, c2, buffer))
+ (character1, character2, buffer))
{
Emchar x1, x2;
struct buffer *b = decode_buffer (buffer, 1);
- CHECK_CHAR_COERCE_INT (c1);
- CHECK_CHAR_COERCE_INT (c2);
- x1 = XCHAR (c1);
- x2 = XCHAR (c2);
+ CHECK_CHAR_COERCE_INT (character1);
+ CHECK_CHAR_COERCE_INT (character2);
+ x1 = XCHAR (character1);
+ x2 = XCHAR (character2);
return (!NILP (b->case_fold_search)
? DOWNCASE (b, x1) == DOWNCASE (b, x2)
Return t if two characters match, case is significant.
Both arguments must be characters (i.e. NOT integers).
*/
- (c1, c2))
+ (character1, character2))
{
- CHECK_CHAR_COERCE_INT (c1);
- CHECK_CHAR_COERCE_INT (c2);
+ CHECK_CHAR_COERCE_INT (character1);
+ CHECK_CHAR_COERCE_INT (character2);
- return EQ (c1, c2) ? Qt : Qnil;
+ return EQ (character1, character2) ? Qt : Qnil;
}
\f
#if 0 /* Undebugged FSFmacs code */
The regions may not be overlapping, because the size of the buffer is
never changed in a transposition.
-Optional fifth arg LEAVE_MARKERS, if non-nil, means don't transpose
+Optional fifth arg LEAVE-MARKERS, if non-nil, means don't transpose
any markers that happen to be located in the regions. (#### BUG: currently
-this function always acts as if LEAVE_MARKERS is non-nil.)
+this function always acts as if LEAVE-MARKERS is non-nil.)
Transposing beyond buffer boundaries is an error.
*/
- (startr1, endr1, startr2, endr2, leave_markers))
+ (start1, end1, start2, end2, leave_markers))
{
- Bufpos start1, end1, start2, end2;
+ Bufpos startr1, endr1, startr2, endr2;
Charcount len1, len2;
Lisp_Object string1, string2;
struct buffer *buf = current_buffer;
- get_buffer_range_char (buf, startr1, endr1, &start1, &end1, 0);
- get_buffer_range_char (buf, startr2, endr2, &start2, &end2, 0);
+ get_buffer_range_char (buf, start1, end1, &startr1, &endr1, 0);
+ get_buffer_range_char (buf, start2, end2, &startr2, &endr2, 0);
- len1 = end1 - start1;
- len2 = end2 - start2;
+ len1 = endr1 - startr1;
+ len2 = endr2 - startr2;
- if (start2 < end1)
+ if (startr2 < endr1)
error ("transposed regions not properly ordered");
- else if (start1 == end1 || start2 == end2)
+ else if (startr1 == endr1 || startr2 == endr2)
error ("transposed region may not be of length 0");
- string1 = make_string_from_buffer (buf, start1, len1);
- string2 = make_string_from_buffer (buf, start2, len2);
- buffer_delete_range (buf, start2, end2, 0);
- buffer_insert_lisp_string_1 (buf, start2, string1, 0);
- buffer_delete_range (buf, start1, end1, 0);
- buffer_insert_lisp_string_1 (buf, start1, string2, 0);
+ string1 = make_string_from_buffer (buf, startr1, len1);
+ string2 = make_string_from_buffer (buf, startr2, len2);
+ buffer_delete_range (buf, startr2, endr2, 0);
+ buffer_insert_lisp_string_1 (buf, startr2, string1, 0);
+ buffer_delete_range (buf, startr1, endr1, 0);
+ buffer_insert_lisp_string_1 (buf, startr1, string2, 0);
/* In FSFmacs there is a whole bunch of really ugly code here
to attempt to transpose the regions without using up any
- Commands which operate on the region only work if the region is active.
- Only a very small set of commands cause the region to become active:
- Those commands whose semantics are to mark an area, like mark-defun.
+ Those commands whose semantics are to mark an area, like `mark-defun'.
- The region is deactivated after each command that is executed, except that:
- "Motion" commands do not change whether the region is active or not.
See the variable `zmacs-regions'.
The same effect can be achieved using the `_' interactive specification.
+
+`zmacs-region-stays' is reset to nil before each command is executed.
*/ );
zmacs_region_stays = 0;
projects / chise / xemacs-chise.git.1 / blobdiff