comparison src/editfns.c @ 444:576fb035e263 r21-2-37

Import from CVS: tag r21-2-37
author cvs
date Mon, 13 Aug 2007 11:36:19 +0200
parents abe6d1db359e
children 1ccc32a20af4
comparison
equal deleted inserted replaced
443:a8296e22da4e 444:576fb035e263
97 else 97 else
98 Vuser_full_name = Fuser_full_name (Qnil); 98 Vuser_full_name = Fuser_full_name (Qnil);
99 } 99 }
100 100
101 DEFUN ("char-to-string", Fchar_to_string, 1, 1, 0, /* 101 DEFUN ("char-to-string", Fchar_to_string, 1, 1, 0, /*
102 Convert arg CH to a one-character string containing that character. 102 Convert CHARACTER to a one-character string containing that character.
103 */ 103 */
104 (ch)) 104 (character))
105 { 105 {
106 Bytecount len; 106 Bytecount len;
107 Bufbyte str[MAX_EMCHAR_LEN]; 107 Bufbyte str[MAX_EMCHAR_LEN];
108 108
109 if (EVENTP (ch)) 109 if (EVENTP (character))
110 { 110 {
111 Lisp_Object ch2 = Fevent_to_character (ch, Qt, Qnil, Qnil); 111 Lisp_Object ch2 = Fevent_to_character (character, Qt, Qnil, Qnil);
112 if (NILP (ch2)) 112 if (NILP (ch2))
113 return 113 return
114 signal_simple_continuable_error 114 signal_simple_continuable_error
115 ("character has no ASCII equivalent:", Fcopy_event (ch, Qnil)); 115 ("character has no ASCII equivalent:", Fcopy_event (character, Qnil));
116 ch = ch2; 116 character = ch2;
117 } 117 }
118 118
119 CHECK_CHAR_COERCE_INT (ch); 119 CHECK_CHAR_COERCE_INT (character);
120 120
121 len = set_charptr_emchar (str, XCHAR (ch)); 121 len = set_charptr_emchar (str, XCHAR (character));
122 return make_string (str, len); 122 return make_string (str, len);
123 } 123 }
124 124
125 DEFUN ("string-to-char", Fstring_to_char, 1, 1, 0, /* 125 DEFUN ("string-to-char", Fstring_to_char, 1, 1, 0, /*
126 Convert arg STRING to a character, the first character of that string. 126 Convert arg STRING to a character, the first character of that string.
127 An empty string will return the constant `nil'. 127 An empty string will return the constant `nil'.
128 */ 128 */
129 (str)) 129 (string))
130 { 130 {
131 Lisp_String *p; 131 Lisp_String *p;
132 CHECK_STRING (str); 132 CHECK_STRING (string);
133 133
134 p = XSTRING (str); 134 p = XSTRING (string);
135 if (string_length (p) != 0) 135 if (string_length (p) != 0)
136 return make_char (string_char (p, 0)); 136 return make_char (string_char (p, 0));
137 else 137 else
138 /* This used to return Qzero. That is broken, broken, broken. */ 138 /* This used to return Qzero. That is broken, broken, broken. */
139 /* It might be kinder to signal an error directly. -slb */ 139 /* It might be kinder to signal an error directly. -slb */
609 609
610 DEFUN ("temp-directory", Ftemp_directory, 0, 0, 0, /* 610 DEFUN ("temp-directory", Ftemp_directory, 0, 0, 0, /*
611 Return the pathname to the directory to use for temporary files. 611 Return the pathname to the directory to use for temporary files.
612 On MS Windows, this is obtained from the TEMP or TMP environment variables, 612 On MS Windows, this is obtained from the TEMP or TMP environment variables,
613 defaulting to / if they are both undefined. 613 defaulting to / if they are both undefined.
614 On Unix it is obtained from TMPDIR, with /tmp as the default 614 On Unix it is obtained from TMPDIR, with /tmp as the default.
615 */ 615 */
616 ()) 616 ())
617 { 617 {
618 char *tmpdir; 618 char *tmpdir;
619 #if defined(WIN32_NATIVE) 619 #if defined(WIN32_NATIVE)
1577 1577
1578 Jamie thinks this is bogus. */ 1578 Jamie thinks this is bogus. */
1579 1579
1580 1580
1581 DEFUN ("insert-char", Finsert_char, 1, 4, 0, /* 1581 DEFUN ("insert-char", Finsert_char, 1, 4, 0, /*
1582 Insert COUNT (second arg) copies of CHR (first arg). 1582 Insert COUNT copies of CHARACTER into BUFFER.
1583 Point and all markers are affected as in the function `insert'. 1583 Point and all markers are affected as in the function `insert'.
1584 COUNT defaults to 1 if omitted. 1584 COUNT defaults to 1 if omitted.
1585 The optional third arg IGNORED is INHERIT under FSF Emacs. 1585 The optional third arg IGNORED is INHERIT under FSF Emacs.
1586 This is highly bogus, however, and XEmacs always behaves as if 1586 This is highly bogus, however, and XEmacs always behaves as if
1587 `t' were passed to INHERIT. 1587 `t' were passed to INHERIT.
1588 The optional fourth arg BUFFER specifies the buffer to insert the 1588 The optional fourth arg BUFFER specifies the buffer to insert the
1589 text into. If BUFFER is nil, the current buffer is assumed. 1589 text into. If BUFFER is nil, the current buffer is assumed.
1590 */ 1590 */
1591 (chr, count, ignored, buffer)) 1591 (character, count, ignored, buffer))
1592 { 1592 {
1593 /* This function can GC */ 1593 /* This function can GC */
1594 REGISTER Bufbyte *string; 1594 REGISTER Bufbyte *string;
1595 REGISTER int slen; 1595 REGISTER int slen;
1596 REGISTER int i, j; 1596 REGISTER int i, j;
1598 REGISTER Bytecount charlen; 1598 REGISTER Bytecount charlen;
1599 Bufbyte str[MAX_EMCHAR_LEN]; 1599 Bufbyte str[MAX_EMCHAR_LEN];
1600 struct buffer *b = decode_buffer (buffer, 1); 1600 struct buffer *b = decode_buffer (buffer, 1);
1601 int cou; 1601 int cou;
1602 1602
1603 CHECK_CHAR_COERCE_INT (chr); 1603 CHECK_CHAR_COERCE_INT (character);
1604 if (NILP (count)) 1604 if (NILP (count))
1605 cou = 1; 1605 cou = 1;
1606 else 1606 else
1607 { 1607 {
1608 CHECK_INT (count); 1608 CHECK_INT (count);
1609 cou = XINT (count); 1609 cou = XINT (count);
1610 } 1610 }
1611 1611
1612 charlen = set_charptr_emchar (str, XCHAR (chr)); 1612 charlen = set_charptr_emchar (str, XCHAR (character));
1613 n = cou * charlen; 1613 n = cou * charlen;
1614 if (n <= 0) 1614 if (n <= 0)
1615 return Qnil; 1615 return Qnil;
1616 slen = min (n, 768); 1616 slen = min (n, 768);
1617 string = alloca_array (Bufbyte, slen); 1617 string = alloca_array (Bufbyte, slen);
1666 /* It might make more sense to name this 1666 /* It might make more sense to name this
1667 `buffer-substring-no-extents', but this name is FSFmacs-compatible, 1667 `buffer-substring-no-extents', but this name is FSFmacs-compatible,
1668 and what the function does is probably good enough for what the 1668 and what the function does is probably good enough for what the
1669 user-code will typically want to use it for. */ 1669 user-code will typically want to use it for. */
1670 DEFUN ("buffer-substring-no-properties", Fbuffer_substring_no_properties, 0, 3, 0, /* 1670 DEFUN ("buffer-substring-no-properties", Fbuffer_substring_no_properties, 0, 3, 0, /*
1671 Return the text from BEG to END, as a string, without copying the extents. 1671 Return the text from START to END as a string, without copying the extents.
1672 */ 1672 */
1673 (start, end, buffer)) 1673 (start, end, buffer))
1674 { 1674 {
1675 /* This function can GC */ 1675 /* This function can GC */
1676 Bufpos begv, zv; 1676 Bufpos begv, zv;
1989 return make_int (cnt); 1989 return make_int (cnt);
1990 } 1990 }
1991 1991
1992 DEFUN ("delete-region", Fdelete_region, 2, 3, "r", /* 1992 DEFUN ("delete-region", Fdelete_region, 2, 3, "r", /*
1993 Delete the text between point and mark. 1993 Delete the text between point and mark.
1994 When called from a program, expects two arguments, 1994 When called from a program, expects two arguments START and END
1995 positions (integers or markers) specifying the stretch to be deleted. 1995 \(integers or markers) specifying the stretch to be deleted.
1996 If BUFFER is nil, the current buffer is assumed. 1996 If optional third arg BUFFER is nil, the current buffer is assumed.
1997 */ 1997 */
1998 (b, e, buffer)) 1998 (start, end, buffer))
1999 { 1999 {
2000 /* This function can GC */ 2000 /* This function can GC */
2001 Bufpos start, end; 2001 Bufpos bp_start, bp_end;
2002 struct buffer *buf = decode_buffer (buffer, 1); 2002 struct buffer *buf = decode_buffer (buffer, 1);
2003 2003
2004 get_buffer_range_char (buf, b, e, &start, &end, 0); 2004 get_buffer_range_char (buf, start, end, &bp_start, &bp_end, 0);
2005 buffer_delete_range (buf, start, end, 0); 2005 buffer_delete_range (buf, bp_start, bp_end, 0);
2006 zmacs_region_stays = 0; 2006 zmacs_region_stays = 0;
2007 return Qnil; 2007 return Qnil;
2008 } 2008 }
2009 2009
2010 void 2010 void
2053 See also `save-restriction'. 2053 See also `save-restriction'.
2054 2054
2055 When calling from a program, pass two arguments; positions (integers 2055 When calling from a program, pass two arguments; positions (integers
2056 or markers) bounding the text that should remain visible. 2056 or markers) bounding the text that should remain visible.
2057 */ 2057 */
2058 (b, e, buffer)) 2058 (start, end, buffer))
2059 { 2059 {
2060 Bufpos start, end; 2060 Bufpos bp_start, bp_end;
2061 struct buffer *buf = decode_buffer (buffer, 1); 2061 struct buffer *buf = decode_buffer (buffer, 1);
2062 Bytind bi_start, bi_end; 2062 Bytind bi_start, bi_end;
2063 2063
2064 get_buffer_range_char (buf, b, e, &start, &end, GB_ALLOW_PAST_ACCESSIBLE); 2064 get_buffer_range_char (buf, start, end, &bp_start, &bp_end,
2065 bi_start = bufpos_to_bytind (buf, start); 2065 GB_ALLOW_PAST_ACCESSIBLE);
2066 bi_end = bufpos_to_bytind (buf, end); 2066 bi_start = bufpos_to_bytind (buf, bp_start);
2067 2067 bi_end = bufpos_to_bytind (buf, bp_end);
2068 SET_BOTH_BUF_BEGV (buf, start, bi_start); 2068
2069 SET_BOTH_BUF_ZV (buf, end, bi_end); 2069 SET_BOTH_BUF_BEGV (buf, bp_start, bi_start);
2070 if (BUF_PT (buf) < start) 2070 SET_BOTH_BUF_ZV (buf, bp_end, bi_end);
2071 BUF_SET_PT (buf, start); 2071 if (BUF_PT (buf) < bp_start)
2072 if (BUF_PT (buf) > end) 2072 BUF_SET_PT (buf, bp_start);
2073 BUF_SET_PT (buf, end); 2073 if (BUF_PT (buf) > bp_end)
2074 BUF_SET_PT (buf, bp_end);
2074 MARK_CLIP_CHANGED; 2075 MARK_CLIP_CHANGED;
2075 /* Changing the buffer bounds invalidates any recorded current column. */ 2076 /* Changing the buffer bounds invalidates any recorded current column. */
2076 invalidate_current_column (); 2077 invalidate_current_column ();
2077 narrow_line_number_cache (buf); 2078 narrow_line_number_cache (buf);
2078 zmacs_region_stays = 0; 2079 zmacs_region_stays = 0;
2268 Return t if two characters match, optionally ignoring case. 2269 Return t if two characters match, optionally ignoring case.
2269 Both arguments must be characters (i.e. NOT integers). 2270 Both arguments must be characters (i.e. NOT integers).
2270 Case is ignored if `case-fold-search' is non-nil in BUFFER. 2271 Case is ignored if `case-fold-search' is non-nil in BUFFER.
2271 If BUFFER is nil, the current buffer is assumed. 2272 If BUFFER is nil, the current buffer is assumed.
2272 */ 2273 */
2273 (c1, c2, buffer)) 2274 (character1, character2, buffer))
2274 { 2275 {
2275 Emchar x1, x2; 2276 Emchar x1, x2;
2276 struct buffer *b = decode_buffer (buffer, 1); 2277 struct buffer *b = decode_buffer (buffer, 1);
2277 2278
2278 CHECK_CHAR_COERCE_INT (c1); 2279 CHECK_CHAR_COERCE_INT (character1);
2279 CHECK_CHAR_COERCE_INT (c2); 2280 CHECK_CHAR_COERCE_INT (character2);
2280 x1 = XCHAR (c1); 2281 x1 = XCHAR (character1);
2281 x2 = XCHAR (c2); 2282 x2 = XCHAR (character2);
2282 2283
2283 return (!NILP (b->case_fold_search) 2284 return (!NILP (b->case_fold_search)
2284 ? DOWNCASE (b, x1) == DOWNCASE (b, x2) 2285 ? DOWNCASE (b, x1) == DOWNCASE (b, x2)
2285 : x1 == x2) 2286 : x1 == x2)
2286 ? Qt : Qnil; 2287 ? Qt : Qnil;
2288 2289
2289 DEFUN ("char=", Fchar_Equal, 2, 2, 0, /* 2290 DEFUN ("char=", Fchar_Equal, 2, 2, 0, /*
2290 Return t if two characters match, case is significant. 2291 Return t if two characters match, case is significant.
2291 Both arguments must be characters (i.e. NOT integers). 2292 Both arguments must be characters (i.e. NOT integers).
2292 */ 2293 */
2293 (c1, c2)) 2294 (character1, character2))
2294 { 2295 {
2295 CHECK_CHAR_COERCE_INT (c1); 2296 CHECK_CHAR_COERCE_INT (character1);
2296 CHECK_CHAR_COERCE_INT (c2); 2297 CHECK_CHAR_COERCE_INT (character2);
2297 2298
2298 return EQ (c1, c2) ? Qt : Qnil; 2299 return EQ (character1, character2) ? Qt : Qnil;
2299 } 2300 }
2300 2301
2301 #if 0 /* Undebugged FSFmacs code */ 2302 #if 0 /* Undebugged FSFmacs code */
2302 /* Transpose the markers in two regions of the current buffer, and 2303 /* Transpose the markers in two regions of the current buffer, and
2303 adjust the ones between them if necessary (i.e.: if the regions 2304 adjust the ones between them if necessary (i.e.: if the regions
2365 DEFUN ("transpose-regions", Ftranspose_regions, 4, 5, 0, /* 2366 DEFUN ("transpose-regions", Ftranspose_regions, 4, 5, 0, /*
2366 Transpose region START1 to END1 with START2 to END2. 2367 Transpose region START1 to END1 with START2 to END2.
2367 The regions may not be overlapping, because the size of the buffer is 2368 The regions may not be overlapping, because the size of the buffer is
2368 never changed in a transposition. 2369 never changed in a transposition.
2369 2370
2370 Optional fifth arg LEAVE_MARKERS, if non-nil, means don't transpose 2371 Optional fifth arg LEAVE-MARKERS, if non-nil, means don't transpose
2371 any markers that happen to be located in the regions. (#### BUG: currently 2372 any markers that happen to be located in the regions. (#### BUG: currently
2372 this function always acts as if LEAVE_MARKERS is non-nil.) 2373 this function always acts as if LEAVE-MARKERS is non-nil.)
2373 2374
2374 Transposing beyond buffer boundaries is an error. 2375 Transposing beyond buffer boundaries is an error.
2375 */ 2376 */
2376 (startr1, endr1, startr2, endr2, leave_markers)) 2377 (start1, end1, start2, end2, leave_markers))
2377 { 2378 {
2378 Bufpos start1, end1, start2, end2; 2379 Bufpos startr1, endr1, startr2, endr2;
2379 Charcount len1, len2; 2380 Charcount len1, len2;
2380 Lisp_Object string1, string2; 2381 Lisp_Object string1, string2;
2381 struct buffer *buf = current_buffer; 2382 struct buffer *buf = current_buffer;
2382 2383
2383 get_buffer_range_char (buf, startr1, endr1, &start1, &end1, 0); 2384 get_buffer_range_char (buf, start1, end1, &startr1, &endr1, 0);
2384 get_buffer_range_char (buf, startr2, endr2, &start2, &end2, 0); 2385 get_buffer_range_char (buf, start2, end2, &startr2, &endr2, 0);
2385 2386
2386 len1 = end1 - start1; 2387 len1 = endr1 - startr1;
2387 len2 = end2 - start2; 2388 len2 = endr2 - startr2;
2388 2389
2389 if (start2 < end1) 2390 if (startr2 < endr1)
2390 error ("transposed regions not properly ordered"); 2391 error ("transposed regions not properly ordered");
2391 else if (start1 == end1 || start2 == end2) 2392 else if (startr1 == endr1 || startr2 == endr2)
2392 error ("transposed region may not be of length 0"); 2393 error ("transposed region may not be of length 0");
2393 2394
2394 string1 = make_string_from_buffer (buf, start1, len1); 2395 string1 = make_string_from_buffer (buf, startr1, len1);
2395 string2 = make_string_from_buffer (buf, start2, len2); 2396 string2 = make_string_from_buffer (buf, startr2, len2);
2396 buffer_delete_range (buf, start2, end2, 0); 2397 buffer_delete_range (buf, startr2, endr2, 0);
2397 buffer_insert_lisp_string_1 (buf, start2, string1, 0); 2398 buffer_insert_lisp_string_1 (buf, startr2, string1, 0);
2398 buffer_delete_range (buf, start1, end1, 0); 2399 buffer_delete_range (buf, startr1, endr1, 0);
2399 buffer_insert_lisp_string_1 (buf, start1, string2, 0); 2400 buffer_insert_lisp_string_1 (buf, startr1, string2, 0);
2400 2401
2401 /* In FSFmacs there is a whole bunch of really ugly code here 2402 /* In FSFmacs there is a whole bunch of really ugly code here
2402 to attempt to transpose the regions without using up any 2403 to attempt to transpose the regions without using up any
2403 extra memory. Although the intent may be good, the result 2404 extra memory. Although the intent may be good, the result
2404 was highly bogus. */ 2405 was highly bogus. */
2508 2509
2509 More specifically: 2510 More specifically:
2510 2511
2511 - Commands which operate on the region only work if the region is active. 2512 - Commands which operate on the region only work if the region is active.
2512 - Only a very small set of commands cause the region to become active: 2513 - Only a very small set of commands cause the region to become active:
2513 Those commands whose semantics are to mark an area, like mark-defun. 2514 Those commands whose semantics are to mark an area, like `mark-defun'.
2514 - The region is deactivated after each command that is executed, except that: 2515 - The region is deactivated after each command that is executed, except that:
2515 - "Motion" commands do not change whether the region is active or not. 2516 - "Motion" commands do not change whether the region is active or not.
2516 2517
2517 set-mark-command (C-SPC) pushes a mark and activates the region. Moving the 2518 set-mark-command (C-SPC) pushes a mark and activates the region. Moving the
2518 cursor with normal motion commands (C-n, C-p, etc) will cause the region 2519 cursor with normal motion commands (C-n, C-p, etc) will cause the region