#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"
#include "systime.h"
#include "sysdep.h"
#include "syspwd.h"
+#include "sysfile.h" /* for getcwd */
/* Some static data, and a function to initialize it for each run */
Lisp_Object Vuser_full_name;
EXFUN (Fuser_full_name, 1);
-char *get_system_name (void);
-
Lisp_Object Qformat;
Lisp_Object Qpoint, Qmark, Qregion_beginning, Qregion_end;
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
and cleaner never to alter the window/buffer connections. */
/* I'm certain some code somewhere depends on this behavior. --jwz */
/* Even if it did, it certainly doesn't matter anymore, because
- this has been the behaviour for countless XEmacs releases
+ this has been the behavior for countless XEmacs releases
now. --hniksic */
if (visible
&& (current_buffer != XBUFFER (XWINDOW (selected_window)->buffer)))
DEFUN ("point-min", Fpoint_min, 0, 1, 0, /*
Return the minimum permissible value of point in BUFFER.
-This is 1, unless narrowing (a buffer restriction) is in effect.
+This is 1, unless narrowing (a buffer restriction)
+is in effect, in which case it may be greater.
If BUFFER is nil, the current buffer is assumed.
*/
(buffer))
DEFUN ("point-min-marker", Fpoint_min_marker, 0, 1, 0, /*
Return a marker to the minimum permissible value of point in BUFFER.
-This is the beginning, unless narrowing (a buffer restriction) is in effect.
+This is the beginning, unless narrowing (a buffer restriction)
+is in effect, in which case it may be greater.
If BUFFER is nil, the current buffer is assumed.
*/
(buffer))
DEFUN ("point-max", Fpoint_max, 0, 1, 0, /*
Return the maximum permissible value of point in BUFFER.
This is (1+ (buffer-size)), unless narrowing (a buffer restriction)
-is in effect, in which case it is less.
+is in effect, in which case it may be less.
If BUFFER is nil, the current buffer is assumed.
*/
(buffer))
}
DEFUN ("point-max-marker", Fpoint_max_marker, 0, 1, 0, /*
-Return a marker to the maximum permissible value of point BUFFER.
+Return a marker to the maximum permissible value of point in BUFFER.
This is (1+ (buffer-size)), unless narrowing (a buffer restriction)
-is in effect, in which case it is less.
+is in effect, in which case it may be less.
If BUFFER is nil, the current buffer is assumed.
*/
(buffer))
(buffer))
{
struct buffer *b = decode_buffer (buffer, 1);
-
return beginning_of_line_p (b, BUF_PT (b)) ? Qt : Qnil;
}
}
DEFUN ("char-after", Fchar_after, 0, 2, 0, /*
-Return character in BUFFER at position POS.
-POS is an integer or a buffer pointer.
+Return the character at position POS in BUFFER.
+POS is an integer or a marker.
If POS is out of range, the value is nil.
-If BUFFER is nil, the current buffer is assumed.
if POS is nil, the value of point is assumed.
+If BUFFER is nil, the current buffer is assumed.
*/
(pos, buffer))
{
}
DEFUN ("char-before", Fchar_before, 0, 2, 0, /*
-Return character in BUFFER before position POS.
-POS is an integer or a buffer pointer.
+Return the character preceding position POS in BUFFER.
+POS is an integer or a marker.
If POS is out of range, the value is nil.
-If BUFFER is nil, the current buffer is assumed.
if POS is nil, the value of point is assumed.
+If BUFFER is nil, the current buffer is assumed.
*/
(pos, buffer))
{
struct buffer *b = decode_buffer (buffer, 1);
- Bufpos n = ((NILP (pos) ? BUF_PT (b) :
- get_buffer_pos_char (b, pos, GB_NO_ERROR_IF_BAD)));
+ Bufpos n = (NILP (pos) ? BUF_PT (b) :
+ get_buffer_pos_char (b, pos, GB_NO_ERROR_IF_BAD));
n--;
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, /*
(uid))
{
char *returned_name;
- int local_uid;
+ uid_t local_uid;
if (!NILP (uid))
{
CHECK_INT (uid);
- local_uid = XINT(uid);
- returned_name = user_login_name(&local_uid);
+ local_uid = XINT (uid);
+ returned_name = user_login_name (&local_uid);
}
else
{
- returned_name = user_login_name(NULL);
+ returned_name = user_login_name (NULL);
}
/* #### - I believe this should return nil instead of "unknown" when pw==0
pw=0 is indicated by a null return from user_login_name
corresponds to a nil argument to Fuser_login_name.
*/
char*
-user_login_name (int *uid)
+user_login_name (uid_t *uid)
{
- struct passwd *pw = NULL;
-
/* uid == NULL to return name of this user */
if (uid != NULL)
{
- pw = getpwuid (*uid);
+ struct passwd *pw = getpwuid (*uid);
return pw ? pw->pw_name : NULL;
}
else
char *user_name = getenv ("LOGNAME");
if (!user_name)
user_name = getenv (
-#ifdef WINDOWSNT
+#ifdef WIN32_NATIVE
"USERNAME" /* it's USERNAME on NT */
#else
"USER"
return (user_name);
else
{
- pw = getpwuid (geteuid ());
-#ifdef __CYGWIN32__
+ struct passwd *pw = getpwuid (geteuid ());
+#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;
}
Lisp_Object user_name;
struct passwd *pw = NULL;
Lisp_Object tem;
- char *p, *q;
+ const char *p, *q;
if (NILP (user) && STRINGP (Vuser_full_name))
return Vuser_full_name;
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 */
}
-char *
+/* !!#### not Mule correct. */
+
+/* Returns the home directory, in external format */
+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)
{
- warn_when_safe(Quser_files_and_directories, Qwarning, "\n"
+ warn_when_safe (Quser_files_and_directories, Qwarning, "\n"
" XEmacs was unable to determine a good value for the user's $HOME\n"
" directory, and will be using the value:\n"
" %s\n"
" This is probably incorrect.",
- cached_home_directory
- );
+ cached_home_directory
+ );
}
}
- return (cached_home_directory);
+ return cached_home_directory;
}
DEFUN ("user-home-directory", Fuser_home_directory, 0, 0, 0, /*
*/
())
{
- Lisp_Object directory;
- char *path;
+ Extbyte *path = get_home_directory ();
- directory = Qnil;
- path = get_home_directory ();
- if (path != NULL)
- {
- directory =
- Fexpand_file_name (Fsubstitute_in_file_name (build_string (path)),
- Qnil);
- }
- return (directory);
+ return path == NULL ? Qnil :
+ Fexpand_file_name (Fsubstitute_in_file_name
+ (build_ext_string ((char *) path, Qfile_name)),
+ Qnil);
}
DEFUN ("system-name", Fsystem_name, 0, 0, 0, /*
return Fcopy_sequence (Vsystem_name);
}
-/* For the benefit of callers who don't want to include lisp.h.
- Caller must free! */
-char *
-get_system_name (void)
-{
- return xstrdup ((char *) XSTRING_DATA (Vsystem_name));
-}
-
DEFUN ("emacs-pid", Femacs_pid, 0, 0, 0, /*
Return the process ID of Emacs, as an integer.
*/
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, /*
%p is replaced by AM or PM, as appropriate.
%r is a synonym for "%I:%M:%S %p".
%R is a synonym for "%H:%M".
+%s is replaced by the time in seconds since 00:00:00, Jan 1, 1970 (a
+ nonstandard extension)
%S is replaced by the second (00-60).
%t is a synonym for "\\t".
%T is a synonym for "%H:%M:%S".
BUG: If the charset used by the current locale is not ISO 8859-1, the
characters appearing in the day and month names may be incorrect.
*/
- (format_string, _time))
+ (format_string, time_))
{
time_t value;
size_t size;
CHECK_STRING (format_string);
- if (! lisp_to_time (_time, &value))
+ if (! lisp_to_time (time_, &value))
error ("Invalid time specification");
/* This is probably enough. */
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;
}
error ("Invalid time specification");
decoded_time = localtime (&time_spec);
- XSETINT (list_args[0], decoded_time->tm_sec);
- XSETINT (list_args[1], decoded_time->tm_min);
- XSETINT (list_args[2], decoded_time->tm_hour);
- XSETINT (list_args[3], decoded_time->tm_mday);
- XSETINT (list_args[4], decoded_time->tm_mon + 1);
- XSETINT (list_args[5], decoded_time->tm_year + 1900);
- XSETINT (list_args[6], decoded_time->tm_wday);
+ list_args[0] = make_int (decoded_time->tm_sec);
+ list_args[1] = make_int (decoded_time->tm_min);
+ list_args[2] = make_int (decoded_time->tm_hour);
+ list_args[3] = make_int (decoded_time->tm_mday);
+ list_args[4] = make_int (decoded_time->tm_mon + 1);
+ list_args[5] = make_int (decoded_time->tm_year + 1900);
+ list_args[6] = make_int (decoded_time->tm_wday);
list_args[7] = (decoded_time->tm_isdst)? Qt : Qnil;
/* Make a copy, in case gmtime modifies the struct. */
if (decoded_time == 0)
list_args[8] = Qnil;
else
- XSETINT (list_args[8], difftm (&save_tm, decoded_time));
+ list_args[8] = make_int (difftm (&save_tm, decoded_time));
return Flist (9, list_args);
}
*/
(int nargs, Lisp_Object *args))
{
- time_t _time;
+ time_t the_time;
struct tm tm;
Lisp_Object zone = (nargs > 6) ? args[nargs - 1] : Qnil;
if (CONSP (zone))
zone = XCAR (zone);
if (NILP (zone))
- _time = mktime (&tm);
+ the_time = mktime (&tm);
else
{
char tzbuf[100];
value doesn't suffice, since that would mishandle leap seconds. */
set_time_zone_rule (tzstring);
- _time = mktime (&tm);
+ the_time = mktime (&tm);
/* Restore TZ to previous value. */
newenv = environ;
#endif
}
- if (_time == (time_t) -1)
+ if (the_time == (time_t) -1)
error ("Specified time is not representable");
- return wasteful_word_to_lisp (_time);
+ return wasteful_word_to_lisp (the_time);
}
DEFUN ("current-time-string", Fcurrent_time_string, 0, 1, 0, /*
(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;
return make_string_from_buffer (b, begv, zv - begv);
}
+/* It might make more sense to name this
+ `buffer-substring-no-extents', but this name is FSFmacs-compatible,
+ 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 START to END as a string, without copying the extents.
+*/
+ (start, end, buffer))
+{
+ /* This function can GC */
+ Bufpos begv, zv;
+ struct buffer *b = decode_buffer (buffer, 1);
+
+ get_buffer_range_char (b, start, end, &begv, &zv, GB_ALLOW_NIL);
+ return make_string_from_buffer_no_extents (b, begv, zv - begv);
+}
+
DEFUN ("insert-buffer-substring", Finsert_buffer_substring, 1, 3, 0, /*
Insert before point a substring of the contents of buffer BUFFER.
BUFFER may be a buffer or a buffer name.
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. */
return Qnil;
}
+/* #### Shouldn't this also accept a BUFFER argument, in the good old
+ XEmacs tradition? */
DEFUN ("translate-region", Ftranslate_region, 3, 3, 0, /*
-From START to END, translate characters according to TABLE.
-TABLE is a string; the Nth character in it is the mapping
-for the character with code N. Returns the number of characters changed.
+Translate characters from START to END according to TABLE.
+
+If TABLE is a string, the Nth character in it is the mapping for the
+character with code N.
+
+If TABLE is a vector, its Nth element is the mapping for character
+with code N. The values of elements may be characters, strings, or
+nil (nil meaning don't replace.)
+
+If TABLE is a char-table, its elements describe the mapping between
+characters and their replacements. The char-table should be of type
+`char' or `generic'.
+
+Returns the number of substitutions performed.
*/
(start, end, table))
{
/* This function can GC */
Bufpos pos, stop; /* Limits of the region. */
- REGISTER Emchar oc; /* Old character. */
- REGISTER Emchar nc; /* New character. */
- int cnt; /* Number of changes made. */
- Charcount size; /* Size of translate table. */
+ int cnt = 0; /* Number of changes made. */
int mc_count;
struct buffer *buf = current_buffer;
+ Emchar oc;
get_buffer_range_char (buf, start, end, &pos, &stop, 0);
- CHECK_STRING (table);
-
- size = XSTRING_CHAR_LENGTH (table);
-
- cnt = 0;
mc_count = begin_multiple_change (buf, pos, stop);
- for (; pos < stop; pos++)
+ if (STRINGP (table))
{
- oc = BUF_FETCH_CHAR (buf, pos);
- if (oc >= 0 && oc < size)
+ 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
+ large regions it makes sense to create an array of Emchars. */
+ if (size * (stop - pos) > 65536)
{
- nc = string_char (XSTRING (table), oc);
- if (nc != oc)
+ Emchar *etable = alloca_array (Emchar, size);
+ convert_bufbyte_string_into_emchar_string
+ (string_data (stable), string_length (stable), etable);
+ for (; pos < stop && (oc = BUF_FETCH_CHAR (buf, pos), 1); pos++)
{
- buffer_replace_char (buf, pos, nc, 0, 0);
+ if (oc < size)
+ {
+ Emchar nc = etable[oc];
+ if (nc != oc)
+ {
+ buffer_replace_char (buf, pos, nc, 0, 0);
+ ++cnt;
+ }
+ }
+ }
+ }
+ else
+#endif /* MULE */
+ {
+ for (; pos < stop && (oc = BUF_FETCH_CHAR (buf, pos), 1); pos++)
+ {
+ if (oc < size)
+ {
+ Emchar nc = string_char (stable, oc);
+ if (nc != oc)
+ {
+ buffer_replace_char (buf, pos, nc, 0, 0);
+ ++cnt;
+ }
+ }
+ }
+ }
+ }
+ else if (VECTORP (table))
+ {
+ Charcount size = XVECTOR_LENGTH (table);
+ Lisp_Object *vtable = XVECTOR_DATA (table);
+
+ for (; pos < stop && (oc = BUF_FETCH_CHAR (buf, pos), 1); pos++)
+ {
+ if (oc < size)
+ {
+ Lisp_Object replacement = vtable[oc];
+ retry:
+ if (CHAR_OR_CHAR_INTP (replacement))
+ {
+ Emchar nc = XCHAR_OR_CHAR_INT (replacement);
+ if (nc != oc)
+ {
+ buffer_replace_char (buf, pos, nc, 0, 0);
+ ++cnt;
+ }
+ }
+ else if (STRINGP (replacement))
+ {
+ Charcount incr = XSTRING_CHAR_LENGTH (replacement) - 1;
+ buffer_delete_range (buf, pos, pos + 1, 0);
+ buffer_insert_lisp_string_1 (buf, pos, replacement, 0);
+ pos += incr, stop += incr;
+ ++cnt;
+ }
+ else if (!NILP (replacement))
+ {
+ replacement = wrong_type_argument (Qchar_or_string_p, replacement);
+ goto retry;
+ }
+ }
+ }
+ }
+ else if (CHAR_TABLEP (table)
+ && (XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_GENERIC
+ || XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_CHAR))
+ {
+ Lisp_Char_Table *ctable = XCHAR_TABLE (table);
+
+ for (; pos < stop && (oc = BUF_FETCH_CHAR (buf, pos), 1); pos++)
+ {
+ Lisp_Object replacement = get_char_table (oc, ctable);
+ retry2:
+ if (CHAR_OR_CHAR_INTP (replacement))
+ {
+ Emchar nc = XCHAR_OR_CHAR_INT (replacement);
+ if (nc != oc)
+ {
+ buffer_replace_char (buf, pos, nc, 0, 0);
+ ++cnt;
+ }
+ }
+ else if (STRINGP (replacement))
+ {
+ Charcount incr = XSTRING_CHAR_LENGTH (replacement) - 1;
+ buffer_delete_range (buf, pos, pos + 1, 0);
+ buffer_insert_lisp_string_1 (buf, pos, replacement, 0);
+ pos += incr, stop += incr;
++cnt;
}
+ else if (!NILP (replacement))
+ {
+ replacement = wrong_type_argument (Qchar_or_string_p, replacement);
+ goto retry2;
+ }
}
}
+ else
+ dead_wrong_type_argument (Qstringp, table);
end_multiple_change (buf, mc_count);
return make_int (cnt);
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)
? Qt : Qnil;
}
-DEFUN ("char=", Fchar_Equal, 2, 3, 0, /*
+DEFUN ("char=", Fchar_Equal, 2, 2, 0, /*
Return t if two characters match, case is significant.
Both arguments must be characters (i.e. NOT integers).
-The optional buffer argument is for symmetry and is ignored.
*/
- (c1, c2, buffer))
+ (character1, character2))
{
- CHECK_CHAR_COERCE_INT (c1);
- CHECK_CHAR_COERCE_INT (c2);
+ CHECK_CHAR_COERCE_INT (character1);
+ CHECK_CHAR_COERCE_INT (character2);
- return XCHAR(c1) == XCHAR(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
DEFSUBR (Fstring_to_char);
DEFSUBR (Fchar_to_string);
DEFSUBR (Fbuffer_substring);
+ DEFSUBR (Fbuffer_substring_no_properties);
DEFSUBR (Fpoint_marker);
DEFSUBR (Fmark_marker);
- 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;