X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=src%2Feditfns.c;h=b914b4a93e9cfeac7258ba0a209e133e7a055c94;hb=8afb64af7147481903a263cd94cd2f42ec9a8b67;hp=442a00b773296b0d5873195c2d24f7c2898f001c;hpb=6883ee56ec887c2c48abe5b06b5e66aa74031910;p=chise%2Fxemacs-chise.git- diff --git a/src/editfns.c b/src/editfns.c index 442a00b..b914b4a 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -39,6 +39,7 @@ Boston, MA 02111-1307, USA. */ #include "frame.h" #include "insdel.h" #include "window.h" +#include "chartab.h" #include "line-number.h" #include "systime.h" @@ -369,7 +370,7 @@ save_excursion_restore (Lisp_Object info) 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))) @@ -548,7 +549,6 @@ If BUFFER is nil, the current buffer is assumed. (buffer)) { struct buffer *b = decode_buffer (buffer, 1); - return beginning_of_line_p (b, BUF_PT (b)) ? Qt : Qnil; } @@ -667,7 +667,7 @@ char* user_login_name (int *uid) { struct passwd *pw = NULL; - + /* uid == NULL to return name of this user */ if (uid != NULL) { @@ -757,7 +757,7 @@ value of `user-full-name' is returned. 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; @@ -821,6 +821,7 @@ uncache_home_directory (void) of a few bytes */ } +/* Returns the home directory, in external format */ char * get_home_directory (void) { @@ -832,7 +833,7 @@ get_home_directory (void) { #if defined(WINDOWSNT) && !defined(__CYGWIN32__) char *homedrive, *homepath; - + if ((homedrive = getenv("HOMEDRIVE")) != NULL && (homepath = getenv("HOMEPATH")) != NULL) { @@ -878,16 +879,16 @@ get_home_directory (void) } 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, /* @@ -895,18 +896,12 @@ Return the user's home directory, as a string. */ ()) { - 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, /* @@ -1045,6 +1040,8 @@ FORMAT-STRING may contain %-sequences to substitute parts of the time. %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". @@ -1062,14 +1059,14 @@ The number of options reflects the `strftime' function. 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. */ @@ -1114,13 +1111,13 @@ ZONE is an integer indicating the number of seconds east of Greenwich. 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. */ @@ -1129,7 +1126,7 @@ ZONE is an integer indicating the number of seconds east of Greenwich. 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); } @@ -1155,7 +1152,7 @@ If you want them to stand for years in this century, you must do that yourself. */ (int nargs, Lisp_Object *args)) { - time_t _time; + time_t the_time; struct tm tm; Lisp_Object zone = (nargs > 6) ? args[nargs - 1] : Qnil; @@ -1171,7 +1168,7 @@ If you want them to stand for years in this century, you must do that yourself. if (CONSP (zone)) zone = XCAR (zone); if (NILP (zone)) - _time = mktime (&tm); + the_time = mktime (&tm); else { char tzbuf[100]; @@ -1194,7 +1191,7 @@ If you want them to stand for years in this century, you must do that yourself. 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; @@ -1205,10 +1202,10 @@ If you want them to stand for years in this century, you must do that yourself. #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, /* @@ -1622,6 +1619,23 @@ If BUFFER is nil, the current buffer is assumed. 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. @@ -1783,42 +1797,149 @@ and don't mark the buffer as really changed. 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); @@ -2263,6 +2384,7 @@ syms_of_editfns (void) DEFSUBR (Fstring_to_char); DEFSUBR (Fchar_to_string); DEFSUBR (Fbuffer_substring); + DEFSUBR (Fbuffer_substring_no_properties); DEFSUBR (Fpoint_marker); DEFSUBR (Fmark_marker);