#include "frame.h"
#include "insdel.h"
#include "window.h"
+#include "chartab.h"
#include "line-number.h"
#include "systime.h"
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)))
(buffer))
{
struct buffer *b = decode_buffer (buffer, 1);
-
return beginning_of_line_p (b, BUF_PT (b)) ? Qt : Qnil;
}
user_login_name (int *uid)
{
struct passwd *pw = NULL;
-
+
/* uid == NULL to return name of this user */
if (uid != NULL)
{
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;
of a few bytes */
}
+/* Returns the home directory, in external format */
char *
get_home_directory (void)
{
{
#if defined(WINDOWSNT) && !defined(__CYGWIN32__)
char *homedrive, *homepath;
-
+
if ((homedrive = getenv("HOMEDRIVE")) != NULL &&
(homepath = getenv("HOMEPATH")) != NULL)
{
}
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;
+ char *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 (path, FORMAT_FILENAME)),
+ Qnil);
}
DEFUN ("system-name", Fsystem_name, 0, 0, 0, /*
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. */
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, /*
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 BEG 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.
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)
+ struct 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)
+ {
+ 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++)
+ {
+ if (oc < size)
+ {
+ Emchar nc = etable[oc];
+ if (nc != oc)
+ {
+ buffer_replace_char (buf, pos, nc, 0, 0);
+ ++cnt;
+ }
+ }
+ }
+ }
+ else
+#endif /* MULE */
{
- nc = string_char (XSTRING (table), oc);
- if (nc != oc)
+ for (; pos < stop && (oc = BUF_FETCH_CHAR (buf, pos), 1); pos++)
{
- buffer_replace_char (buf, pos, nc, 0, 0);
+ 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))
+ {
+ struct 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);
DEFSUBR (Fstring_to_char);
DEFSUBR (Fchar_to_string);
DEFSUBR (Fbuffer_substring);
+ DEFSUBR (Fbuffer_substring_no_properties);
DEFSUBR (Fpoint_marker);
DEFSUBR (Fmark_marker);
projects / chise / xemacs-chise.git.1 / blobdiff