Mercurial > emacs
annotate src/editfns.c @ 31600:ac8c86ff7ee3
(USE_MMAP_FOR_BUFFERS): Define instead of REL_ALLOC_MMAP.
author | Gerd Moellmann <gerd@gnu.org> |
---|---|
date | Thu, 14 Sep 2000 15:12:48 +0000 |
parents | 044ae1ff8c78 |
children | f8d2403d385b |
rev | line source |
---|---|
305 | 1 /* Lisp functions pertaining to editing. |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
2 Copyright (C) 1985,86,87,89,93,94,95,96,97,98, 1999, 2000 |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
3 Free Software Foundation, Inc. |
305 | 4 |
5 This file is part of GNU Emacs. | |
6 | |
7 GNU Emacs is free software; you can redistribute it and/or modify | |
8 it under the terms of the GNU General Public License as published by | |
12244 | 9 the Free Software Foundation; either version 2, or (at your option) |
305 | 10 any later version. |
11 | |
12 GNU Emacs is distributed in the hope that it will be useful, | |
13 but WITHOUT ANY WARRANTY; without even the implied warranty of | |
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
15 GNU General Public License for more details. | |
16 | |
17 You should have received a copy of the GNU General Public License | |
18 along with GNU Emacs; see the file COPYING. If not, write to | |
14862 | 19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
20 Boston, MA 02111-1307, USA. */ | |
305 | 21 |
22 | |
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
parents:
26058
diff
changeset
|
23 #include <config.h> |
2962
79314d830f7d
* editfns.c: #include <sys/types.h>, to get time_t for Eggert's
Jim Blandy <jimb@redhat.com>
parents:
2921
diff
changeset
|
24 #include <sys/types.h> |
79314d830f7d
* editfns.c: #include <sys/types.h>, to get time_t for Eggert's
Jim Blandy <jimb@redhat.com>
parents:
2921
diff
changeset
|
25 |
372 | 26 #ifdef VMS |
577 | 27 #include "vms-pwd.h" |
372 | 28 #else |
305 | 29 #include <pwd.h> |
372 | 30 #endif |
31 | |
21514 | 32 #ifdef HAVE_UNISTD_H |
33 #include <unistd.h> | |
34 #endif | |
35 | |
305 | 36 #include "lisp.h" |
1285
d50533e23dff
* editfns.c (make_buffer_string): Call copy_intervals_to_string().
Joseph Arceneaux <jla@gnu.org>
parents:
1254
diff
changeset
|
37 #include "intervals.h" |
305 | 38 #include "buffer.h" |
17031 | 39 #include "charset.h" |
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
parents:
26058
diff
changeset
|
40 #include "coding.h" |
305 | 41 #include "window.h" |
42 | |
577 | 43 #include "systime.h" |
305 | 44 |
45 #define min(a, b) ((a) < (b) ? (a) : (b)) | |
46 #define max(a, b) ((a) > (b) ? (a) : (b)) | |
47 | |
19441
2e2b54ae9b9d
(NULL): Define, if not defined.
Richard M. Stallman <rms@gnu.org>
parents:
19416
diff
changeset
|
48 #ifndef NULL |
2e2b54ae9b9d
(NULL): Define, if not defined.
Richard M. Stallman <rms@gnu.org>
parents:
19416
diff
changeset
|
49 #define NULL 0 |
2e2b54ae9b9d
(NULL): Define, if not defined.
Richard M. Stallman <rms@gnu.org>
parents:
19416
diff
changeset
|
50 #endif |
2e2b54ae9b9d
(NULL): Define, if not defined.
Richard M. Stallman <rms@gnu.org>
parents:
19416
diff
changeset
|
51 |
31095
e19d38e14720
[USE_CRT_DLL]: Remove unnecessary extern, which screws
Andrew Innes <andrewi@gnu.org>
parents:
31016
diff
changeset
|
52 #ifndef USE_CRT_DLL |
13025
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
53 extern char **environ; |
31095
e19d38e14720
[USE_CRT_DLL]: Remove unnecessary extern, which screws
Andrew Innes <andrewi@gnu.org>
parents:
31016
diff
changeset
|
54 #endif |
e19d38e14720
[USE_CRT_DLL]: Remove unnecessary extern, which screws
Andrew Innes <andrewi@gnu.org>
parents:
31016
diff
changeset
|
55 |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
56 extern Lisp_Object make_time P_ ((time_t)); |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
57 extern size_t emacs_strftimeu P_ ((char *, size_t, const char *, |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
58 const struct tm *, int)); |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
59 static int tm_diff P_ ((struct tm *, struct tm *)); |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
60 static void find_field P_ ((Lisp_Object, Lisp_Object, int *, int *)); |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
61 static void update_buffer_properties P_ ((int, int)); |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
62 static Lisp_Object region_limit P_ ((int)); |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
63 static int lisp_time_argument P_ ((Lisp_Object, time_t *, int *)); |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
64 static size_t emacs_memftimeu P_ ((char *, size_t, const char *, |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
65 size_t, const struct tm *, int)); |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
66 static void general_insert_function P_ ((void (*) (unsigned char *, int), |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
67 void (*) (Lisp_Object, int, int, int, |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
68 int, int), |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
69 int, int, Lisp_Object *)); |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
70 static Lisp_Object subst_char_in_region_unwind P_ ((Lisp_Object)); |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
71 static Lisp_Object subst_char_in_region_unwind_1 P_ ((Lisp_Object)); |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
72 static void transpose_markers P_ ((int, int, int, int, int, int, int, int)); |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
73 |
31336 | 74 #ifdef HAVE_INDEX |
75 extern char *index P_ ((const char *, int)); | |
76 #endif | |
77 | |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
78 Lisp_Object Vbuffer_access_fontify_functions; |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
79 Lisp_Object Qbuffer_access_fontify_functions; |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
80 Lisp_Object Vbuffer_access_fontified_property; |
9657
0fc126c193e7
(Finsert_buffer_substring): Use insert_from_buffer instead of insert.
Karl Heuer <kwzh@gnu.org>
parents:
9572
diff
changeset
|
81 |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
82 Lisp_Object Fuser_full_name P_ ((Lisp_Object)); |
17829
2d98572c57ab
Declare Fuser_full_name as Lisp_Object in advance to
Kenichi Handa <handa@m17n.org>
parents:
17115
diff
changeset
|
83 |
27077
19a664c654ab
(Vinhibit_field_text_motion): New variable.
Gerd Moellmann <gerd@gnu.org>
parents:
26853
diff
changeset
|
84 /* Non-nil means don't stop at field boundary in text motion commands. */ |
19a664c654ab
(Vinhibit_field_text_motion): New variable.
Gerd Moellmann <gerd@gnu.org>
parents:
26853
diff
changeset
|
85 |
19a664c654ab
(Vinhibit_field_text_motion): New variable.
Gerd Moellmann <gerd@gnu.org>
parents:
26853
diff
changeset
|
86 Lisp_Object Vinhibit_field_text_motion; |
19a664c654ab
(Vinhibit_field_text_motion): New variable.
Gerd Moellmann <gerd@gnu.org>
parents:
26853
diff
changeset
|
87 |
305 | 88 /* Some static data, and a function to initialize it for each run */ |
89 | |
90 Lisp_Object Vsystem_name; | |
12026
505a894d943e
(syms_of_editfns): user-login-name renamed from user-name.
Karl Heuer <kwzh@gnu.org>
parents:
11912
diff
changeset
|
91 Lisp_Object Vuser_real_login_name; /* login name of current user ID */ |
505a894d943e
(syms_of_editfns): user-login-name renamed from user-name.
Karl Heuer <kwzh@gnu.org>
parents:
11912
diff
changeset
|
92 Lisp_Object Vuser_full_name; /* full name of current user */ |
505a894d943e
(syms_of_editfns): user-login-name renamed from user-name.
Karl Heuer <kwzh@gnu.org>
parents:
11912
diff
changeset
|
93 Lisp_Object Vuser_login_name; /* user name from LOGNAME or USER */ |
305 | 94 |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
95 /* Symbol for the text property used to mark fields. */ |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
96 |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
97 Lisp_Object Qfield; |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
98 |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
99 /* A special value for Qfield properties. */ |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
100 |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
101 Lisp_Object Qboundary; |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
102 |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
103 |
305 | 104 void |
105 init_editfns () | |
106 { | |
330 | 107 char *user_name; |
25782
8f59abd3a02b
(init_editfns): Remove unused variables.
Gerd Moellmann <gerd@gnu.org>
parents:
25662
diff
changeset
|
108 register unsigned char *p; |
305 | 109 struct passwd *pw; /* password entry for the current user */ |
110 Lisp_Object tem; | |
111 | |
112 /* Set up system_name even when dumping. */ | |
7907
148ad20d6774
(init_editfns): Call init_system_name instead of get_system_name.
Karl Heuer <kwzh@gnu.org>
parents:
7862
diff
changeset
|
113 init_system_name (); |
305 | 114 |
115 #ifndef CANNOT_DUMP | |
116 /* Don't bother with this on initial start when just dumping out */ | |
117 if (!initialized) | |
118 return; | |
119 #endif /* not CANNOT_DUMP */ | |
120 | |
121 pw = (struct passwd *) getpwuid (getuid ()); | |
9572 | 122 #ifdef MSDOS |
123 /* We let the real user name default to "root" because that's quite | |
124 accurate on MSDOG and because it lets Emacs find the init file. | |
125 (The DVX libraries override the Djgpp libraries here.) */ | |
12026
505a894d943e
(syms_of_editfns): user-login-name renamed from user-name.
Karl Heuer <kwzh@gnu.org>
parents:
11912
diff
changeset
|
126 Vuser_real_login_name = build_string (pw ? pw->pw_name : "root"); |
9572 | 127 #else |
12026
505a894d943e
(syms_of_editfns): user-login-name renamed from user-name.
Karl Heuer <kwzh@gnu.org>
parents:
11912
diff
changeset
|
128 Vuser_real_login_name = build_string (pw ? pw->pw_name : "unknown"); |
9572 | 129 #endif |
305 | 130 |
330 | 131 /* Get the effective user name, by consulting environment variables, |
132 or the effective uid if those are unset. */ | |
5907
5fdb226fe9a4
(init_editfns): Look at LOGNAME before USER.
Karl Heuer <kwzh@gnu.org>
parents:
5884
diff
changeset
|
133 user_name = (char *) getenv ("LOGNAME"); |
330 | 134 if (!user_name) |
9801
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
135 #ifdef WINDOWSNT |
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
136 user_name = (char *) getenv ("USERNAME"); /* it's USERNAME on NT */ |
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
137 #else /* WINDOWSNT */ |
5907
5fdb226fe9a4
(init_editfns): Look at LOGNAME before USER.
Karl Heuer <kwzh@gnu.org>
parents:
5884
diff
changeset
|
138 user_name = (char *) getenv ("USER"); |
9801
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
139 #endif /* WINDOWSNT */ |
305 | 140 if (!user_name) |
330 | 141 { |
142 pw = (struct passwd *) getpwuid (geteuid ()); | |
143 user_name = (char *) (pw ? pw->pw_name : "unknown"); | |
144 } | |
12026
505a894d943e
(syms_of_editfns): user-login-name renamed from user-name.
Karl Heuer <kwzh@gnu.org>
parents:
11912
diff
changeset
|
145 Vuser_login_name = build_string (user_name); |
305 | 146 |
330 | 147 /* If the user name claimed in the environment vars differs from |
148 the real uid, use the claimed name to find the full name. */ | |
12026
505a894d943e
(syms_of_editfns): user-login-name renamed from user-name.
Karl Heuer <kwzh@gnu.org>
parents:
11912
diff
changeset
|
149 tem = Fstring_equal (Vuser_login_name, Vuser_real_login_name); |
16641
2103a88cc61f
(Fuser_full_name): Accept a string (the login name) as
Richard M. Stallman <rms@gnu.org>
parents:
16639
diff
changeset
|
150 Vuser_full_name = Fuser_full_name (NILP (tem)? make_number (geteuid()) |
2103a88cc61f
(Fuser_full_name): Accept a string (the login name) as
Richard M. Stallman <rms@gnu.org>
parents:
16639
diff
changeset
|
151 : Vuser_login_name); |
30480 | 152 |
11447
d51e912495be
(init_editfns): Add casts.
Richard M. Stallman <rms@gnu.org>
parents:
11433
diff
changeset
|
153 p = (unsigned char *) getenv ("NAME"); |
11135
9ab21ef32537
(init_editfns): Use NAME envvar to init user-full-name.
Richard M. Stallman <rms@gnu.org>
parents:
10480
diff
changeset
|
154 if (p) |
9ab21ef32537
(init_editfns): Use NAME envvar to init user-full-name.
Richard M. Stallman <rms@gnu.org>
parents:
10480
diff
changeset
|
155 Vuser_full_name = build_string (p); |
16683
6802dbd07a80
(Fuser_full_name): Return nil if the specified user doesn't exist.
Richard M. Stallman <rms@gnu.org>
parents:
16648
diff
changeset
|
156 else if (NILP (Vuser_full_name)) |
6802dbd07a80
(Fuser_full_name): Return nil if the specified user doesn't exist.
Richard M. Stallman <rms@gnu.org>
parents:
16648
diff
changeset
|
157 Vuser_full_name = build_string ("unknown"); |
305 | 158 } |
159 | |
160 DEFUN ("char-to-string", Fchar_to_string, Schar_to_string, 1, 1, 0, | |
21257
205a5aa4aa2f
(Fchar_to_string): Use make_string_from_bytes.
Richard M. Stallman <rms@gnu.org>
parents:
21245
diff
changeset
|
161 "Convert arg CHAR to a string containing that character.") |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
162 (character) |
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
163 Lisp_Object character; |
305 | 164 { |
17031 | 165 int len; |
26853
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
166 unsigned char str[MAX_MULTIBYTE_LENGTH]; |
17031 | 167 |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
168 CHECK_NUMBER (character, 0); |
305 | 169 |
26853
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
170 len = CHAR_STRING (XFASTINT (character), str); |
21257
205a5aa4aa2f
(Fchar_to_string): Use make_string_from_bytes.
Richard M. Stallman <rms@gnu.org>
parents:
21245
diff
changeset
|
171 return make_string_from_bytes (str, 1, len); |
305 | 172 } |
173 | |
174 DEFUN ("string-to-char", Fstring_to_char, Sstring_to_char, 1, 1, 0, | |
17031 | 175 "Convert arg STRING to a character, the first character of that string.\n\ |
176 A multibyte character is handled correctly.") | |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
177 (string) |
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
178 register Lisp_Object string; |
305 | 179 { |
180 register Lisp_Object val; | |
181 register struct Lisp_String *p; | |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
182 CHECK_STRING (string, 0); |
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
183 p = XSTRING (string); |
305 | 184 if (p->size) |
23650
3cc42e65f25b
(Fstring_to_char): Don't return a multibyte character
Kenichi Handa <handa@m17n.org>
parents:
23596
diff
changeset
|
185 { |
3cc42e65f25b
(Fstring_to_char): Don't return a multibyte character
Kenichi Handa <handa@m17n.org>
parents:
23596
diff
changeset
|
186 if (STRING_MULTIBYTE (string)) |
3cc42e65f25b
(Fstring_to_char): Don't return a multibyte character
Kenichi Handa <handa@m17n.org>
parents:
23596
diff
changeset
|
187 XSETFASTINT (val, STRING_CHAR (p->data, STRING_BYTES (p))); |
3cc42e65f25b
(Fstring_to_char): Don't return a multibyte character
Kenichi Handa <handa@m17n.org>
parents:
23596
diff
changeset
|
188 else |
3cc42e65f25b
(Fstring_to_char): Don't return a multibyte character
Kenichi Handa <handa@m17n.org>
parents:
23596
diff
changeset
|
189 XSETFASTINT (val, p->data[0]); |
3cc42e65f25b
(Fstring_to_char): Don't return a multibyte character
Kenichi Handa <handa@m17n.org>
parents:
23596
diff
changeset
|
190 } |
305 | 191 else |
9305
ac077e2a75f1
(Fstring_to_char, Fpoint, Fbufsize, Fpoint_min, Fpoint_max, Ffollowing_char,
Karl Heuer <kwzh@gnu.org>
parents:
9265
diff
changeset
|
192 XSETFASTINT (val, 0); |
305 | 193 return val; |
194 } | |
195 | |
196 static Lisp_Object | |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
197 buildmark (charpos, bytepos) |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
198 int charpos, bytepos; |
305 | 199 { |
200 register Lisp_Object mark; | |
201 mark = Fmake_marker (); | |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
202 set_marker_both (mark, Qnil, charpos, bytepos); |
305 | 203 return mark; |
204 } | |
205 | |
206 DEFUN ("point", Fpoint, Spoint, 0, 0, 0, | |
207 "Return value of point, as an integer.\n\ | |
208 Beginning of buffer is position (point-min)") | |
209 () | |
210 { | |
211 Lisp_Object temp; | |
16039
855c8d8ba0f0
Change all references from point to PT.
Karl Heuer <kwzh@gnu.org>
parents:
15910
diff
changeset
|
212 XSETFASTINT (temp, PT); |
305 | 213 return temp; |
214 } | |
215 | |
216 DEFUN ("point-marker", Fpoint_marker, Spoint_marker, 0, 0, 0, | |
217 "Return value of point, as a marker object.") | |
218 () | |
219 { | |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
220 return buildmark (PT, PT_BYTE); |
305 | 221 } |
222 | |
223 int | |
224 clip_to_bounds (lower, num, upper) | |
225 int lower, num, upper; | |
226 { | |
227 if (num < lower) | |
228 return lower; | |
229 else if (num > upper) | |
230 return upper; | |
231 else | |
232 return num; | |
233 } | |
234 | |
235 DEFUN ("goto-char", Fgoto_char, Sgoto_char, 1, 1, "NGoto char: ", | |
236 "Set point to POSITION, a number or marker.\n\ | |
17031 | 237 Beginning of buffer is position (point-min), end is (point-max).\n\ |
238 If the position is in the middle of a multibyte form,\n\ | |
239 the actual point is set at the head of the multibyte form\n\ | |
240 except in the case that `enable-multibyte-characters' is nil.") | |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
241 (position) |
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
242 register Lisp_Object position; |
305 | 243 { |
17031 | 244 int pos; |
245 | |
21226
c8d0df2cbd3d
(Fgoto_char): If POSITION is a marker pointing a
Richard M. Stallman <rms@gnu.org>
parents:
21225
diff
changeset
|
246 if (MARKERP (position) |
c8d0df2cbd3d
(Fgoto_char): If POSITION is a marker pointing a
Richard M. Stallman <rms@gnu.org>
parents:
21225
diff
changeset
|
247 && current_buffer == XMARKER (position)->buffer) |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
248 { |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
249 pos = marker_position (position); |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
250 if (pos < BEGV) |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
251 SET_PT_BOTH (BEGV, BEGV_BYTE); |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
252 else if (pos > ZV) |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
253 SET_PT_BOTH (ZV, ZV_BYTE); |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
254 else |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
255 SET_PT_BOTH (pos, marker_byte_position (position)); |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
256 |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
257 return position; |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
258 } |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
259 |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
260 CHECK_NUMBER_COERCE_MARKER (position, 0); |
305 | 261 |
17031 | 262 pos = clip_to_bounds (BEGV, XINT (position), ZV); |
263 SET_PT (pos); | |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
264 return position; |
305 | 265 } |
266 | |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
267 |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
268 /* Return the start or end position of the region. |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
269 BEGINNINGP non-zero means return the start. |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
270 If there is no region active, signal an error. */ |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
271 |
305 | 272 static Lisp_Object |
273 region_limit (beginningp) | |
274 int beginningp; | |
275 { | |
4047
e950abdc9ed2
(region_limit): Declare Vmark_even_if_inactive.
Roland McGrath <roland@gnu.org>
parents:
4038
diff
changeset
|
276 extern Lisp_Object Vmark_even_if_inactive; /* Defined in callint.c. */ |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
277 Lisp_Object m; |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
278 |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
279 if (!NILP (Vtransient_mark_mode) |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
280 && NILP (Vmark_even_if_inactive) |
4038
03a4c3912c13
(region_limit): Don't error if Vmark_even_if_inactive is set. When the
Roland McGrath <roland@gnu.org>
parents:
4019
diff
changeset
|
281 && NILP (current_buffer->mark_active)) |
03a4c3912c13
(region_limit): Don't error if Vmark_even_if_inactive is set. When the
Roland McGrath <roland@gnu.org>
parents:
4019
diff
changeset
|
282 Fsignal (Qmark_inactive, Qnil); |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
283 |
305 | 284 m = Fmarker_position (current_buffer->mark); |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
285 if (NILP (m)) |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
286 error ("There is no region now"); |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
287 |
16039
855c8d8ba0f0
Change all references from point to PT.
Karl Heuer <kwzh@gnu.org>
parents:
15910
diff
changeset
|
288 if ((PT < XFASTINT (m)) == beginningp) |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
289 m = make_number (PT); |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
290 return m; |
305 | 291 } |
292 | |
293 DEFUN ("region-beginning", Fregion_beginning, Sregion_beginning, 0, 0, 0, | |
294 "Return position of beginning of region, as an integer.") | |
295 () | |
296 { | |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
297 return region_limit (1); |
305 | 298 } |
299 | |
300 DEFUN ("region-end", Fregion_end, Sregion_end, 0, 0, 0, | |
301 "Return position of end of region, as an integer.") | |
302 () | |
303 { | |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
304 return region_limit (0); |
305 | 305 } |
306 | |
307 DEFUN ("mark-marker", Fmark_marker, Smark_marker, 0, 0, 0, | |
308 "Return this buffer's mark, as a marker object.\n\ | |
309 Watch out! Moving this marker changes the mark position.\n\ | |
310 If you set the marker not to point anywhere, the buffer will have no mark.") | |
311 () | |
312 { | |
313 return current_buffer->mark; | |
314 } | |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
315 |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
316 |
26389
e2acf63b5403
(Fline_beginning_position): If N is not 1,
Richard M. Stallman <rms@gnu.org>
parents:
26372
diff
changeset
|
317 /* Return nonzero if POS1 and POS2 have the same value |
e2acf63b5403
(Fline_beginning_position): If N is not 1,
Richard M. Stallman <rms@gnu.org>
parents:
26372
diff
changeset
|
318 for the text property PROP. */ |
e2acf63b5403
(Fline_beginning_position): If N is not 1,
Richard M. Stallman <rms@gnu.org>
parents:
26372
diff
changeset
|
319 |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
320 static int |
30244
bfc202f38a22
(char_property_eq, char_property_stickiness):
Miles Bader <miles@gnu.org>
parents:
30023
diff
changeset
|
321 char_property_eq (prop, pos1, pos2) |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
322 Lisp_Object prop; |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
323 Lisp_Object pos1, pos2; |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
324 { |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
325 Lisp_Object pval1, pval2; |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
326 |
30244
bfc202f38a22
(char_property_eq, char_property_stickiness):
Miles Bader <miles@gnu.org>
parents:
30023
diff
changeset
|
327 pval1 = Fget_char_property (pos1, prop, Qnil); |
bfc202f38a22
(char_property_eq, char_property_stickiness):
Miles Bader <miles@gnu.org>
parents:
30023
diff
changeset
|
328 pval2 = Fget_char_property (pos2, prop, Qnil); |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
329 |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
330 return EQ (pval1, pval2); |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
331 } |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
332 |
30244
bfc202f38a22
(char_property_eq, char_property_stickiness):
Miles Bader <miles@gnu.org>
parents:
30023
diff
changeset
|
333 /* Return the direction from which the char-property PROP would be |
26389
e2acf63b5403
(Fline_beginning_position): If N is not 1,
Richard M. Stallman <rms@gnu.org>
parents:
26372
diff
changeset
|
334 inherited by any new text inserted at POS: 1 if it would be |
e2acf63b5403
(Fline_beginning_position): If N is not 1,
Richard M. Stallman <rms@gnu.org>
parents:
26372
diff
changeset
|
335 inherited from the char after POS, -1 if it would be inherited from |
e2acf63b5403
(Fline_beginning_position): If N is not 1,
Richard M. Stallman <rms@gnu.org>
parents:
26372
diff
changeset
|
336 the char before POS, and 0 if from neither. */ |
e2acf63b5403
(Fline_beginning_position): If N is not 1,
Richard M. Stallman <rms@gnu.org>
parents:
26372
diff
changeset
|
337 |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
338 static int |
30244
bfc202f38a22
(char_property_eq, char_property_stickiness):
Miles Bader <miles@gnu.org>
parents:
30023
diff
changeset
|
339 char_property_stickiness (prop, pos) |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
340 Lisp_Object prop; |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
341 Lisp_Object pos; |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
342 { |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
343 Lisp_Object front_sticky; |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
344 |
26389
e2acf63b5403
(Fline_beginning_position): If N is not 1,
Richard M. Stallman <rms@gnu.org>
parents:
26372
diff
changeset
|
345 if (XINT (pos) > BEGV) |
e2acf63b5403
(Fline_beginning_position): If N is not 1,
Richard M. Stallman <rms@gnu.org>
parents:
26372
diff
changeset
|
346 /* Consider previous character. */ |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
347 { |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
348 Lisp_Object prev_pos, rear_non_sticky; |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
349 |
26389
e2acf63b5403
(Fline_beginning_position): If N is not 1,
Richard M. Stallman <rms@gnu.org>
parents:
26372
diff
changeset
|
350 prev_pos = make_number (XINT (pos) - 1); |
30244
bfc202f38a22
(char_property_eq, char_property_stickiness):
Miles Bader <miles@gnu.org>
parents:
30023
diff
changeset
|
351 rear_non_sticky = Fget_char_property (prev_pos, Qrear_nonsticky, Qnil); |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
352 |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
353 if (EQ (rear_non_sticky, Qnil) |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
354 || (CONSP (rear_non_sticky) |
28470
93996c44b23a
* editfns.c (text_property_stickiness, Fmessage_or_box): Use NILP to test
Ken Raeburn <raeburn@raeburn.org>
parents:
28358
diff
changeset
|
355 && NILP (Fmemq (prop, rear_non_sticky)))) |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
356 /* PROP is not rear-non-sticky, and since this takes precedence over |
26389
e2acf63b5403
(Fline_beginning_position): If N is not 1,
Richard M. Stallman <rms@gnu.org>
parents:
26372
diff
changeset
|
357 any front-stickiness, PROP is inherited from before. */ |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
358 return -1; |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
359 } |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
360 |
26389
e2acf63b5403
(Fline_beginning_position): If N is not 1,
Richard M. Stallman <rms@gnu.org>
parents:
26372
diff
changeset
|
361 /* Consider following character. */ |
30244
bfc202f38a22
(char_property_eq, char_property_stickiness):
Miles Bader <miles@gnu.org>
parents:
30023
diff
changeset
|
362 front_sticky = Fget_char_property (pos, Qfront_sticky, Qnil); |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
363 |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
364 if (EQ (front_sticky, Qt) |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
365 || (CONSP (front_sticky) |
28470
93996c44b23a
* editfns.c (text_property_stickiness, Fmessage_or_box): Use NILP to test
Ken Raeburn <raeburn@raeburn.org>
parents:
28358
diff
changeset
|
366 && !NILP (Fmemq (prop, front_sticky)))) |
26389
e2acf63b5403
(Fline_beginning_position): If N is not 1,
Richard M. Stallman <rms@gnu.org>
parents:
26372
diff
changeset
|
367 /* PROP is inherited from after. */ |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
368 return 1; |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
369 |
26389
e2acf63b5403
(Fline_beginning_position): If N is not 1,
Richard M. Stallman <rms@gnu.org>
parents:
26372
diff
changeset
|
370 /* PROP is not inherited from either side. */ |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
371 return 0; |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
372 } |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
373 |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
374 |
26389
e2acf63b5403
(Fline_beginning_position): If N is not 1,
Richard M. Stallman <rms@gnu.org>
parents:
26372
diff
changeset
|
375 /* Find the field surrounding POS in *BEG and *END. If POS is nil, |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
376 the value of point is used instead. If BEG or END null, |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
377 means don't store the beginning or end of the field. |
26389
e2acf63b5403
(Fline_beginning_position): If N is not 1,
Richard M. Stallman <rms@gnu.org>
parents:
26372
diff
changeset
|
378 |
e2acf63b5403
(Fline_beginning_position): If N is not 1,
Richard M. Stallman <rms@gnu.org>
parents:
26372
diff
changeset
|
379 If MERGE_AT_BOUNDARY is nonzero, then if POS is at the very first |
30439
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
380 position of a field, then the beginning of the previous field is |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
381 returned instead of the beginning of POS's field (since the end of a |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
382 field is actually also the beginning of the next input field, this |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
383 behavior is sometimes useful). Additionally in the MERGE_AT_BOUNDARY |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
384 true case, if two fields are separated by a field with the special |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
385 value `boundary', and POS lies within it, then the two separated |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
386 fields are considered to be adjacent, and POS between them, when |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
387 finding the beginning and ending of the "merged" field. |
26389
e2acf63b5403
(Fline_beginning_position): If N is not 1,
Richard M. Stallman <rms@gnu.org>
parents:
26372
diff
changeset
|
388 |
e2acf63b5403
(Fline_beginning_position): If N is not 1,
Richard M. Stallman <rms@gnu.org>
parents:
26372
diff
changeset
|
389 Either BEG or END may be 0, in which case the corresponding value |
e2acf63b5403
(Fline_beginning_position): If N is not 1,
Richard M. Stallman <rms@gnu.org>
parents:
26372
diff
changeset
|
390 is not stored. */ |
e2acf63b5403
(Fline_beginning_position): If N is not 1,
Richard M. Stallman <rms@gnu.org>
parents:
26372
diff
changeset
|
391 |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
392 static void |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
393 find_field (pos, merge_at_boundary, beg, end) |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
394 Lisp_Object pos; |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
395 Lisp_Object merge_at_boundary; |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
396 int *beg, *end; |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
397 { |
30439
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
398 /* Fields right before and after the point. */ |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
399 Lisp_Object before_field, after_field; |
26389
e2acf63b5403
(Fline_beginning_position): If N is not 1,
Richard M. Stallman <rms@gnu.org>
parents:
26372
diff
changeset
|
400 /* 1 if POS counts as the start of a field. */ |
e2acf63b5403
(Fline_beginning_position): If N is not 1,
Richard M. Stallman <rms@gnu.org>
parents:
26372
diff
changeset
|
401 int at_field_start = 0; |
e2acf63b5403
(Fline_beginning_position): If N is not 1,
Richard M. Stallman <rms@gnu.org>
parents:
26372
diff
changeset
|
402 /* 1 if POS counts as the end of a field. */ |
e2acf63b5403
(Fline_beginning_position): If N is not 1,
Richard M. Stallman <rms@gnu.org>
parents:
26372
diff
changeset
|
403 int at_field_end = 0; |
30439
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
404 |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
405 if (NILP (pos)) |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
406 XSETFASTINT (pos, PT); |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
407 else |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
408 CHECK_NUMBER_COERCE_MARKER (pos, 0); |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
409 |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
410 after_field |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
411 = Fget_char_property (pos, Qfield, Qnil); |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
412 before_field |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
413 = (XFASTINT (pos) > BEGV |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
414 ? Fget_char_property (make_number (XINT (pos) - 1), Qfield, Qnil) |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
415 : Qnil); |
30439
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
416 |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
417 /* See if we need to handle the case where MERGE_AT_BOUNDARY is nil |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
418 and POS is at beginning of a field, which can also be interpreted |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
419 as the end of the previous field. Note that the case where if |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
420 MERGE_AT_BOUNDARY is non-nil (see function comment) is actually the |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
421 more natural one; then we avoid treating the beginning of a field |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
422 specially. */ |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
423 if (NILP (merge_at_boundary) && !EQ (after_field, before_field)) |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
424 /* We are at a boundary, see which direction is inclusive. We |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
425 decide by seeing which field the `field' property sticks to. */ |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
426 { |
30439
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
427 int stickiness = char_property_stickiness (Qfield, pos); |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
428 |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
429 if (stickiness > 0) |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
430 at_field_start = 1; |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
431 else if (stickiness < 0) |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
432 at_field_end = 1; |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
433 else |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
434 /* STICKINESS == 0 means that any inserted text will get a |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
435 `field' char-property of nil, so check to see if that |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
436 matches either of the adjacent characters (this being a |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
437 kind of "stickiness by default"). */ |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
438 { |
30439
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
439 if (NILP (before_field)) |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
440 at_field_end = 1; /* Sticks to the left. */ |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
441 else if (NILP (after_field)) |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
442 at_field_start = 1; /* Sticks to the right. */ |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
443 } |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
444 } |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
445 |
30439
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
446 /* Note about special `boundary' fields: |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
447 |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
448 Consider the case where the point (`.') is between the fields `x' and `y': |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
449 |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
450 xxxx.yyyy |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
451 |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
452 In this situation, if merge_at_boundary is true, we consider the |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
453 `x' and `y' fields as forming one big merged field, and so the end |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
454 of the field is the end of `y'. |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
455 |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
456 However, if `x' and `y' are separated by a special `boundary' field |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
457 (a field with a `field' char-property of 'boundary), then we ignore |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
458 this special field when merging adjacent fields. Here's the same |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
459 situation, but with a `boundary' field between the `x' and `y' fields: |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
460 |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
461 xxx.BBBByyyy |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
462 |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
463 Here, if point is at the end of `x', the beginning of `y', or |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
464 anywhere in-between (within the `boundary' field), we merge all |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
465 three fields and consider the beginning as being the beginning of |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
466 the `x' field, and the end as being the end of the `y' field. */ |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
467 |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
468 if (beg) |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
469 { |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
470 if (at_field_start) |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
471 /* POS is at the edge of a field, and we should consider it as |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
472 the beginning of the following field. */ |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
473 *beg = XFASTINT (pos); |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
474 else |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
475 /* Find the previous field boundary. */ |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
476 { |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
477 if (!NILP (merge_at_boundary) && EQ (before_field, Qboundary)) |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
478 /* Skip a `boundary' field. */ |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
479 pos = Fprevious_single_char_property_change (pos, Qfield, Qnil,Qnil); |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
480 |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
481 pos = Fprevious_single_char_property_change (pos, Qfield, Qnil, Qnil); |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
482 *beg = NILP (pos) ? BEGV : XFASTINT (pos); |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
483 } |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
484 } |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
485 |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
486 if (end) |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
487 { |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
488 if (at_field_end) |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
489 /* POS is at the edge of a field, and we should consider it as |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
490 the end of the previous field. */ |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
491 *end = XFASTINT (pos); |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
492 else |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
493 /* Find the next field boundary. */ |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
494 { |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
495 if (!NILP (merge_at_boundary) && EQ (after_field, Qboundary)) |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
496 /* Skip a `boundary' field. */ |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
497 pos = Fnext_single_char_property_change (pos, Qfield, Qnil, Qnil); |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
498 |
30439
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
499 pos = Fnext_single_char_property_change (pos, Qfield, Qnil, Qnil); |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
500 *end = NILP (pos) ? ZV : XFASTINT (pos); |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
501 } |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
502 } |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
503 } |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
504 |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
505 |
26629
05dcbc266797
(Fdelete_field): Make it noninteractive. Return nil.
Richard M. Stallman <rms@gnu.org>
parents:
26526
diff
changeset
|
506 DEFUN ("delete-field", Fdelete_field, Sdelete_field, 0, 1, 0, |
26347
7fd9f4ecdd29
(Fdelete_field): Renamed from Ferase_field.
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
507 "Delete the field surrounding POS.\n\ |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
508 A field is a region of text with the same `field' property.\n\ |
26389
e2acf63b5403
(Fline_beginning_position): If N is not 1,
Richard M. Stallman <rms@gnu.org>
parents:
26372
diff
changeset
|
509 If POS is nil, the value of point is used for POS.") |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
510 (pos) |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
511 Lisp_Object pos; |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
512 { |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
513 int beg, end; |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
514 find_field (pos, Qnil, &beg, &end); |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
515 if (beg != end) |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
516 del_range (beg, end); |
26629
05dcbc266797
(Fdelete_field): Make it noninteractive. Return nil.
Richard M. Stallman <rms@gnu.org>
parents:
26526
diff
changeset
|
517 return Qnil; |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
518 } |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
519 |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
520 DEFUN ("field-string", Ffield_string, Sfield_string, 0, 1, 0, |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
521 "Return the contents of the field surrounding POS as a string.\n\ |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
522 A field is a region of text with the same `field' property.\n\ |
26389
e2acf63b5403
(Fline_beginning_position): If N is not 1,
Richard M. Stallman <rms@gnu.org>
parents:
26372
diff
changeset
|
523 If POS is nil, the value of point is used for POS.") |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
524 (pos) |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
525 Lisp_Object pos; |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
526 { |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
527 int beg, end; |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
528 find_field (pos, Qnil, &beg, &end); |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
529 return make_buffer_string (beg, end, 1); |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
530 } |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
531 |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
532 DEFUN ("field-string-no-properties", Ffield_string_no_properties, Sfield_string_no_properties, 0, 1, 0, |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
533 "Return the contents of the field around POS, without text-properties.\n\ |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
534 A field is a region of text with the same `field' property.\n\ |
26389
e2acf63b5403
(Fline_beginning_position): If N is not 1,
Richard M. Stallman <rms@gnu.org>
parents:
26372
diff
changeset
|
535 If POS is nil, the value of point is used for POS.") |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
536 (pos) |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
537 Lisp_Object pos; |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
538 { |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
539 int beg, end; |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
540 find_field (pos, Qnil, &beg, &end); |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
541 return make_buffer_string (beg, end, 0); |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
542 } |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
543 |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
544 DEFUN ("field-beginning", Ffield_beginning, Sfield_beginning, 0, 2, 0, |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
545 "Return the beginning of the field surrounding POS.\n\ |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
546 A field is a region of text with the same `field' property.\n\ |
26389
e2acf63b5403
(Fline_beginning_position): If N is not 1,
Richard M. Stallman <rms@gnu.org>
parents:
26372
diff
changeset
|
547 If POS is nil, the value of point is used for POS.\n\ |
e2acf63b5403
(Fline_beginning_position): If N is not 1,
Richard M. Stallman <rms@gnu.org>
parents:
26372
diff
changeset
|
548 If ESCAPE-FROM-EDGE is non-nil and POS is at the beginning of its\n\ |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
549 field, then the beginning of the *previous* field is returned.") |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
550 (pos, escape_from_edge) |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
551 Lisp_Object pos, escape_from_edge; |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
552 { |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
553 int beg; |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
554 find_field (pos, escape_from_edge, &beg, 0); |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
555 return make_number (beg); |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
556 } |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
557 |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
558 DEFUN ("field-end", Ffield_end, Sfield_end, 0, 2, 0, |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
559 "Return the end of the field surrounding POS.\n\ |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
560 A field is a region of text with the same `field' property.\n\ |
26389
e2acf63b5403
(Fline_beginning_position): If N is not 1,
Richard M. Stallman <rms@gnu.org>
parents:
26372
diff
changeset
|
561 If POS is nil, the value of point is used for POS.\n\ |
e2acf63b5403
(Fline_beginning_position): If N is not 1,
Richard M. Stallman <rms@gnu.org>
parents:
26372
diff
changeset
|
562 If ESCAPE-FROM-EDGE is non-nil and POS is at the end of its field,\n\ |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
563 then the end of the *following* field is returned.") |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
564 (pos, escape_from_edge) |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
565 Lisp_Object pos, escape_from_edge; |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
566 { |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
567 int end; |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
568 find_field (pos, escape_from_edge, 0, &end); |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
569 return make_number (end); |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
570 } |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
571 |
30439
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
572 DEFUN ("constrain-to-field", Fconstrain_to_field, Sconstrain_to_field, 2, 5, 0, |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
573 "Return the position closest to NEW-POS that is in the same field as OLD-POS.\n\ |
30439
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
574 \n\ |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
575 A field is a region of text with the same `field' property.\n\ |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
576 If NEW-POS is nil, then the current point is used instead, and set to the\n\ |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
577 constrained position if that is is different.\n\ |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
578 \n\ |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
579 If OLD-POS is at the boundary of two fields, then the allowable\n\ |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
580 positions for NEW-POS depends on the value of the optional argument\n\ |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
581 ESCAPE-FROM-EDGE: If ESCAPE-FROM-EDGE is nil, then NEW-POS is\n\ |
30244
bfc202f38a22
(char_property_eq, char_property_stickiness):
Miles Bader <miles@gnu.org>
parents:
30023
diff
changeset
|
582 constrained to the field that has the same `field' char-property\n\ |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
583 as any new characters inserted at OLD-POS, whereas if ESCAPE-FROM-EDGE\n\ |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
584 is non-nil, NEW-POS is constrained to the union of the two adjacent\n\ |
30439
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
585 fields. Additionally, if two fields are separated by another field with\n\ |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
586 the special value `boundary', then any point within this special field is\n\ |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
587 also considered to be `on the boundary'.\n\ |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
588 \n\ |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
589 If the optional argument ONLY-IN-LINE is non-nil and constraining\n\ |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
590 NEW-POS would move it to a different line, NEW-POS is returned\n\ |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
591 unconstrained. This useful for commands that move by line, like\n\ |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
592 \\[next-line] or \\[beginning-of-line], which should generally respect field boundaries\n\ |
27081
f068649f1c28
(Fconstrain_to_field): Don't constrain if
Gerd Moellmann <gerd@gnu.org>
parents:
27077
diff
changeset
|
593 only in the case where they can still move to the right line.\n\ |
f068649f1c28
(Fconstrain_to_field): Don't constrain if
Gerd Moellmann <gerd@gnu.org>
parents:
27077
diff
changeset
|
594 \n\ |
30439
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
595 If the optional argument INHIBIT-CAPTURE-PROPERTY is non-nil, and OLD-POS has\n\ |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
596 a non-nil property of that name, then any field boundaries are ignored.\n\ |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
597 \n\ |
27081
f068649f1c28
(Fconstrain_to_field): Don't constrain if
Gerd Moellmann <gerd@gnu.org>
parents:
27077
diff
changeset
|
598 Field boundaries are not noticed if `inhibit-field-text-motion' is non-nil.") |
30439
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
599 (new_pos, old_pos, escape_from_edge, only_in_line, inhibit_capture_property) |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
600 Lisp_Object new_pos, old_pos; |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
601 Lisp_Object escape_from_edge, only_in_line, inhibit_capture_property; |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
602 { |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
603 /* If non-zero, then the original point, before re-positioning. */ |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
604 int orig_point = 0; |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
605 |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
606 if (NILP (new_pos)) |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
607 /* Use the current point, and afterwards, set it. */ |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
608 { |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
609 orig_point = PT; |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
610 XSETFASTINT (new_pos, PT); |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
611 } |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
612 |
27081
f068649f1c28
(Fconstrain_to_field): Don't constrain if
Gerd Moellmann <gerd@gnu.org>
parents:
27077
diff
changeset
|
613 if (NILP (Vinhibit_field_text_motion) |
f068649f1c28
(Fconstrain_to_field): Don't constrain if
Gerd Moellmann <gerd@gnu.org>
parents:
27077
diff
changeset
|
614 && !EQ (new_pos, old_pos) |
30439
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
615 && !char_property_eq (Qfield, new_pos, old_pos) |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
616 && (NILP (inhibit_capture_property) |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
617 || NILP (Fget_char_property(old_pos, inhibit_capture_property, Qnil)))) |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
618 /* NEW_POS is not within the same field as OLD_POS; try to |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
619 move NEW_POS so that it is. */ |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
620 { |
30439
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
621 int fwd, shortage; |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
622 Lisp_Object field_bound; |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
623 |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
624 CHECK_NUMBER_COERCE_MARKER (new_pos, 0); |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
625 CHECK_NUMBER_COERCE_MARKER (old_pos, 0); |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
626 |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
627 fwd = (XFASTINT (new_pos) > XFASTINT (old_pos)); |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
628 |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
629 if (fwd) |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
630 field_bound = Ffield_end (old_pos, escape_from_edge); |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
631 else |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
632 field_bound = Ffield_beginning (old_pos, escape_from_edge); |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
633 |
30550
73040724e653
(Fconstrain_to_field): Fix the conditions for deciding when to constrain
Miles Bader <miles@gnu.org>
parents:
30503
diff
changeset
|
634 if (/* See if ESCAPE_FROM_EDGE caused FIELD_BOUND to jump to the |
73040724e653
(Fconstrain_to_field): Fix the conditions for deciding when to constrain
Miles Bader <miles@gnu.org>
parents:
30503
diff
changeset
|
635 other side of NEW_POS, which would mean that NEW_POS is |
73040724e653
(Fconstrain_to_field): Fix the conditions for deciding when to constrain
Miles Bader <miles@gnu.org>
parents:
30503
diff
changeset
|
636 already acceptable, and it's not necessary to constrain it |
73040724e653
(Fconstrain_to_field): Fix the conditions for deciding when to constrain
Miles Bader <miles@gnu.org>
parents:
30503
diff
changeset
|
637 to FIELD_BOUND. */ |
73040724e653
(Fconstrain_to_field): Fix the conditions for deciding when to constrain
Miles Bader <miles@gnu.org>
parents:
30503
diff
changeset
|
638 ((XFASTINT (field_bound) < XFASTINT (new_pos)) ? fwd : !fwd) |
73040724e653
(Fconstrain_to_field): Fix the conditions for deciding when to constrain
Miles Bader <miles@gnu.org>
parents:
30503
diff
changeset
|
639 /* NEW_POS should be constrained, but only if either |
73040724e653
(Fconstrain_to_field): Fix the conditions for deciding when to constrain
Miles Bader <miles@gnu.org>
parents:
30503
diff
changeset
|
640 ONLY_IN_LINE is nil (in which case any constraint is OK), |
73040724e653
(Fconstrain_to_field): Fix the conditions for deciding when to constrain
Miles Bader <miles@gnu.org>
parents:
30503
diff
changeset
|
641 or NEW_POS and FIELD_BOUND are on the same line (in which |
73040724e653
(Fconstrain_to_field): Fix the conditions for deciding when to constrain
Miles Bader <miles@gnu.org>
parents:
30503
diff
changeset
|
642 case the constraint is OK even if ONLY_IN_LINE is non-nil). */ |
73040724e653
(Fconstrain_to_field): Fix the conditions for deciding when to constrain
Miles Bader <miles@gnu.org>
parents:
30503
diff
changeset
|
643 && (NILP (only_in_line) |
73040724e653
(Fconstrain_to_field): Fix the conditions for deciding when to constrain
Miles Bader <miles@gnu.org>
parents:
30503
diff
changeset
|
644 /* This is the ONLY_IN_LINE case, check that NEW_POS and |
73040724e653
(Fconstrain_to_field): Fix the conditions for deciding when to constrain
Miles Bader <miles@gnu.org>
parents:
30503
diff
changeset
|
645 FIELD_BOUND are on the same line by seeing whether |
73040724e653
(Fconstrain_to_field): Fix the conditions for deciding when to constrain
Miles Bader <miles@gnu.org>
parents:
30503
diff
changeset
|
646 there's an intervening newline or not. */ |
73040724e653
(Fconstrain_to_field): Fix the conditions for deciding when to constrain
Miles Bader <miles@gnu.org>
parents:
30503
diff
changeset
|
647 || (scan_buffer ('\n', |
73040724e653
(Fconstrain_to_field): Fix the conditions for deciding when to constrain
Miles Bader <miles@gnu.org>
parents:
30503
diff
changeset
|
648 XFASTINT (new_pos), XFASTINT (field_bound), |
73040724e653
(Fconstrain_to_field): Fix the conditions for deciding when to constrain
Miles Bader <miles@gnu.org>
parents:
30503
diff
changeset
|
649 fwd ? -1 : 1, &shortage, 1), |
73040724e653
(Fconstrain_to_field): Fix the conditions for deciding when to constrain
Miles Bader <miles@gnu.org>
parents:
30503
diff
changeset
|
650 shortage != 0))) |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
651 /* Constrain NEW_POS to FIELD_BOUND. */ |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
652 new_pos = field_bound; |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
653 |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
654 if (orig_point && XFASTINT (new_pos) != orig_point) |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
655 /* The NEW_POS argument was originally nil, so automatically set PT. */ |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
656 SET_PT (XFASTINT (new_pos)); |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
657 } |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
658 |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
659 return new_pos; |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
660 } |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
661 |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
662 |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
663 DEFUN ("line-beginning-position", Fline_beginning_position, Sline_beginning_position, |
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
664 0, 1, 0, |
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
665 "Return the character position of the first character on the current line.\n\ |
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
666 With argument N not nil or 1, move forward N - 1 lines first.\n\ |
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
667 If scan reaches end of buffer, return that position.\n\ |
26389
e2acf63b5403
(Fline_beginning_position): If N is not 1,
Richard M. Stallman <rms@gnu.org>
parents:
26372
diff
changeset
|
668 The scan does not cross a field boundary unless it would move\n\ |
27081
f068649f1c28
(Fconstrain_to_field): Don't constrain if
Gerd Moellmann <gerd@gnu.org>
parents:
27077
diff
changeset
|
669 beyond there to a different line. Field boundaries are not noticed if\n\ |
f068649f1c28
(Fconstrain_to_field): Don't constrain if
Gerd Moellmann <gerd@gnu.org>
parents:
27077
diff
changeset
|
670 `inhibit-field-text-motion' is non-nil. .And if N is nil or 1,\n\ |
f068649f1c28
(Fconstrain_to_field): Don't constrain if
Gerd Moellmann <gerd@gnu.org>
parents:
27077
diff
changeset
|
671 and scan starts at a field boundary, the scan stops as soon as it starts.\n\ |
f068649f1c28
(Fconstrain_to_field): Don't constrain if
Gerd Moellmann <gerd@gnu.org>
parents:
27077
diff
changeset
|
672 \n\ |
26389
e2acf63b5403
(Fline_beginning_position): If N is not 1,
Richard M. Stallman <rms@gnu.org>
parents:
26372
diff
changeset
|
673 This function does not move point.") |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
674 (n) |
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
675 Lisp_Object n; |
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
676 { |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
677 int orig, orig_byte, end; |
305 | 678 |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
679 if (NILP (n)) |
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
680 XSETFASTINT (n, 1); |
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
681 else |
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
682 CHECK_NUMBER (n, 0); |
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
683 |
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
684 orig = PT; |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
685 orig_byte = PT_BYTE; |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
686 Fforward_line (make_number (XINT (n) - 1)); |
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
687 end = PT; |
25647
947cb0e32a1d
(Fline_beginning_position): Handle minibuffer prompt here.
Richard M. Stallman <rms@gnu.org>
parents:
25609
diff
changeset
|
688 |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
689 SET_PT_BOTH (orig, orig_byte); |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
690 |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
691 /* Return END constrained to the current input field. */ |
27081
f068649f1c28
(Fconstrain_to_field): Don't constrain if
Gerd Moellmann <gerd@gnu.org>
parents:
27077
diff
changeset
|
692 return Fconstrain_to_field (make_number (end), make_number (orig), |
f068649f1c28
(Fconstrain_to_field): Don't constrain if
Gerd Moellmann <gerd@gnu.org>
parents:
27077
diff
changeset
|
693 XINT (n) != 1 ? Qt : Qnil, |
30439
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
694 Qt, Qnil); |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
695 } |
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
696 |
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
697 DEFUN ("line-end-position", Fline_end_position, Sline_end_position, |
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
698 0, 1, 0, |
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
699 "Return the character position of the last character on the current line.\n\ |
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
700 With argument N not nil or 1, move forward N - 1 lines first.\n\ |
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
701 If scan reaches end of buffer, return that position.\n\ |
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
702 This function does not move point.") |
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
703 (n) |
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
704 Lisp_Object n; |
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
705 { |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
706 int end_pos; |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
707 int orig = PT; |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
708 |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
709 if (NILP (n)) |
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
710 XSETFASTINT (n, 1); |
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
711 else |
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
712 CHECK_NUMBER (n, 0); |
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
713 |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
714 end_pos = find_before_next_newline (orig, 0, XINT (n) - (XINT (n) <= 0)); |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
715 |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
716 /* Return END_POS constrained to the current input field. */ |
27081
f068649f1c28
(Fconstrain_to_field): Don't constrain if
Gerd Moellmann <gerd@gnu.org>
parents:
27077
diff
changeset
|
717 return Fconstrain_to_field (make_number (end_pos), make_number (orig), |
30439
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
718 Qnil, Qt, Qnil); |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
719 } |
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
720 |
305 | 721 Lisp_Object |
722 save_excursion_save () | |
723 { | |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
724 int visible = (XBUFFER (XWINDOW (selected_window)->buffer) |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
725 == current_buffer); |
305 | 726 |
727 return Fcons (Fpoint_marker (), | |
12982
385a67ad96c3
(save_excursion_save): Pass the new arg to Fcopy_marker.
Richard M. Stallman <rms@gnu.org>
parents:
12973
diff
changeset
|
728 Fcons (Fcopy_marker (current_buffer->mark, Qnil), |
2049
a358c97a23e4
(save_excursion_save): Save mark_active of buffer.
Richard M. Stallman <rms@gnu.org>
parents:
1916
diff
changeset
|
729 Fcons (visible ? Qt : Qnil, |
30480 | 730 current_buffer->mark_active))); |
305 | 731 } |
732 | |
733 Lisp_Object | |
734 save_excursion_restore (info) | |
15075
e8613675066c
(save_excursion_restore): Add gcpros.
Richard M. Stallman <rms@gnu.org>
parents:
15015
diff
changeset
|
735 Lisp_Object info; |
305 | 736 { |
15075
e8613675066c
(save_excursion_restore): Add gcpros.
Richard M. Stallman <rms@gnu.org>
parents:
15015
diff
changeset
|
737 Lisp_Object tem, tem1, omark, nmark; |
e8613675066c
(save_excursion_restore): Add gcpros.
Richard M. Stallman <rms@gnu.org>
parents:
15015
diff
changeset
|
738 struct gcpro gcpro1, gcpro2, gcpro3; |
305 | 739 |
740 tem = Fmarker_buffer (Fcar (info)); | |
741 /* If buffer being returned to is now deleted, avoid error */ | |
742 /* Otherwise could get error here while unwinding to top level | |
743 and crash */ | |
744 /* In that case, Fmarker_buffer returns nil now. */ | |
488 | 745 if (NILP (tem)) |
305 | 746 return Qnil; |
15075
e8613675066c
(save_excursion_restore): Add gcpros.
Richard M. Stallman <rms@gnu.org>
parents:
15015
diff
changeset
|
747 |
e8613675066c
(save_excursion_restore): Add gcpros.
Richard M. Stallman <rms@gnu.org>
parents:
15015
diff
changeset
|
748 omark = nmark = Qnil; |
e8613675066c
(save_excursion_restore): Add gcpros.
Richard M. Stallman <rms@gnu.org>
parents:
15015
diff
changeset
|
749 GCPRO3 (info, omark, nmark); |
e8613675066c
(save_excursion_restore): Add gcpros.
Richard M. Stallman <rms@gnu.org>
parents:
15015
diff
changeset
|
750 |
305 | 751 Fset_buffer (tem); |
752 tem = Fcar (info); | |
753 Fgoto_char (tem); | |
754 unchain_marker (tem); | |
755 tem = Fcar (Fcdr (info)); | |
7485
a1b7f72e0ea2
(save_excursion_restore): Don't run activate-mark-hook
Richard M. Stallman <rms@gnu.org>
parents:
7307
diff
changeset
|
756 omark = Fmarker_position (current_buffer->mark); |
305 | 757 Fset_marker (current_buffer->mark, tem, Fcurrent_buffer ()); |
7485
a1b7f72e0ea2
(save_excursion_restore): Don't run activate-mark-hook
Richard M. Stallman <rms@gnu.org>
parents:
7307
diff
changeset
|
758 nmark = Fmarker_position (tem); |
305 | 759 unchain_marker (tem); |
760 tem = Fcdr (Fcdr (info)); | |
4420
8113d9ba472e
(save_excursion_restore): Never make the buffer visible.
Richard M. Stallman <rms@gnu.org>
parents:
4358
diff
changeset
|
761 #if 0 /* We used to make the current buffer visible in the selected window |
8113d9ba472e
(save_excursion_restore): Never make the buffer visible.
Richard M. Stallman <rms@gnu.org>
parents:
4358
diff
changeset
|
762 if that was true previously. That avoids some anomalies. |
8113d9ba472e
(save_excursion_restore): Never make the buffer visible.
Richard M. Stallman <rms@gnu.org>
parents:
4358
diff
changeset
|
763 But it creates others, and it wasn't documented, and it is simpler |
8113d9ba472e
(save_excursion_restore): Never make the buffer visible.
Richard M. Stallman <rms@gnu.org>
parents:
4358
diff
changeset
|
764 and cleaner never to alter the window/buffer connections. */ |
2049
a358c97a23e4
(save_excursion_save): Save mark_active of buffer.
Richard M. Stallman <rms@gnu.org>
parents:
1916
diff
changeset
|
765 tem1 = Fcar (tem); |
a358c97a23e4
(save_excursion_save): Save mark_active of buffer.
Richard M. Stallman <rms@gnu.org>
parents:
1916
diff
changeset
|
766 if (!NILP (tem1) |
1254
c7e7e3438711
* editfns.c (save_excursion_save, save_excursion_restore):
Jim Blandy <jimb@redhat.com>
parents:
1117
diff
changeset
|
767 && current_buffer != XBUFFER (XWINDOW (selected_window)->buffer)) |
305 | 768 Fswitch_to_buffer (Fcurrent_buffer (), Qnil); |
4420
8113d9ba472e
(save_excursion_restore): Never make the buffer visible.
Richard M. Stallman <rms@gnu.org>
parents:
4358
diff
changeset
|
769 #endif /* 0 */ |
2049
a358c97a23e4
(save_excursion_save): Save mark_active of buffer.
Richard M. Stallman <rms@gnu.org>
parents:
1916
diff
changeset
|
770 |
a358c97a23e4
(save_excursion_save): Save mark_active of buffer.
Richard M. Stallman <rms@gnu.org>
parents:
1916
diff
changeset
|
771 tem1 = current_buffer->mark_active; |
a358c97a23e4
(save_excursion_save): Save mark_active of buffer.
Richard M. Stallman <rms@gnu.org>
parents:
1916
diff
changeset
|
772 current_buffer->mark_active = Fcdr (tem); |
6206
67c608b0e2f7
(save_excursion_restore): Don't call Vrun_hooks if nil.
Richard M. Stallman <rms@gnu.org>
parents:
5915
diff
changeset
|
773 if (!NILP (Vrun_hooks)) |
67c608b0e2f7
(save_excursion_restore): Don't call Vrun_hooks if nil.
Richard M. Stallman <rms@gnu.org>
parents:
5915
diff
changeset
|
774 { |
7485
a1b7f72e0ea2
(save_excursion_restore): Don't run activate-mark-hook
Richard M. Stallman <rms@gnu.org>
parents:
7307
diff
changeset
|
775 /* If mark is active now, and either was not active |
a1b7f72e0ea2
(save_excursion_restore): Don't run activate-mark-hook
Richard M. Stallman <rms@gnu.org>
parents:
7307
diff
changeset
|
776 or was at a different place, run the activate hook. */ |
6206
67c608b0e2f7
(save_excursion_restore): Don't call Vrun_hooks if nil.
Richard M. Stallman <rms@gnu.org>
parents:
5915
diff
changeset
|
777 if (! NILP (current_buffer->mark_active)) |
7485
a1b7f72e0ea2
(save_excursion_restore): Don't run activate-mark-hook
Richard M. Stallman <rms@gnu.org>
parents:
7307
diff
changeset
|
778 { |
a1b7f72e0ea2
(save_excursion_restore): Don't run activate-mark-hook
Richard M. Stallman <rms@gnu.org>
parents:
7307
diff
changeset
|
779 if (! EQ (omark, nmark)) |
a1b7f72e0ea2
(save_excursion_restore): Don't run activate-mark-hook
Richard M. Stallman <rms@gnu.org>
parents:
7307
diff
changeset
|
780 call1 (Vrun_hooks, intern ("activate-mark-hook")); |
a1b7f72e0ea2
(save_excursion_restore): Don't run activate-mark-hook
Richard M. Stallman <rms@gnu.org>
parents:
7307
diff
changeset
|
781 } |
a1b7f72e0ea2
(save_excursion_restore): Don't run activate-mark-hook
Richard M. Stallman <rms@gnu.org>
parents:
7307
diff
changeset
|
782 /* If mark has ceased to be active, run deactivate hook. */ |
6206
67c608b0e2f7
(save_excursion_restore): Don't call Vrun_hooks if nil.
Richard M. Stallman <rms@gnu.org>
parents:
5915
diff
changeset
|
783 else if (! NILP (tem1)) |
67c608b0e2f7
(save_excursion_restore): Don't call Vrun_hooks if nil.
Richard M. Stallman <rms@gnu.org>
parents:
5915
diff
changeset
|
784 call1 (Vrun_hooks, intern ("deactivate-mark-hook")); |
67c608b0e2f7
(save_excursion_restore): Don't call Vrun_hooks if nil.
Richard M. Stallman <rms@gnu.org>
parents:
5915
diff
changeset
|
785 } |
15075
e8613675066c
(save_excursion_restore): Add gcpros.
Richard M. Stallman <rms@gnu.org>
parents:
15015
diff
changeset
|
786 UNGCPRO; |
305 | 787 return Qnil; |
788 } | |
789 | |
790 DEFUN ("save-excursion", Fsave_excursion, Ssave_excursion, 0, UNEVALLED, 0, | |
791 "Save point, mark, and current buffer; execute BODY; restore those things.\n\ | |
792 Executes BODY just like `progn'.\n\ | |
793 The values of point, mark and the current buffer are restored\n\ | |
2049
a358c97a23e4
(save_excursion_save): Save mark_active of buffer.
Richard M. Stallman <rms@gnu.org>
parents:
1916
diff
changeset
|
794 even in case of abnormal exit (throw or error).\n\ |
21200
ea520c42a342
(Fchar_after, Fchar_before): Properly check arg type
Richard M. Stallman <rms@gnu.org>
parents:
21064
diff
changeset
|
795 The state of activation of the mark is also restored.\n\ |
ea520c42a342
(Fchar_after, Fchar_before): Properly check arg type
Richard M. Stallman <rms@gnu.org>
parents:
21064
diff
changeset
|
796 \n\ |
ea520c42a342
(Fchar_after, Fchar_before): Properly check arg type
Richard M. Stallman <rms@gnu.org>
parents:
21064
diff
changeset
|
797 This construct does not save `deactivate-mark', and therefore\n\ |
ea520c42a342
(Fchar_after, Fchar_before): Properly check arg type
Richard M. Stallman <rms@gnu.org>
parents:
21064
diff
changeset
|
798 functions that change the buffer will still cause deactivation\n\ |
ea520c42a342
(Fchar_after, Fchar_before): Properly check arg type
Richard M. Stallman <rms@gnu.org>
parents:
21064
diff
changeset
|
799 of the mark at the end of the command. To prevent that, bind\n\ |
ea520c42a342
(Fchar_after, Fchar_before): Properly check arg type
Richard M. Stallman <rms@gnu.org>
parents:
21064
diff
changeset
|
800 `deactivate-mark' with `let'.") |
305 | 801 (args) |
802 Lisp_Object args; | |
803 { | |
804 register Lisp_Object val; | |
805 int count = specpdl_ptr - specpdl; | |
806 | |
807 record_unwind_protect (save_excursion_restore, save_excursion_save ()); | |
16298
17304eb73f97
(Fsave_current_buffer): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16269
diff
changeset
|
808 |
17304eb73f97
(Fsave_current_buffer): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16269
diff
changeset
|
809 val = Fprogn (args); |
17304eb73f97
(Fsave_current_buffer): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16269
diff
changeset
|
810 return unbind_to (count, val); |
17304eb73f97
(Fsave_current_buffer): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16269
diff
changeset
|
811 } |
17304eb73f97
(Fsave_current_buffer): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16269
diff
changeset
|
812 |
17304eb73f97
(Fsave_current_buffer): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16269
diff
changeset
|
813 DEFUN ("save-current-buffer", Fsave_current_buffer, Ssave_current_buffer, 0, UNEVALLED, 0, |
17304eb73f97
(Fsave_current_buffer): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16269
diff
changeset
|
814 "Save the current buffer; execute BODY; restore the current buffer.\n\ |
17304eb73f97
(Fsave_current_buffer): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16269
diff
changeset
|
815 Executes BODY just like `progn'.") |
17304eb73f97
(Fsave_current_buffer): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16269
diff
changeset
|
816 (args) |
17304eb73f97
(Fsave_current_buffer): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16269
diff
changeset
|
817 Lisp_Object args; |
17304eb73f97
(Fsave_current_buffer): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16269
diff
changeset
|
818 { |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
819 Lisp_Object val; |
16298
17304eb73f97
(Fsave_current_buffer): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16269
diff
changeset
|
820 int count = specpdl_ptr - specpdl; |
17304eb73f97
(Fsave_current_buffer): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16269
diff
changeset
|
821 |
20696
cdbe4824e7f1
(Fsave_current_buffer): Use set_buffer_if_live.
Richard M. Stallman <rms@gnu.org>
parents:
20688
diff
changeset
|
822 record_unwind_protect (set_buffer_if_live, Fcurrent_buffer ()); |
16298
17304eb73f97
(Fsave_current_buffer): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16269
diff
changeset
|
823 |
305 | 824 val = Fprogn (args); |
825 return unbind_to (count, val); | |
826 } | |
827 | |
25608
1cdab17df2b3
(Fbufsize): Accept an extra BUFFER parameter.
Richard M. Stallman <rms@gnu.org>
parents:
25507
diff
changeset
|
828 DEFUN ("buffer-size", Fbufsize, Sbufsize, 0, 1, 0, |
1cdab17df2b3
(Fbufsize): Accept an extra BUFFER parameter.
Richard M. Stallman <rms@gnu.org>
parents:
25507
diff
changeset
|
829 "Return the number of characters in the current buffer.\n\ |
1cdab17df2b3
(Fbufsize): Accept an extra BUFFER parameter.
Richard M. Stallman <rms@gnu.org>
parents:
25507
diff
changeset
|
830 If BUFFER, return the number of characters in that buffer instead.") |
1cdab17df2b3
(Fbufsize): Accept an extra BUFFER parameter.
Richard M. Stallman <rms@gnu.org>
parents:
25507
diff
changeset
|
831 (buffer) |
1cdab17df2b3
(Fbufsize): Accept an extra BUFFER parameter.
Richard M. Stallman <rms@gnu.org>
parents:
25507
diff
changeset
|
832 Lisp_Object buffer; |
305 | 833 { |
25608
1cdab17df2b3
(Fbufsize): Accept an extra BUFFER parameter.
Richard M. Stallman <rms@gnu.org>
parents:
25507
diff
changeset
|
834 if (NILP (buffer)) |
1cdab17df2b3
(Fbufsize): Accept an extra BUFFER parameter.
Richard M. Stallman <rms@gnu.org>
parents:
25507
diff
changeset
|
835 return make_number (Z - BEG); |
25609
157f0e91232e
Clear up previous change.
Richard M. Stallman <rms@gnu.org>
parents:
25608
diff
changeset
|
836 else |
157f0e91232e
Clear up previous change.
Richard M. Stallman <rms@gnu.org>
parents:
25608
diff
changeset
|
837 { |
157f0e91232e
Clear up previous change.
Richard M. Stallman <rms@gnu.org>
parents:
25608
diff
changeset
|
838 CHECK_BUFFER (buffer, 1); |
157f0e91232e
Clear up previous change.
Richard M. Stallman <rms@gnu.org>
parents:
25608
diff
changeset
|
839 return make_number (BUF_Z (XBUFFER (buffer)) |
157f0e91232e
Clear up previous change.
Richard M. Stallman <rms@gnu.org>
parents:
25608
diff
changeset
|
840 - BUF_BEG (XBUFFER (buffer))); |
157f0e91232e
Clear up previous change.
Richard M. Stallman <rms@gnu.org>
parents:
25608
diff
changeset
|
841 } |
305 | 842 } |
843 | |
844 DEFUN ("point-min", Fpoint_min, Spoint_min, 0, 0, 0, | |
845 "Return the minimum permissible value of point in the current buffer.\n\ | |
4943 | 846 This is 1, unless narrowing (a buffer restriction) is in effect.") |
305 | 847 () |
848 { | |
849 Lisp_Object temp; | |
9305
ac077e2a75f1
(Fstring_to_char, Fpoint, Fbufsize, Fpoint_min, Fpoint_max, Ffollowing_char,
Karl Heuer <kwzh@gnu.org>
parents:
9265
diff
changeset
|
850 XSETFASTINT (temp, BEGV); |
305 | 851 return temp; |
852 } | |
853 | |
854 DEFUN ("point-min-marker", Fpoint_min_marker, Spoint_min_marker, 0, 0, 0, | |
855 "Return a marker to the minimum permissible value of point in this buffer.\n\ | |
4943 | 856 This is the beginning, unless narrowing (a buffer restriction) is in effect.") |
305 | 857 () |
858 { | |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
859 return buildmark (BEGV, BEGV_BYTE); |
305 | 860 } |
861 | |
862 DEFUN ("point-max", Fpoint_max, Spoint_max, 0, 0, 0, | |
863 "Return the maximum permissible value of point in the current buffer.\n\ | |
4943 | 864 This is (1+ (buffer-size)), unless narrowing (a buffer restriction)\n\ |
865 is in effect, in which case it is less.") | |
305 | 866 () |
867 { | |
868 Lisp_Object temp; | |
9305
ac077e2a75f1
(Fstring_to_char, Fpoint, Fbufsize, Fpoint_min, Fpoint_max, Ffollowing_char,
Karl Heuer <kwzh@gnu.org>
parents:
9265
diff
changeset
|
869 XSETFASTINT (temp, ZV); |
305 | 870 return temp; |
871 } | |
872 | |
873 DEFUN ("point-max-marker", Fpoint_max_marker, Spoint_max_marker, 0, 0, 0, | |
874 "Return a marker to the maximum permissible value of point in this buffer.\n\ | |
4943 | 875 This is (1+ (buffer-size)), unless narrowing (a buffer restriction)\n\ |
876 is in effect, in which case it is less.") | |
305 | 877 () |
878 { | |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
879 return buildmark (ZV, ZV_BYTE); |
305 | 880 } |
881 | |
21821
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
882 DEFUN ("gap-position", Fgap_position, Sgap_position, 0, 0, 0, |
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
883 "Return the position of the gap, in the current buffer.\n\ |
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
884 See also `gap-size'.") |
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
885 () |
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
886 { |
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
887 Lisp_Object temp; |
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
888 XSETFASTINT (temp, GPT); |
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
889 return temp; |
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
890 } |
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
891 |
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
892 DEFUN ("gap-size", Fgap_size, Sgap_size, 0, 0, 0, |
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
893 "Return the size of the current buffer's gap.\n\ |
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
894 See also `gap-position'.") |
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
895 () |
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
896 { |
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
897 Lisp_Object temp; |
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
898 XSETFASTINT (temp, GAP_SIZE); |
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
899 return temp; |
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
900 } |
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
901 |
20861
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
902 DEFUN ("position-bytes", Fposition_bytes, Sposition_bytes, 1, 1, 0, |
23132
1c8e0e09aea1
(Fposition_bytes): If the arg POSITION is out of
Kenichi Handa <handa@m17n.org>
parents:
23063
diff
changeset
|
903 "Return the byte position for character position POSITION.\n\ |
1c8e0e09aea1
(Fposition_bytes): If the arg POSITION is out of
Kenichi Handa <handa@m17n.org>
parents:
23063
diff
changeset
|
904 If POSITION is out of range, the value is nil.") |
20861
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
905 (position) |
20879
64d2baa47498
(Fposition_bytes): Declare arg POSITION as Lips_Object.
Kenichi Handa <handa@m17n.org>
parents:
20878
diff
changeset
|
906 Lisp_Object position; |
20861
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
907 { |
20878
34e0c8eb49eb
(Fposition_bytes): Allow marker as arg POSITION. Use
Kenichi Handa <handa@m17n.org>
parents:
20861
diff
changeset
|
908 CHECK_NUMBER_COERCE_MARKER (position, 1); |
23132
1c8e0e09aea1
(Fposition_bytes): If the arg POSITION is out of
Kenichi Handa <handa@m17n.org>
parents:
23063
diff
changeset
|
909 if (XINT (position) < BEG || XINT (position) > Z) |
1c8e0e09aea1
(Fposition_bytes): If the arg POSITION is out of
Kenichi Handa <handa@m17n.org>
parents:
23063
diff
changeset
|
910 return Qnil; |
20878
34e0c8eb49eb
(Fposition_bytes): Allow marker as arg POSITION. Use
Kenichi Handa <handa@m17n.org>
parents:
20861
diff
changeset
|
911 return make_number (CHAR_TO_BYTE (XINT (position))); |
20861
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
912 } |
22645
e5b201634497
(Fbyte_to_position): New function.
Richard M. Stallman <rms@gnu.org>
parents:
22199
diff
changeset
|
913 |
e5b201634497
(Fbyte_to_position): New function.
Richard M. Stallman <rms@gnu.org>
parents:
22199
diff
changeset
|
914 DEFUN ("byte-to-position", Fbyte_to_position, Sbyte_to_position, 1, 1, 0, |
23132
1c8e0e09aea1
(Fposition_bytes): If the arg POSITION is out of
Kenichi Handa <handa@m17n.org>
parents:
23063
diff
changeset
|
915 "Return the character position for byte position BYTEPOS.\n\ |
1c8e0e09aea1
(Fposition_bytes): If the arg POSITION is out of
Kenichi Handa <handa@m17n.org>
parents:
23063
diff
changeset
|
916 If BYTEPOS is out of range, the value is nil.") |
22645
e5b201634497
(Fbyte_to_position): New function.
Richard M. Stallman <rms@gnu.org>
parents:
22199
diff
changeset
|
917 (bytepos) |
e5b201634497
(Fbyte_to_position): New function.
Richard M. Stallman <rms@gnu.org>
parents:
22199
diff
changeset
|
918 Lisp_Object bytepos; |
e5b201634497
(Fbyte_to_position): New function.
Richard M. Stallman <rms@gnu.org>
parents:
22199
diff
changeset
|
919 { |
e5b201634497
(Fbyte_to_position): New function.
Richard M. Stallman <rms@gnu.org>
parents:
22199
diff
changeset
|
920 CHECK_NUMBER (bytepos, 1); |
23132
1c8e0e09aea1
(Fposition_bytes): If the arg POSITION is out of
Kenichi Handa <handa@m17n.org>
parents:
23063
diff
changeset
|
921 if (XINT (bytepos) < BEG_BYTE || XINT (bytepos) > Z_BYTE) |
1c8e0e09aea1
(Fposition_bytes): If the arg POSITION is out of
Kenichi Handa <handa@m17n.org>
parents:
23063
diff
changeset
|
922 return Qnil; |
22645
e5b201634497
(Fbyte_to_position): New function.
Richard M. Stallman <rms@gnu.org>
parents:
22199
diff
changeset
|
923 return make_number (BYTE_TO_CHAR (XINT (bytepos))); |
e5b201634497
(Fbyte_to_position): New function.
Richard M. Stallman <rms@gnu.org>
parents:
22199
diff
changeset
|
924 } |
20861
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
925 |
512 | 926 DEFUN ("following-char", Ffollowing_char, Sfollowing_char, 0, 0, 0, |
927 "Return the character following point, as a number.\n\ | |
28545
19535c629080
(preceding-char, following-char): Doc fix.
Dave Love <fx@gnu.org>
parents:
28470
diff
changeset
|
928 At the end of the buffer or accessible region, return 0.") |
305 | 929 () |
930 { | |
931 Lisp_Object temp; | |
16039
855c8d8ba0f0
Change all references from point to PT.
Karl Heuer <kwzh@gnu.org>
parents:
15910
diff
changeset
|
932 if (PT >= ZV) |
9305
ac077e2a75f1
(Fstring_to_char, Fpoint, Fbufsize, Fpoint_min, Fpoint_max, Ffollowing_char,
Karl Heuer <kwzh@gnu.org>
parents:
9265
diff
changeset
|
933 XSETFASTINT (temp, 0); |
512 | 934 else |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
935 XSETFASTINT (temp, FETCH_CHAR (PT_BYTE)); |
305 | 936 return temp; |
937 } | |
938 | |
512 | 939 DEFUN ("preceding-char", Fprevious_char, Sprevious_char, 0, 0, 0, |
940 "Return the character preceding point, as a number.\n\ | |
28545
19535c629080
(preceding-char, following-char): Doc fix.
Dave Love <fx@gnu.org>
parents:
28470
diff
changeset
|
941 At the beginning of the buffer or accessible region, return 0.") |
305 | 942 () |
943 { | |
944 Lisp_Object temp; | |
16039
855c8d8ba0f0
Change all references from point to PT.
Karl Heuer <kwzh@gnu.org>
parents:
15910
diff
changeset
|
945 if (PT <= BEGV) |
9305
ac077e2a75f1
(Fstring_to_char, Fpoint, Fbufsize, Fpoint_min, Fpoint_max, Ffollowing_char,
Karl Heuer <kwzh@gnu.org>
parents:
9265
diff
changeset
|
946 XSETFASTINT (temp, 0); |
17031 | 947 else if (!NILP (current_buffer->enable_multibyte_characters)) |
948 { | |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
949 int pos = PT_BYTE; |
17031 | 950 DEC_POS (pos); |
951 XSETFASTINT (temp, FETCH_CHAR (pos)); | |
952 } | |
305 | 953 else |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
954 XSETFASTINT (temp, FETCH_BYTE (PT_BYTE - 1)); |
305 | 955 return temp; |
956 } | |
957 | |
958 DEFUN ("bobp", Fbobp, Sbobp, 0, 0, 0, | |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
959 "Return t if point is at the beginning of the buffer.\n\ |
305 | 960 If the buffer is narrowed, this means the beginning of the narrowed part.") |
961 () | |
962 { | |
16039
855c8d8ba0f0
Change all references from point to PT.
Karl Heuer <kwzh@gnu.org>
parents:
15910
diff
changeset
|
963 if (PT == BEGV) |
305 | 964 return Qt; |
965 return Qnil; | |
966 } | |
967 | |
968 DEFUN ("eobp", Feobp, Seobp, 0, 0, 0, | |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
969 "Return t if point is at the end of the buffer.\n\ |
305 | 970 If the buffer is narrowed, this means the end of the narrowed part.") |
971 () | |
972 { | |
16039
855c8d8ba0f0
Change all references from point to PT.
Karl Heuer <kwzh@gnu.org>
parents:
15910
diff
changeset
|
973 if (PT == ZV) |
305 | 974 return Qt; |
975 return Qnil; | |
976 } | |
977 | |
978 DEFUN ("bolp", Fbolp, Sbolp, 0, 0, 0, | |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
979 "Return t if point is at the beginning of a line.") |
305 | 980 () |
981 { | |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
982 if (PT == BEGV || FETCH_BYTE (PT_BYTE - 1) == '\n') |
305 | 983 return Qt; |
984 return Qnil; | |
985 } | |
986 | |
987 DEFUN ("eolp", Feolp, Seolp, 0, 0, 0, | |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
988 "Return t if point is at the end of a line.\n\ |
305 | 989 `End of a line' includes point being at the end of the buffer.") |
990 () | |
991 { | |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
992 if (PT == ZV || FETCH_BYTE (PT_BYTE) == '\n') |
305 | 993 return Qt; |
994 return Qnil; | |
995 } | |
996 | |
18252
9c4fb902b6eb
(Fchar_after, Fchar_before): Make arg optional.
Richard M. Stallman <rms@gnu.org>
parents:
18240
diff
changeset
|
997 DEFUN ("char-after", Fchar_after, Schar_after, 0, 1, 0, |
305 | 998 "Return character in current buffer at position POS.\n\ |
27445
a1fc4f6f01bf
(Fchar_after, Fchar_before): Doc fix.
Dave Love <fx@gnu.org>
parents:
27081
diff
changeset
|
999 POS is an integer or a marker.\n\ |
22199
edca9002c740
(Fchar_after): Make nil fully equivalent to (point) as arg.
Richard M. Stallman <rms@gnu.org>
parents:
21914
diff
changeset
|
1000 If POS is out of range, the value is nil.") |
305 | 1001 (pos) |
1002 Lisp_Object pos; | |
1003 { | |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
1004 register int pos_byte; |
305 | 1005 |
18252
9c4fb902b6eb
(Fchar_after, Fchar_before): Make arg optional.
Richard M. Stallman <rms@gnu.org>
parents:
18240
diff
changeset
|
1006 if (NILP (pos)) |
22199
edca9002c740
(Fchar_after): Make nil fully equivalent to (point) as arg.
Richard M. Stallman <rms@gnu.org>
parents:
21914
diff
changeset
|
1007 { |
edca9002c740
(Fchar_after): Make nil fully equivalent to (point) as arg.
Richard M. Stallman <rms@gnu.org>
parents:
21914
diff
changeset
|
1008 pos_byte = PT_BYTE; |
23577
36cccf1ba0a9
(Fchar_after): Fix type clashes.
Andreas Schwab <schwab@suse.de>
parents:
23565
diff
changeset
|
1009 XSETFASTINT (pos, PT); |
22199
edca9002c740
(Fchar_after): Make nil fully equivalent to (point) as arg.
Richard M. Stallman <rms@gnu.org>
parents:
21914
diff
changeset
|
1010 } |
edca9002c740
(Fchar_after): Make nil fully equivalent to (point) as arg.
Richard M. Stallman <rms@gnu.org>
parents:
21914
diff
changeset
|
1011 |
edca9002c740
(Fchar_after): Make nil fully equivalent to (point) as arg.
Richard M. Stallman <rms@gnu.org>
parents:
21914
diff
changeset
|
1012 if (MARKERP (pos)) |
21200
ea520c42a342
(Fchar_after, Fchar_before): Properly check arg type
Richard M. Stallman <rms@gnu.org>
parents:
21064
diff
changeset
|
1013 { |
ea520c42a342
(Fchar_after, Fchar_before): Properly check arg type
Richard M. Stallman <rms@gnu.org>
parents:
21064
diff
changeset
|
1014 pos_byte = marker_byte_position (pos); |
ea520c42a342
(Fchar_after, Fchar_before): Properly check arg type
Richard M. Stallman <rms@gnu.org>
parents:
21064
diff
changeset
|
1015 if (pos_byte < BEGV_BYTE || pos_byte >= ZV_BYTE) |
ea520c42a342
(Fchar_after, Fchar_before): Properly check arg type
Richard M. Stallman <rms@gnu.org>
parents:
21064
diff
changeset
|
1016 return Qnil; |
ea520c42a342
(Fchar_after, Fchar_before): Properly check arg type
Richard M. Stallman <rms@gnu.org>
parents:
21064
diff
changeset
|
1017 } |
18252
9c4fb902b6eb
(Fchar_after, Fchar_before): Make arg optional.
Richard M. Stallman <rms@gnu.org>
parents:
18240
diff
changeset
|
1018 else |
9c4fb902b6eb
(Fchar_after, Fchar_before): Make arg optional.
Richard M. Stallman <rms@gnu.org>
parents:
18240
diff
changeset
|
1019 { |
9c4fb902b6eb
(Fchar_after, Fchar_before): Make arg optional.
Richard M. Stallman <rms@gnu.org>
parents:
18240
diff
changeset
|
1020 CHECK_NUMBER_COERCE_MARKER (pos, 0); |
21521
354a7085f1d7
(Fchar_after, Fchar_before): Fix mixing of Lisp_Object
Andreas Schwab <schwab@suse.de>
parents:
21514
diff
changeset
|
1021 if (XINT (pos) < BEGV || XINT (pos) >= ZV) |
21200
ea520c42a342
(Fchar_after, Fchar_before): Properly check arg type
Richard M. Stallman <rms@gnu.org>
parents:
21064
diff
changeset
|
1022 return Qnil; |
30480 | 1023 |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
1024 pos_byte = CHAR_TO_BYTE (XINT (pos)); |
18252
9c4fb902b6eb
(Fchar_after, Fchar_before): Make arg optional.
Richard M. Stallman <rms@gnu.org>
parents:
18240
diff
changeset
|
1025 } |
305 | 1026 |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
1027 return make_number (FETCH_CHAR (pos_byte)); |
305 | 1028 } |
17031 | 1029 |
18252
9c4fb902b6eb
(Fchar_after, Fchar_before): Make arg optional.
Richard M. Stallman <rms@gnu.org>
parents:
18240
diff
changeset
|
1030 DEFUN ("char-before", Fchar_before, Schar_before, 0, 1, 0, |
17031 | 1031 "Return character in current buffer preceding position POS.\n\ |
27445
a1fc4f6f01bf
(Fchar_after, Fchar_before): Doc fix.
Dave Love <fx@gnu.org>
parents:
27081
diff
changeset
|
1032 POS is an integer or a marker.\n\ |
22199
edca9002c740
(Fchar_after): Make nil fully equivalent to (point) as arg.
Richard M. Stallman <rms@gnu.org>
parents:
21914
diff
changeset
|
1033 If POS is out of range, the value is nil.") |
17031 | 1034 (pos) |
1035 Lisp_Object pos; | |
1036 { | |
1037 register Lisp_Object val; | |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
1038 register int pos_byte; |
17031 | 1039 |
18252
9c4fb902b6eb
(Fchar_after, Fchar_before): Make arg optional.
Richard M. Stallman <rms@gnu.org>
parents:
18240
diff
changeset
|
1040 if (NILP (pos)) |
22199
edca9002c740
(Fchar_after): Make nil fully equivalent to (point) as arg.
Richard M. Stallman <rms@gnu.org>
parents:
21914
diff
changeset
|
1041 { |
edca9002c740
(Fchar_after): Make nil fully equivalent to (point) as arg.
Richard M. Stallman <rms@gnu.org>
parents:
21914
diff
changeset
|
1042 pos_byte = PT_BYTE; |
23577
36cccf1ba0a9
(Fchar_after): Fix type clashes.
Andreas Schwab <schwab@suse.de>
parents:
23565
diff
changeset
|
1043 XSETFASTINT (pos, PT); |
22199
edca9002c740
(Fchar_after): Make nil fully equivalent to (point) as arg.
Richard M. Stallman <rms@gnu.org>
parents:
21914
diff
changeset
|
1044 } |
edca9002c740
(Fchar_after): Make nil fully equivalent to (point) as arg.
Richard M. Stallman <rms@gnu.org>
parents:
21914
diff
changeset
|
1045 |
edca9002c740
(Fchar_after): Make nil fully equivalent to (point) as arg.
Richard M. Stallman <rms@gnu.org>
parents:
21914
diff
changeset
|
1046 if (MARKERP (pos)) |
21200
ea520c42a342
(Fchar_after, Fchar_before): Properly check arg type
Richard M. Stallman <rms@gnu.org>
parents:
21064
diff
changeset
|
1047 { |
ea520c42a342
(Fchar_after, Fchar_before): Properly check arg type
Richard M. Stallman <rms@gnu.org>
parents:
21064
diff
changeset
|
1048 pos_byte = marker_byte_position (pos); |
ea520c42a342
(Fchar_after, Fchar_before): Properly check arg type
Richard M. Stallman <rms@gnu.org>
parents:
21064
diff
changeset
|
1049 |
ea520c42a342
(Fchar_after, Fchar_before): Properly check arg type
Richard M. Stallman <rms@gnu.org>
parents:
21064
diff
changeset
|
1050 if (pos_byte <= BEGV_BYTE || pos_byte > ZV_BYTE) |
ea520c42a342
(Fchar_after, Fchar_before): Properly check arg type
Richard M. Stallman <rms@gnu.org>
parents:
21064
diff
changeset
|
1051 return Qnil; |
ea520c42a342
(Fchar_after, Fchar_before): Properly check arg type
Richard M. Stallman <rms@gnu.org>
parents:
21064
diff
changeset
|
1052 } |
18252
9c4fb902b6eb
(Fchar_after, Fchar_before): Make arg optional.
Richard M. Stallman <rms@gnu.org>
parents:
18240
diff
changeset
|
1053 else |
9c4fb902b6eb
(Fchar_after, Fchar_before): Make arg optional.
Richard M. Stallman <rms@gnu.org>
parents:
18240
diff
changeset
|
1054 { |
9c4fb902b6eb
(Fchar_after, Fchar_before): Make arg optional.
Richard M. Stallman <rms@gnu.org>
parents:
18240
diff
changeset
|
1055 CHECK_NUMBER_COERCE_MARKER (pos, 0); |
17031 | 1056 |
21521
354a7085f1d7
(Fchar_after, Fchar_before): Fix mixing of Lisp_Object
Andreas Schwab <schwab@suse.de>
parents:
21514
diff
changeset
|
1057 if (XINT (pos) <= BEGV || XINT (pos) > ZV) |
21200
ea520c42a342
(Fchar_after, Fchar_before): Properly check arg type
Richard M. Stallman <rms@gnu.org>
parents:
21064
diff
changeset
|
1058 return Qnil; |
ea520c42a342
(Fchar_after, Fchar_before): Properly check arg type
Richard M. Stallman <rms@gnu.org>
parents:
21064
diff
changeset
|
1059 |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
1060 pos_byte = CHAR_TO_BYTE (XINT (pos)); |
18252
9c4fb902b6eb
(Fchar_after, Fchar_before): Make arg optional.
Richard M. Stallman <rms@gnu.org>
parents:
18240
diff
changeset
|
1061 } |
17031 | 1062 |
1063 if (!NILP (current_buffer->enable_multibyte_characters)) | |
1064 { | |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
1065 DEC_POS (pos_byte); |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
1066 XSETFASTINT (val, FETCH_CHAR (pos_byte)); |
17031 | 1067 } |
1068 else | |
1069 { | |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
1070 pos_byte--; |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
1071 XSETFASTINT (val, FETCH_BYTE (pos_byte)); |
17031 | 1072 } |
1073 return val; | |
1074 } | |
305 | 1075 |
9572 | 1076 DEFUN ("user-login-name", Fuser_login_name, Suser_login_name, 0, 1, 0, |
305 | 1077 "Return the name under which the user logged in, as a string.\n\ |
1078 This is based on the effective uid, not the real uid.\n\ | |
5907
5fdb226fe9a4
(init_editfns): Look at LOGNAME before USER.
Karl Heuer <kwzh@gnu.org>
parents:
5884
diff
changeset
|
1079 Also, if the environment variable LOGNAME or USER is set,\n\ |
9572 | 1080 that determines the value of this function.\n\n\ |
1081 If optional argument UID is an integer, return the login name of the user\n\ | |
1082 with that uid, or nil if there is no such user.") | |
1083 (uid) | |
1084 Lisp_Object uid; | |
305 | 1085 { |
9572 | 1086 struct passwd *pw; |
1087 | |
9520
5187a4159d16
(Fuser_login_name, Fuser_real_login_name):
Richard M. Stallman <rms@gnu.org>
parents:
9305
diff
changeset
|
1088 /* Set up the user name info if we didn't do it before. |
5187a4159d16
(Fuser_login_name, Fuser_real_login_name):
Richard M. Stallman <rms@gnu.org>
parents:
9305
diff
changeset
|
1089 (That can happen if Emacs is dumpable |
5187a4159d16
(Fuser_login_name, Fuser_real_login_name):
Richard M. Stallman <rms@gnu.org>
parents:
9305
diff
changeset
|
1090 but you decide to run `temacs -l loadup' and not dump. */ |
12026
505a894d943e
(syms_of_editfns): user-login-name renamed from user-name.
Karl Heuer <kwzh@gnu.org>
parents:
11912
diff
changeset
|
1091 if (INTEGERP (Vuser_login_name)) |
9520
5187a4159d16
(Fuser_login_name, Fuser_real_login_name):
Richard M. Stallman <rms@gnu.org>
parents:
9305
diff
changeset
|
1092 init_editfns (); |
9572 | 1093 |
1094 if (NILP (uid)) | |
12026
505a894d943e
(syms_of_editfns): user-login-name renamed from user-name.
Karl Heuer <kwzh@gnu.org>
parents:
11912
diff
changeset
|
1095 return Vuser_login_name; |
9572 | 1096 |
1097 CHECK_NUMBER (uid, 0); | |
1098 pw = (struct passwd *) getpwuid (XINT (uid)); | |
1099 return (pw ? build_string (pw->pw_name) : Qnil); | |
305 | 1100 } |
1101 | |
1102 DEFUN ("user-real-login-name", Fuser_real_login_name, Suser_real_login_name, | |
1103 0, 0, 0, | |
1104 "Return the name of the user's real uid, as a string.\n\ | |
6878
175e4da3d3f4
(Fuser_real_login_name): Doc syntax fix.
Richard M. Stallman <rms@gnu.org>
parents:
6772
diff
changeset
|
1105 This ignores the environment variables LOGNAME and USER, so it differs from\n\ |
5915
11c1e1696fe3
(Fuser_real_login_name): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents:
5907
diff
changeset
|
1106 `user-login-name' when running under `su'.") |
305 | 1107 () |
1108 { | |
9520
5187a4159d16
(Fuser_login_name, Fuser_real_login_name):
Richard M. Stallman <rms@gnu.org>
parents:
9305
diff
changeset
|
1109 /* Set up the user name info if we didn't do it before. |
5187a4159d16
(Fuser_login_name, Fuser_real_login_name):
Richard M. Stallman <rms@gnu.org>
parents:
9305
diff
changeset
|
1110 (That can happen if Emacs is dumpable |
5187a4159d16
(Fuser_login_name, Fuser_real_login_name):
Richard M. Stallman <rms@gnu.org>
parents:
9305
diff
changeset
|
1111 but you decide to run `temacs -l loadup' and not dump. */ |
12026
505a894d943e
(syms_of_editfns): user-login-name renamed from user-name.
Karl Heuer <kwzh@gnu.org>
parents:
11912
diff
changeset
|
1112 if (INTEGERP (Vuser_login_name)) |
9520
5187a4159d16
(Fuser_login_name, Fuser_real_login_name):
Richard M. Stallman <rms@gnu.org>
parents:
9305
diff
changeset
|
1113 init_editfns (); |
12026
505a894d943e
(syms_of_editfns): user-login-name renamed from user-name.
Karl Heuer <kwzh@gnu.org>
parents:
11912
diff
changeset
|
1114 return Vuser_real_login_name; |
305 | 1115 } |
1116 | |
1117 DEFUN ("user-uid", Fuser_uid, Suser_uid, 0, 0, 0, | |
1118 "Return the effective uid of Emacs, as an integer.") | |
1119 () | |
1120 { | |
1121 return make_number (geteuid ()); | |
1122 } | |
1123 | |
1124 DEFUN ("user-real-uid", Fuser_real_uid, Suser_real_uid, 0, 0, 0, | |
1125 "Return the real uid of Emacs, as an integer.") | |
1126 () | |
1127 { | |
1128 return make_number (getuid ()); | |
1129 } | |
1130 | |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
1131 DEFUN ("user-full-name", Fuser_full_name, Suser_full_name, 0, 1, 0, |
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
1132 "Return the full name of the user logged in, as a string.\n\ |
24847 | 1133 If the full name corresponding to Emacs's userid is not known,\n\ |
1134 return \"unknown\".\n\ | |
1135 \n\ | |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
1136 If optional argument UID is an integer, return the full name of the user\n\ |
24847 | 1137 with that uid, or nil if there is no such user.\n\ |
16641
2103a88cc61f
(Fuser_full_name): Accept a string (the login name) as
Richard M. Stallman <rms@gnu.org>
parents:
16639
diff
changeset
|
1138 If UID is a string, return the full name of the user with that login\n\ |
24847 | 1139 name, or nil if there is no such user.") |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
1140 (uid) |
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
1141 Lisp_Object uid; |
305 | 1142 { |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
1143 struct passwd *pw; |
18661
537522d5e6d8
(Fuser_full_name): Declare p, q and r as unsigned char *.
Richard M. Stallman <rms@gnu.org>
parents:
18613
diff
changeset
|
1144 register unsigned char *p, *q; |
16641
2103a88cc61f
(Fuser_full_name): Accept a string (the login name) as
Richard M. Stallman <rms@gnu.org>
parents:
16639
diff
changeset
|
1145 Lisp_Object full; |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
1146 |
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
1147 if (NILP (uid)) |
30480 | 1148 return Vuser_full_name; |
16641
2103a88cc61f
(Fuser_full_name): Accept a string (the login name) as
Richard M. Stallman <rms@gnu.org>
parents:
16639
diff
changeset
|
1149 else if (NUMBERP (uid)) |
2103a88cc61f
(Fuser_full_name): Accept a string (the login name) as
Richard M. Stallman <rms@gnu.org>
parents:
16639
diff
changeset
|
1150 pw = (struct passwd *) getpwuid (XINT (uid)); |
30480 | 1151 else if (STRINGP (uid)) |
16641
2103a88cc61f
(Fuser_full_name): Accept a string (the login name) as
Richard M. Stallman <rms@gnu.org>
parents:
16639
diff
changeset
|
1152 pw = (struct passwd *) getpwnam (XSTRING (uid)->data); |
2103a88cc61f
(Fuser_full_name): Accept a string (the login name) as
Richard M. Stallman <rms@gnu.org>
parents:
16639
diff
changeset
|
1153 else |
2103a88cc61f
(Fuser_full_name): Accept a string (the login name) as
Richard M. Stallman <rms@gnu.org>
parents:
16639
diff
changeset
|
1154 error ("Invalid UID specification"); |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
1155 |
16641
2103a88cc61f
(Fuser_full_name): Accept a string (the login name) as
Richard M. Stallman <rms@gnu.org>
parents:
16639
diff
changeset
|
1156 if (!pw) |
16683
6802dbd07a80
(Fuser_full_name): Return nil if the specified user doesn't exist.
Richard M. Stallman <rms@gnu.org>
parents:
16648
diff
changeset
|
1157 return Qnil; |
30480 | 1158 |
16641
2103a88cc61f
(Fuser_full_name): Accept a string (the login name) as
Richard M. Stallman <rms@gnu.org>
parents:
16639
diff
changeset
|
1159 p = (unsigned char *) USER_FULL_NAME; |
2103a88cc61f
(Fuser_full_name): Accept a string (the login name) as
Richard M. Stallman <rms@gnu.org>
parents:
16639
diff
changeset
|
1160 /* Chop off everything after the first comma. */ |
2103a88cc61f
(Fuser_full_name): Accept a string (the login name) as
Richard M. Stallman <rms@gnu.org>
parents:
16639
diff
changeset
|
1161 q = (unsigned char *) index (p, ','); |
2103a88cc61f
(Fuser_full_name): Accept a string (the login name) as
Richard M. Stallman <rms@gnu.org>
parents:
16639
diff
changeset
|
1162 full = make_string (p, q ? q - p : strlen (p)); |
30480 | 1163 |
16641
2103a88cc61f
(Fuser_full_name): Accept a string (the login name) as
Richard M. Stallman <rms@gnu.org>
parents:
16639
diff
changeset
|
1164 #ifdef AMPERSAND_FULL_NAME |
2103a88cc61f
(Fuser_full_name): Accept a string (the login name) as
Richard M. Stallman <rms@gnu.org>
parents:
16639
diff
changeset
|
1165 p = XSTRING (full)->data; |
2103a88cc61f
(Fuser_full_name): Accept a string (the login name) as
Richard M. Stallman <rms@gnu.org>
parents:
16639
diff
changeset
|
1166 q = (unsigned char *) index (p, '&'); |
2103a88cc61f
(Fuser_full_name): Accept a string (the login name) as
Richard M. Stallman <rms@gnu.org>
parents:
16639
diff
changeset
|
1167 /* Substitute the login name for the &, upcasing the first character. */ |
2103a88cc61f
(Fuser_full_name): Accept a string (the login name) as
Richard M. Stallman <rms@gnu.org>
parents:
16639
diff
changeset
|
1168 if (q) |
2103a88cc61f
(Fuser_full_name): Accept a string (the login name) as
Richard M. Stallman <rms@gnu.org>
parents:
16639
diff
changeset
|
1169 { |
18661
537522d5e6d8
(Fuser_full_name): Declare p, q and r as unsigned char *.
Richard M. Stallman <rms@gnu.org>
parents:
18613
diff
changeset
|
1170 register unsigned char *r; |
16641
2103a88cc61f
(Fuser_full_name): Accept a string (the login name) as
Richard M. Stallman <rms@gnu.org>
parents:
16639
diff
changeset
|
1171 Lisp_Object login; |
2103a88cc61f
(Fuser_full_name): Accept a string (the login name) as
Richard M. Stallman <rms@gnu.org>
parents:
16639
diff
changeset
|
1172 |
2103a88cc61f
(Fuser_full_name): Accept a string (the login name) as
Richard M. Stallman <rms@gnu.org>
parents:
16639
diff
changeset
|
1173 login = Fuser_login_name (make_number (pw->pw_uid)); |
2103a88cc61f
(Fuser_full_name): Accept a string (the login name) as
Richard M. Stallman <rms@gnu.org>
parents:
16639
diff
changeset
|
1174 r = (unsigned char *) alloca (strlen (p) + XSTRING (login)->size + 1); |
2103a88cc61f
(Fuser_full_name): Accept a string (the login name) as
Richard M. Stallman <rms@gnu.org>
parents:
16639
diff
changeset
|
1175 bcopy (p, r, q - p); |
2103a88cc61f
(Fuser_full_name): Accept a string (the login name) as
Richard M. Stallman <rms@gnu.org>
parents:
16639
diff
changeset
|
1176 r[q - p] = 0; |
2103a88cc61f
(Fuser_full_name): Accept a string (the login name) as
Richard M. Stallman <rms@gnu.org>
parents:
16639
diff
changeset
|
1177 strcat (r, XSTRING (login)->data); |
2103a88cc61f
(Fuser_full_name): Accept a string (the login name) as
Richard M. Stallman <rms@gnu.org>
parents:
16639
diff
changeset
|
1178 r[q - p] = UPCASE (r[q - p]); |
2103a88cc61f
(Fuser_full_name): Accept a string (the login name) as
Richard M. Stallman <rms@gnu.org>
parents:
16639
diff
changeset
|
1179 strcat (r, q + 1); |
2103a88cc61f
(Fuser_full_name): Accept a string (the login name) as
Richard M. Stallman <rms@gnu.org>
parents:
16639
diff
changeset
|
1180 full = build_string (r); |
2103a88cc61f
(Fuser_full_name): Accept a string (the login name) as
Richard M. Stallman <rms@gnu.org>
parents:
16639
diff
changeset
|
1181 } |
2103a88cc61f
(Fuser_full_name): Accept a string (the login name) as
Richard M. Stallman <rms@gnu.org>
parents:
16639
diff
changeset
|
1182 #endif /* AMPERSAND_FULL_NAME */ |
2103a88cc61f
(Fuser_full_name): Accept a string (the login name) as
Richard M. Stallman <rms@gnu.org>
parents:
16639
diff
changeset
|
1183 |
2103a88cc61f
(Fuser_full_name): Accept a string (the login name) as
Richard M. Stallman <rms@gnu.org>
parents:
16639
diff
changeset
|
1184 return full; |
305 | 1185 } |
1186 | |
1187 DEFUN ("system-name", Fsystem_name, Ssystem_name, 0, 0, 0, | |
1188 "Return the name of the machine you are running on, as a string.") | |
1189 () | |
1190 { | |
1191 return Vsystem_name; | |
1192 } | |
1193 | |
7907
148ad20d6774
(init_editfns): Call init_system_name instead of get_system_name.
Karl Heuer <kwzh@gnu.org>
parents:
7862
diff
changeset
|
1194 /* For the benefit of callers who don't want to include lisp.h */ |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
1195 |
7907
148ad20d6774
(init_editfns): Call init_system_name instead of get_system_name.
Karl Heuer <kwzh@gnu.org>
parents:
7862
diff
changeset
|
1196 char * |
148ad20d6774
(init_editfns): Call init_system_name instead of get_system_name.
Karl Heuer <kwzh@gnu.org>
parents:
7862
diff
changeset
|
1197 get_system_name () |
148ad20d6774
(init_editfns): Call init_system_name instead of get_system_name.
Karl Heuer <kwzh@gnu.org>
parents:
7862
diff
changeset
|
1198 { |
18756
751f531e5a20
(get_system_name): Don't crash if Vsystem_name does not contain a string.
Richard M. Stallman <rms@gnu.org>
parents:
18745
diff
changeset
|
1199 if (STRINGP (Vsystem_name)) |
751f531e5a20
(get_system_name): Don't crash if Vsystem_name does not contain a string.
Richard M. Stallman <rms@gnu.org>
parents:
18745
diff
changeset
|
1200 return (char *) XSTRING (Vsystem_name)->data; |
751f531e5a20
(get_system_name): Don't crash if Vsystem_name does not contain a string.
Richard M. Stallman <rms@gnu.org>
parents:
18745
diff
changeset
|
1201 else |
751f531e5a20
(get_system_name): Don't crash if Vsystem_name does not contain a string.
Richard M. Stallman <rms@gnu.org>
parents:
18745
diff
changeset
|
1202 return ""; |
7907
148ad20d6774
(init_editfns): Call init_system_name instead of get_system_name.
Karl Heuer <kwzh@gnu.org>
parents:
7862
diff
changeset
|
1203 } |
148ad20d6774
(init_editfns): Call init_system_name instead of get_system_name.
Karl Heuer <kwzh@gnu.org>
parents:
7862
diff
changeset
|
1204 |
5373
a70b89d2d6bb
(Femacs_pid): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5242
diff
changeset
|
1205 DEFUN ("emacs-pid", Femacs_pid, Semacs_pid, 0, 0, 0, |
a70b89d2d6bb
(Femacs_pid): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5242
diff
changeset
|
1206 "Return the process ID of Emacs, as an integer.") |
a70b89d2d6bb
(Femacs_pid): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5242
diff
changeset
|
1207 () |
a70b89d2d6bb
(Femacs_pid): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5242
diff
changeset
|
1208 { |
a70b89d2d6bb
(Femacs_pid): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5242
diff
changeset
|
1209 return make_number (getpid ()); |
a70b89d2d6bb
(Femacs_pid): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5242
diff
changeset
|
1210 } |
a70b89d2d6bb
(Femacs_pid): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5242
diff
changeset
|
1211 |
448 | 1212 DEFUN ("current-time", Fcurrent_time, Scurrent_time, 0, 0, 0, |
13618
5fe951036f57
(Fcurrent_time): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
13450
diff
changeset
|
1213 "Return the current time, as the number of seconds since 1970-01-01 00:00:00.\n\ |
577 | 1214 The time is returned as a list of three integers. The first has the\n\ |
1215 most significant 16 bits of the seconds, while the second has the\n\ | |
1216 least significant 16 bits. The third integer gives the microsecond\n\ | |
1217 count.\n\ | |
1218 \n\ | |
1219 The microsecond count is zero on systems that do not provide\n\ | |
1220 resolution finer than a second.") | |
448 | 1221 () |
1222 { | |
577 | 1223 EMACS_TIME t; |
1224 Lisp_Object result[3]; | |
1225 | |
1226 EMACS_GET_TIME (t); | |
9265
e44908d7323b
(Fcurrent_time, Fformat): Use new accessor macros instead of calling XSET
Karl Heuer <kwzh@gnu.org>
parents:
9163
diff
changeset
|
1227 XSETINT (result[0], (EMACS_SECS (t) >> 16) & 0xffff); |
e44908d7323b
(Fcurrent_time, Fformat): Use new accessor macros instead of calling XSET
Karl Heuer <kwzh@gnu.org>
parents:
9163
diff
changeset
|
1228 XSETINT (result[1], (EMACS_SECS (t) >> 0) & 0xffff); |
e44908d7323b
(Fcurrent_time, Fformat): Use new accessor macros instead of calling XSET
Karl Heuer <kwzh@gnu.org>
parents:
9163
diff
changeset
|
1229 XSETINT (result[2], EMACS_USECS (t)); |
577 | 1230 |
1231 return Flist (3, result); | |
448 | 1232 } |
1233 | |
1234 | |
2921
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1235 static int |
30480 | 1236 lisp_time_argument (specified_time, result, usec) |
2921
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1237 Lisp_Object specified_time; |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1238 time_t *result; |
30480 | 1239 int *usec; |
2921
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1240 { |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1241 if (NILP (specified_time)) |
30480 | 1242 { |
1243 if (usec) | |
1244 { | |
1245 EMACS_TIME t; | |
1246 | |
30503
fef49230e1aa
(lisp_time_argument): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents:
30480
diff
changeset
|
1247 EMACS_GET_TIME (t); |
30480 | 1248 *usec = EMACS_USECS (t); |
1249 *result = EMACS_SECS (t); | |
1250 return 1; | |
1251 } | |
1252 else | |
1253 return time (result) != -1; | |
1254 } | |
2921
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1255 else |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1256 { |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1257 Lisp_Object high, low; |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1258 high = Fcar (specified_time); |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1259 CHECK_NUMBER (high, 0); |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1260 low = Fcdr (specified_time); |
9163
41fe5f636879
(lisp_time_argument, Finsert, Finsert_and_inherit, Finsert_before_markers,
Karl Heuer <kwzh@gnu.org>
parents:
9154
diff
changeset
|
1261 if (CONSP (low)) |
30480 | 1262 { |
1263 if (usec) | |
1264 { | |
1265 Lisp_Object usec_l = Fcdr (low); | |
1266 if (CONSP (usec_l)) | |
1267 usec_l = Fcar (usec_l); | |
1268 if (NILP (usec_l)) | |
1269 *usec = 0; | |
1270 else | |
1271 { | |
1272 CHECK_NUMBER (usec_l, 0); | |
1273 *usec = XINT (usec_l); | |
1274 } | |
1275 } | |
1276 low = Fcar (low); | |
1277 } | |
1278 else if (usec) | |
1279 *usec = 0; | |
2921
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1280 CHECK_NUMBER (low, 0); |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1281 *result = (XINT (high) << 16) + (XINT (low) & 0xffff); |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1282 return *result >> 16 == XINT (high); |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1283 } |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1284 } |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1285 |
30480 | 1286 DEFUN ("float-time", Ffloat_time, Sfloat_time, 0, 1, 0, |
1287 "Return the current time, as a float number of seconds since the epoch.\n\ | |
1288 If an argument is given, it specifies a time to convert to float\n\ | |
1289 instead of the current time. The argument should have the forms:\n\ | |
1290 (HIGH . LOW) or (HIGH LOW USEC) or (HIGH LOW . USEC).\n\ | |
1291 Thus, you can use times obtained from `current-time'\n\ | |
1292 and from `file-attributes'.") | |
1293 (specified_time) | |
1294 Lisp_Object specified_time; | |
1295 { | |
1296 time_t sec; | |
1297 int usec; | |
1298 | |
1299 if (! lisp_time_argument (specified_time, &sec, &usec)) | |
1300 error ("Invalid time specification"); | |
1301 | |
1302 return make_float (sec + usec * 0.0000001); | |
1303 } | |
1304 | |
23213
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1305 /* Write information into buffer S of size MAXSIZE, according to the |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1306 FORMAT of length FORMAT_LEN, using time information taken from *TP. |
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
parents:
26058
diff
changeset
|
1307 Default to Universal Time if UT is nonzero, local time otherwise. |
23213
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1308 Return the number of bytes written, not including the terminating |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1309 '\0'. If S is NULL, nothing will be written anywhere; so to |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1310 determine how many bytes would be written, use NULL for S and |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1311 ((size_t) -1) for MAXSIZE. |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1312 |
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
parents:
26058
diff
changeset
|
1313 This function behaves like emacs_strftimeu, except it allows null |
23213
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1314 bytes in FORMAT. */ |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1315 static size_t |
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
parents:
26058
diff
changeset
|
1316 emacs_memftimeu (s, maxsize, format, format_len, tp, ut) |
23213
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1317 char *s; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1318 size_t maxsize; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1319 const char *format; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1320 size_t format_len; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1321 const struct tm *tp; |
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
parents:
26058
diff
changeset
|
1322 int ut; |
23213
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1323 { |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1324 size_t total = 0; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1325 |
23218
90e5d916ebd9
Add a comment to emacs_memftime, explaining why it needs to loop.
Paul Eggert <eggert@twinsun.com>
parents:
23213
diff
changeset
|
1326 /* Loop through all the null-terminated strings in the format |
90e5d916ebd9
Add a comment to emacs_memftime, explaining why it needs to loop.
Paul Eggert <eggert@twinsun.com>
parents:
23213
diff
changeset
|
1327 argument. Normally there's just one null-terminated string, but |
90e5d916ebd9
Add a comment to emacs_memftime, explaining why it needs to loop.
Paul Eggert <eggert@twinsun.com>
parents:
23213
diff
changeset
|
1328 there can be arbitrarily many, concatenated together, if the |
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
parents:
26058
diff
changeset
|
1329 format contains '\0' bytes. emacs_strftimeu stops at the first |
23218
90e5d916ebd9
Add a comment to emacs_memftime, explaining why it needs to loop.
Paul Eggert <eggert@twinsun.com>
parents:
23213
diff
changeset
|
1330 '\0' byte so we must invoke it separately for each such string. */ |
23213
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1331 for (;;) |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1332 { |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1333 size_t len; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1334 size_t result; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1335 |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1336 if (s) |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1337 s[0] = '\1'; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1338 |
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
parents:
26058
diff
changeset
|
1339 result = emacs_strftimeu (s, maxsize, format, tp, ut); |
23213
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1340 |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1341 if (s) |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1342 { |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1343 if (result == 0 && s[0] != '\0') |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1344 return 0; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1345 s += result + 1; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1346 } |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1347 |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1348 maxsize -= result + 1; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1349 total += result; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1350 len = strlen (format); |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1351 if (len == format_len) |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1352 return total; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1353 total++; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1354 format += len + 1; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1355 format_len -= len + 1; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1356 } |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1357 } |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1358 |
18511
92e9fb8b88f4
(Fformat_time_string): Move doc string outside DEFUN.
Richard M. Stallman <rms@gnu.org>
parents:
18315
diff
changeset
|
1359 /* |
17907
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1360 DEFUN ("format-time-string", Fformat_time_string, Sformat_time_string, 1, 3, 0, |
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1361 "Use FORMAT-STRING to format the time TIME, or now if omitted.\n\ |
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1362 TIME is specified as (HIGH LOW . IGNORED) or (HIGH . LOW), as returned by\n\ |
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1363 `current-time' or `file-attributes'.\n\ |
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1364 The third, optional, argument UNIVERSAL, if non-nil, means describe TIME\n\ |
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1365 as Universal Time; nil means describe TIME in the local time zone.\n\ |
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1366 The value is a copy of FORMAT-STRING, but with certain constructs replaced\n\ |
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1367 by text that describes the specified date and time in TIME:\n\ |
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1368 \n\ |
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1369 %Y is the year, %y within the century, %C the century.\n\ |
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1370 %G is the year corresponding to the ISO week, %g within the century.\n\ |
20338
d55ca55974a0
(emacs_strftime): New decl.
Paul Eggert <eggert@twinsun.com>
parents:
20311
diff
changeset
|
1371 %m is the numeric month.\n\ |
d55ca55974a0
(emacs_strftime): New decl.
Paul Eggert <eggert@twinsun.com>
parents:
20311
diff
changeset
|
1372 %b and %h are the locale's abbreviated month name, %B the full name.\n\ |
17907
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1373 %d is the day of the month, zero-padded, %e is blank-padded.\n\ |
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1374 %u is the numeric day of week from 1 (Monday) to 7, %w from 0 (Sunday) to 6.\n\ |
20338
d55ca55974a0
(emacs_strftime): New decl.
Paul Eggert <eggert@twinsun.com>
parents:
20311
diff
changeset
|
1375 %a is the locale's abbreviated name of the day of week, %A the full name.\n\ |
17907
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1376 %U is the week number starting on Sunday, %W starting on Monday,\n\ |
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1377 %V according to ISO 8601.\n\ |
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1378 %j is the day of the year.\n\ |
9154
b4739bcefc44
(Fformat_time_string): Mostly rewritten, to handle
Richard M. Stallman <rms@gnu.org>
parents:
8981
diff
changeset
|
1379 \n\ |
17907
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1380 %H is the hour on a 24-hour clock, %I is on a 12-hour clock, %k is like %H\n\ |
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1381 only blank-padded, %l is like %I blank-padded.\n\ |
20338
d55ca55974a0
(emacs_strftime): New decl.
Paul Eggert <eggert@twinsun.com>
parents:
20311
diff
changeset
|
1382 %p is the locale's equivalent of either AM or PM.\n\ |
17907
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1383 %M is the minute.\n\ |
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1384 %S is the second.\n\ |
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1385 %Z is the time zone name, %z is the numeric form.\n\ |
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1386 %s is the number of seconds since 1970-01-01 00:00:00 +0000.\n\ |
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1387 \n\ |
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1388 %c is the locale's date and time format.\n\ |
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1389 %x is the locale's \"preferred\" date format.\n\ |
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1390 %D is like \"%m/%d/%y\".\n\ |
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1391 \n\ |
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1392 %R is like \"%H:%M\", %T is like \"%H:%M:%S\", %r is like \"%I:%M:%S %p\".\n\ |
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1393 %X is the locale's \"preferred\" time format.\n\ |
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1394 \n\ |
20338
d55ca55974a0
(emacs_strftime): New decl.
Paul Eggert <eggert@twinsun.com>
parents:
20311
diff
changeset
|
1395 Finally, %n is a newline, %t is a tab, %% is a literal %.\n\ |
17907
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1396 \n\ |
18511
92e9fb8b88f4
(Fformat_time_string): Move doc string outside DEFUN.
Richard M. Stallman <rms@gnu.org>
parents:
18315
diff
changeset
|
1397 Certain flags and modifiers are available with some format controls.\n\ |
17907
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1398 The flags are `_' and `-'. For certain characters X, %_X is like %X,\n\ |
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1399 but padded with blanks; %-X is like %X, but without padding.\n\ |
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1400 %NX (where N stands for an integer) is like %X,\n\ |
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1401 but takes up at least N (a number) positions.\n\ |
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1402 The modifiers are `E' and `O'. For certain characters X,\n\ |
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1403 %EX is a locale's alternative version of %X;\n\ |
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1404 %OX is like %X, but uses the locale's number symbols.\n\ |
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1405 \n\ |
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1406 For example, to produce full ISO 8601 format, use \"%Y-%m-%dT%T%z\".") |
20023
b89c59bccc68
Repeat the argument list of format-time-string in the
Karl Heuer <kwzh@gnu.org>
parents:
19441
diff
changeset
|
1407 (format_string, time, universal) |
18511
92e9fb8b88f4
(Fformat_time_string): Move doc string outside DEFUN.
Richard M. Stallman <rms@gnu.org>
parents:
18315
diff
changeset
|
1408 */ |
92e9fb8b88f4
(Fformat_time_string): Move doc string outside DEFUN.
Richard M. Stallman <rms@gnu.org>
parents:
18315
diff
changeset
|
1409 |
92e9fb8b88f4
(Fformat_time_string): Move doc string outside DEFUN.
Richard M. Stallman <rms@gnu.org>
parents:
18315
diff
changeset
|
1410 DEFUN ("format-time-string", Fformat_time_string, Sformat_time_string, 1, 3, 0, |
92e9fb8b88f4
(Fformat_time_string): Move doc string outside DEFUN.
Richard M. Stallman <rms@gnu.org>
parents:
18315
diff
changeset
|
1411 0 /* See immediately above */) |
17907
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1412 (format_string, time, universal) |
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1413 Lisp_Object format_string, time, universal; |
9154
b4739bcefc44
(Fformat_time_string): Mostly rewritten, to handle
Richard M. Stallman <rms@gnu.org>
parents:
8981
diff
changeset
|
1414 { |
b4739bcefc44
(Fformat_time_string): Mostly rewritten, to handle
Richard M. Stallman <rms@gnu.org>
parents:
8981
diff
changeset
|
1415 time_t value; |
b4739bcefc44
(Fformat_time_string): Mostly rewritten, to handle
Richard M. Stallman <rms@gnu.org>
parents:
8981
diff
changeset
|
1416 int size; |
23198
dddce768cf7a
(Fformat_time_string, Fdecode_time, Fcurrent_time_zone):
Paul Eggert <eggert@twinsun.com>
parents:
23197
diff
changeset
|
1417 struct tm *tm; |
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
parents:
26058
diff
changeset
|
1418 int ut = ! NILP (universal); |
9154
b4739bcefc44
(Fformat_time_string): Mostly rewritten, to handle
Richard M. Stallman <rms@gnu.org>
parents:
8981
diff
changeset
|
1419 |
b4739bcefc44
(Fformat_time_string): Mostly rewritten, to handle
Richard M. Stallman <rms@gnu.org>
parents:
8981
diff
changeset
|
1420 CHECK_STRING (format_string, 1); |
b4739bcefc44
(Fformat_time_string): Mostly rewritten, to handle
Richard M. Stallman <rms@gnu.org>
parents:
8981
diff
changeset
|
1421 |
30480 | 1422 if (! lisp_time_argument (time, &value, NULL)) |
9154
b4739bcefc44
(Fformat_time_string): Mostly rewritten, to handle
Richard M. Stallman <rms@gnu.org>
parents:
8981
diff
changeset
|
1423 error ("Invalid time specification"); |
b4739bcefc44
(Fformat_time_string): Mostly rewritten, to handle
Richard M. Stallman <rms@gnu.org>
parents:
8981
diff
changeset
|
1424 |
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
parents:
26058
diff
changeset
|
1425 format_string = code_convert_string_norecord (format_string, |
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
parents:
26058
diff
changeset
|
1426 Vlocale_coding_system, 1); |
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
parents:
26058
diff
changeset
|
1427 |
9154
b4739bcefc44
(Fformat_time_string): Mostly rewritten, to handle
Richard M. Stallman <rms@gnu.org>
parents:
8981
diff
changeset
|
1428 /* This is probably enough. */ |
21245
6cde55b7c9de
Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents:
21235
diff
changeset
|
1429 size = STRING_BYTES (XSTRING (format_string)) * 6 + 50; |
9154
b4739bcefc44
(Fformat_time_string): Mostly rewritten, to handle
Richard M. Stallman <rms@gnu.org>
parents:
8981
diff
changeset
|
1430 |
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
parents:
26058
diff
changeset
|
1431 tm = ut ? gmtime (&value) : localtime (&value); |
23198
dddce768cf7a
(Fformat_time_string, Fdecode_time, Fcurrent_time_zone):
Paul Eggert <eggert@twinsun.com>
parents:
23197
diff
changeset
|
1432 if (! tm) |
dddce768cf7a
(Fformat_time_string, Fdecode_time, Fcurrent_time_zone):
Paul Eggert <eggert@twinsun.com>
parents:
23197
diff
changeset
|
1433 error ("Specified time is not representable"); |
dddce768cf7a
(Fformat_time_string, Fdecode_time, Fcurrent_time_zone):
Paul Eggert <eggert@twinsun.com>
parents:
23197
diff
changeset
|
1434 |
26526
b7438760079b
* callproc.c (strerror): Remove decl.
Paul Eggert <eggert@twinsun.com>
parents:
26415
diff
changeset
|
1435 synchronize_system_time_locale (); |
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
parents:
26058
diff
changeset
|
1436 |
9154
b4739bcefc44
(Fformat_time_string): Mostly rewritten, to handle
Richard M. Stallman <rms@gnu.org>
parents:
8981
diff
changeset
|
1437 while (1) |
b4739bcefc44
(Fformat_time_string): Mostly rewritten, to handle
Richard M. Stallman <rms@gnu.org>
parents:
8981
diff
changeset
|
1438 { |
17907
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1439 char *buf = (char *) alloca (size + 1); |
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1440 int result; |
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1441 |
19032
84ae0a03a643
(Fformat_time_string): Don't hang if strftime produces
Richard M. Stallman <rms@gnu.org>
parents:
18937
diff
changeset
|
1442 buf[0] = '\1'; |
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
parents:
26058
diff
changeset
|
1443 result = emacs_memftimeu (buf, size, XSTRING (format_string)->data, |
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
parents:
26058
diff
changeset
|
1444 STRING_BYTES (XSTRING (format_string)), |
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
parents:
26058
diff
changeset
|
1445 tm, ut); |
19032
84ae0a03a643
(Fformat_time_string): Don't hang if strftime produces
Richard M. Stallman <rms@gnu.org>
parents:
18937
diff
changeset
|
1446 if ((result > 0 && result < size) || (result == 0 && buf[0] == '\0')) |
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
parents:
26058
diff
changeset
|
1447 return code_convert_string_norecord (make_string (buf, result), |
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
parents:
26058
diff
changeset
|
1448 Vlocale_coding_system, 0); |
17907
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1449 |
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1450 /* If buffer was too small, make it bigger and try again. */ |
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
parents:
26058
diff
changeset
|
1451 result = emacs_memftimeu (NULL, (size_t) -1, |
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
parents:
26058
diff
changeset
|
1452 XSTRING (format_string)->data, |
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
parents:
26058
diff
changeset
|
1453 STRING_BYTES (XSTRING (format_string)), |
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
parents:
26058
diff
changeset
|
1454 tm, ut); |
17907
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1455 size = result + 1; |
9154
b4739bcefc44
(Fformat_time_string): Mostly rewritten, to handle
Richard M. Stallman <rms@gnu.org>
parents:
8981
diff
changeset
|
1456 } |
b4739bcefc44
(Fformat_time_string): Mostly rewritten, to handle
Richard M. Stallman <rms@gnu.org>
parents:
8981
diff
changeset
|
1457 } |
b4739bcefc44
(Fformat_time_string): Mostly rewritten, to handle
Richard M. Stallman <rms@gnu.org>
parents:
8981
diff
changeset
|
1458 |
9801
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
1459 DEFUN ("decode-time", Fdecode_time, Sdecode_time, 0, 1, 0, |
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
1460 "Decode a time value as (SEC MINUTE HOUR DAY MONTH YEAR DOW DST ZONE).\n\ |
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
1461 The optional SPECIFIED-TIME should be a list of (HIGH LOW . IGNORED)\n\ |
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
1462 or (HIGH . LOW), as from `current-time' and `file-attributes', or `nil'\n\ |
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
1463 to use the current time. The list has the following nine members:\n\ |
13013
2511f0ccd986
(Fdecode_time): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
12982
diff
changeset
|
1464 SEC is an integer between 0 and 60; SEC is 60 for a leap second, which\n\ |
2511f0ccd986
(Fdecode_time): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
12982
diff
changeset
|
1465 only some operating systems support. MINUTE is an integer between 0 and 59.\n\ |
9801
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
1466 HOUR is an integer between 0 and 23. DAY is an integer between 1 and 31.\n\ |
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
1467 MONTH is an integer between 1 and 12. YEAR is an integer indicating the\n\ |
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
1468 four-digit year. DOW is the day of week, an integer between 0 and 6, where\n\ |
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
1469 0 is Sunday. DST is t if daylight savings time is effect, otherwise nil.\n\ |
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
1470 ZONE is an integer indicating the number of seconds east of Greenwich.\n\ |
12973
2c0225a5aa91
(Fdecode_time): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
12958
diff
changeset
|
1471 \(Note that Common Lisp has different meanings for DOW and ZONE.)") |
9801
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
1472 (specified_time) |
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
1473 Lisp_Object specified_time; |
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
1474 { |
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
1475 time_t time_spec; |
9812
bc352c8f079c
(Fdecode_time): Fix Lisp_Object vs. integer problems.
Karl Heuer <kwzh@gnu.org>
parents:
9809
diff
changeset
|
1476 struct tm save_tm; |
9801
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
1477 struct tm *decoded_time; |
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
1478 Lisp_Object list_args[9]; |
30480 | 1479 |
1480 if (! lisp_time_argument (specified_time, &time_spec, NULL)) | |
9801
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
1481 error ("Invalid time specification"); |
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
1482 |
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
1483 decoded_time = localtime (&time_spec); |
23198
dddce768cf7a
(Fformat_time_string, Fdecode_time, Fcurrent_time_zone):
Paul Eggert <eggert@twinsun.com>
parents:
23197
diff
changeset
|
1484 if (! decoded_time) |
dddce768cf7a
(Fformat_time_string, Fdecode_time, Fcurrent_time_zone):
Paul Eggert <eggert@twinsun.com>
parents:
23197
diff
changeset
|
1485 error ("Specified time is not representable"); |
9812
bc352c8f079c
(Fdecode_time): Fix Lisp_Object vs. integer problems.
Karl Heuer <kwzh@gnu.org>
parents:
9809
diff
changeset
|
1486 XSETFASTINT (list_args[0], decoded_time->tm_sec); |
bc352c8f079c
(Fdecode_time): Fix Lisp_Object vs. integer problems.
Karl Heuer <kwzh@gnu.org>
parents:
9809
diff
changeset
|
1487 XSETFASTINT (list_args[1], decoded_time->tm_min); |
bc352c8f079c
(Fdecode_time): Fix Lisp_Object vs. integer problems.
Karl Heuer <kwzh@gnu.org>
parents:
9809
diff
changeset
|
1488 XSETFASTINT (list_args[2], decoded_time->tm_hour); |
bc352c8f079c
(Fdecode_time): Fix Lisp_Object vs. integer problems.
Karl Heuer <kwzh@gnu.org>
parents:
9809
diff
changeset
|
1489 XSETFASTINT (list_args[3], decoded_time->tm_mday); |
bc352c8f079c
(Fdecode_time): Fix Lisp_Object vs. integer problems.
Karl Heuer <kwzh@gnu.org>
parents:
9809
diff
changeset
|
1490 XSETFASTINT (list_args[4], decoded_time->tm_mon + 1); |
15757
5ddb082ffebb
(Fdecode_time, difftm): Work even if tm_year represents
Richard M. Stallman <rms@gnu.org>
parents:
15334
diff
changeset
|
1491 XSETINT (list_args[5], decoded_time->tm_year + 1900); |
9812
bc352c8f079c
(Fdecode_time): Fix Lisp_Object vs. integer problems.
Karl Heuer <kwzh@gnu.org>
parents:
9809
diff
changeset
|
1492 XSETFASTINT (list_args[6], decoded_time->tm_wday); |
9801
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
1493 list_args[7] = (decoded_time->tm_isdst)? Qt : Qnil; |
9812
bc352c8f079c
(Fdecode_time): Fix Lisp_Object vs. integer problems.
Karl Heuer <kwzh@gnu.org>
parents:
9809
diff
changeset
|
1494 |
bc352c8f079c
(Fdecode_time): Fix Lisp_Object vs. integer problems.
Karl Heuer <kwzh@gnu.org>
parents:
9809
diff
changeset
|
1495 /* Make a copy, in case gmtime modifies the struct. */ |
bc352c8f079c
(Fdecode_time): Fix Lisp_Object vs. integer problems.
Karl Heuer <kwzh@gnu.org>
parents:
9809
diff
changeset
|
1496 save_tm = *decoded_time; |
bc352c8f079c
(Fdecode_time): Fix Lisp_Object vs. integer problems.
Karl Heuer <kwzh@gnu.org>
parents:
9809
diff
changeset
|
1497 decoded_time = gmtime (&time_spec); |
bc352c8f079c
(Fdecode_time): Fix Lisp_Object vs. integer problems.
Karl Heuer <kwzh@gnu.org>
parents:
9809
diff
changeset
|
1498 if (decoded_time == 0) |
bc352c8f079c
(Fdecode_time): Fix Lisp_Object vs. integer problems.
Karl Heuer <kwzh@gnu.org>
parents:
9809
diff
changeset
|
1499 list_args[8] = Qnil; |
bc352c8f079c
(Fdecode_time): Fix Lisp_Object vs. integer problems.
Karl Heuer <kwzh@gnu.org>
parents:
9809
diff
changeset
|
1500 else |
16269
79e6c47054c5
(tm_diff): Renamed from difftm. Yield int, not long.
Paul Eggert <eggert@twinsun.com>
parents:
16134
diff
changeset
|
1501 XSETINT (list_args[8], tm_diff (&save_tm, decoded_time)); |
9801
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
1502 return Flist (9, list_args); |
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
1503 } |
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
1504 |
15180
9a22c72359c1
(Fencode_time): Accept MANY args, so as to cope
Richard M. Stallman <rms@gnu.org>
parents:
15075
diff
changeset
|
1505 DEFUN ("encode-time", Fencode_time, Sencode_time, 6, MANY, 0, |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
1506 "Convert SECOND, MINUTE, HOUR, DAY, MONTH, YEAR and ZONE to internal time.\n\ |
15180
9a22c72359c1
(Fencode_time): Accept MANY args, so as to cope
Richard M. Stallman <rms@gnu.org>
parents:
15075
diff
changeset
|
1507 This is the reverse operation of `decode-time', which see.\n\ |
9a22c72359c1
(Fencode_time): Accept MANY args, so as to cope
Richard M. Stallman <rms@gnu.org>
parents:
15075
diff
changeset
|
1508 ZONE defaults to the current time zone rule. This can\n\ |
15910
8cd4f2fd5525
(Fencode_time, Fset_time_zone_rule): Use UTC if the zone is t.
Erik Naggum <erik@naggum.no>
parents:
15841
diff
changeset
|
1509 be a string or t (as from `set-time-zone-rule'), or it can be a list\n\ |
16526
f34bfb5aa684
(Fencode_time): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
16521
diff
changeset
|
1510 \(as from `current-time-zone') or an integer (as from `decode-time')\n\ |
13025
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1511 applied without consideration for daylight savings time.\n\ |
15180
9a22c72359c1
(Fencode_time): Accept MANY args, so as to cope
Richard M. Stallman <rms@gnu.org>
parents:
15075
diff
changeset
|
1512 \n\ |
9a22c72359c1
(Fencode_time): Accept MANY args, so as to cope
Richard M. Stallman <rms@gnu.org>
parents:
15075
diff
changeset
|
1513 You can pass more than 7 arguments; then the first six arguments\n\ |
9a22c72359c1
(Fencode_time): Accept MANY args, so as to cope
Richard M. Stallman <rms@gnu.org>
parents:
15075
diff
changeset
|
1514 are used as SECOND through YEAR, and the *last* argument is used as ZONE.\n\ |
9a22c72359c1
(Fencode_time): Accept MANY args, so as to cope
Richard M. Stallman <rms@gnu.org>
parents:
15075
diff
changeset
|
1515 The intervening arguments are ignored.\n\ |
9a22c72359c1
(Fencode_time): Accept MANY args, so as to cope
Richard M. Stallman <rms@gnu.org>
parents:
15075
diff
changeset
|
1516 This feature lets (apply 'encode-time (decode-time ...)) work.\n\ |
9a22c72359c1
(Fencode_time): Accept MANY args, so as to cope
Richard M. Stallman <rms@gnu.org>
parents:
15075
diff
changeset
|
1517 \n\ |
13025
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1518 Out-of-range values for SEC, MINUTE, HOUR, DAY, or MONTH are allowed;\n\ |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1519 for example, a DAY of 0 means the day preceding the given month.\n\ |
11476
7917226c3ea9
(Fencode_time): Don't treat years < 100 as special.
Richard M. Stallman <rms@gnu.org>
parents:
11468
diff
changeset
|
1520 Year numbers less than 100 are treated just like other year numbers.\n\ |
13025
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1521 If you want them to stand for years in this century, you must do that yourself.") |
15180
9a22c72359c1
(Fencode_time): Accept MANY args, so as to cope
Richard M. Stallman <rms@gnu.org>
parents:
15075
diff
changeset
|
1522 (nargs, args) |
9a22c72359c1
(Fencode_time): Accept MANY args, so as to cope
Richard M. Stallman <rms@gnu.org>
parents:
15075
diff
changeset
|
1523 int nargs; |
9a22c72359c1
(Fencode_time): Accept MANY args, so as to cope
Richard M. Stallman <rms@gnu.org>
parents:
15075
diff
changeset
|
1524 register Lisp_Object *args; |
11402
66d935214d8e
(Fencode_time): Use XINT to examine `zone'.
Richard M. Stallman <rms@gnu.org>
parents:
11263
diff
changeset
|
1525 { |
11468
772f49d1969d
(Fencode_time): Rewrite by Naggum.
Richard M. Stallman <rms@gnu.org>
parents:
11451
diff
changeset
|
1526 time_t time; |
13025
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1527 struct tm tm; |
16874 | 1528 Lisp_Object zone = (nargs > 6 ? args[nargs - 1] : Qnil); |
11402
66d935214d8e
(Fencode_time): Use XINT to examine `zone'.
Richard M. Stallman <rms@gnu.org>
parents:
11263
diff
changeset
|
1529 |
15180
9a22c72359c1
(Fencode_time): Accept MANY args, so as to cope
Richard M. Stallman <rms@gnu.org>
parents:
15075
diff
changeset
|
1530 CHECK_NUMBER (args[0], 0); /* second */ |
9a22c72359c1
(Fencode_time): Accept MANY args, so as to cope
Richard M. Stallman <rms@gnu.org>
parents:
15075
diff
changeset
|
1531 CHECK_NUMBER (args[1], 1); /* minute */ |
9a22c72359c1
(Fencode_time): Accept MANY args, so as to cope
Richard M. Stallman <rms@gnu.org>
parents:
15075
diff
changeset
|
1532 CHECK_NUMBER (args[2], 2); /* hour */ |
9a22c72359c1
(Fencode_time): Accept MANY args, so as to cope
Richard M. Stallman <rms@gnu.org>
parents:
15075
diff
changeset
|
1533 CHECK_NUMBER (args[3], 3); /* day */ |
9a22c72359c1
(Fencode_time): Accept MANY args, so as to cope
Richard M. Stallman <rms@gnu.org>
parents:
15075
diff
changeset
|
1534 CHECK_NUMBER (args[4], 4); /* month */ |
9a22c72359c1
(Fencode_time): Accept MANY args, so as to cope
Richard M. Stallman <rms@gnu.org>
parents:
15075
diff
changeset
|
1535 CHECK_NUMBER (args[5], 5); /* year */ |
11468
772f49d1969d
(Fencode_time): Rewrite by Naggum.
Richard M. Stallman <rms@gnu.org>
parents:
11451
diff
changeset
|
1536 |
15180
9a22c72359c1
(Fencode_time): Accept MANY args, so as to cope
Richard M. Stallman <rms@gnu.org>
parents:
15075
diff
changeset
|
1537 tm.tm_sec = XINT (args[0]); |
9a22c72359c1
(Fencode_time): Accept MANY args, so as to cope
Richard M. Stallman <rms@gnu.org>
parents:
15075
diff
changeset
|
1538 tm.tm_min = XINT (args[1]); |
9a22c72359c1
(Fencode_time): Accept MANY args, so as to cope
Richard M. Stallman <rms@gnu.org>
parents:
15075
diff
changeset
|
1539 tm.tm_hour = XINT (args[2]); |
9a22c72359c1
(Fencode_time): Accept MANY args, so as to cope
Richard M. Stallman <rms@gnu.org>
parents:
15075
diff
changeset
|
1540 tm.tm_mday = XINT (args[3]); |
9a22c72359c1
(Fencode_time): Accept MANY args, so as to cope
Richard M. Stallman <rms@gnu.org>
parents:
15075
diff
changeset
|
1541 tm.tm_mon = XINT (args[4]) - 1; |
9a22c72359c1
(Fencode_time): Accept MANY args, so as to cope
Richard M. Stallman <rms@gnu.org>
parents:
15075
diff
changeset
|
1542 tm.tm_year = XINT (args[5]) - 1900; |
13025
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1543 tm.tm_isdst = -1; |
11468
772f49d1969d
(Fencode_time): Rewrite by Naggum.
Richard M. Stallman <rms@gnu.org>
parents:
11451
diff
changeset
|
1544 |
13025
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1545 if (CONSP (zone)) |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1546 zone = Fcar (zone); |
11468
772f49d1969d
(Fencode_time): Rewrite by Naggum.
Richard M. Stallman <rms@gnu.org>
parents:
11451
diff
changeset
|
1547 if (NILP (zone)) |
13025
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1548 time = mktime (&tm); |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1549 else |
11468
772f49d1969d
(Fencode_time): Rewrite by Naggum.
Richard M. Stallman <rms@gnu.org>
parents:
11451
diff
changeset
|
1550 { |
13025
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1551 char tzbuf[100]; |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1552 char *tzstring; |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1553 char **oldenv = environ, **newenv; |
30480 | 1554 |
18613
614b916ff5bf
Fix bugs with inappropriate mixing of Lisp_Object with int.
Richard M. Stallman <rms@gnu.org>
parents:
18605
diff
changeset
|
1555 if (EQ (zone, Qt)) |
15910
8cd4f2fd5525
(Fencode_time, Fset_time_zone_rule): Use UTC if the zone is t.
Erik Naggum <erik@naggum.no>
parents:
15841
diff
changeset
|
1556 tzstring = "UTC0"; |
8cd4f2fd5525
(Fencode_time, Fset_time_zone_rule): Use UTC if the zone is t.
Erik Naggum <erik@naggum.no>
parents:
15841
diff
changeset
|
1557 else if (STRINGP (zone)) |
13347
186d80572f4f
(Fencode_time): Add cast.
Richard M. Stallman <rms@gnu.org>
parents:
13238
diff
changeset
|
1558 tzstring = (char *) XSTRING (zone)->data; |
13025
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1559 else if (INTEGERP (zone)) |
11468
772f49d1969d
(Fencode_time): Rewrite by Naggum.
Richard M. Stallman <rms@gnu.org>
parents:
11451
diff
changeset
|
1560 { |
13025
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1561 int abszone = abs (XINT (zone)); |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1562 sprintf (tzbuf, "XXX%s%d:%02d:%02d", "-" + (XINT (zone) < 0), |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1563 abszone / (60*60), (abszone/60) % 60, abszone % 60); |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1564 tzstring = tzbuf; |
11468
772f49d1969d
(Fencode_time): Rewrite by Naggum.
Richard M. Stallman <rms@gnu.org>
parents:
11451
diff
changeset
|
1565 } |
13025
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1566 else |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1567 error ("Invalid time zone specification"); |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1568 |
30480 | 1569 /* Set TZ before calling mktime; merely adjusting mktime's returned |
13025
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1570 value doesn't suffice, since that would mishandle leap seconds. */ |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1571 set_time_zone_rule (tzstring); |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1572 |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1573 time = mktime (&tm); |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1574 |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1575 /* Restore TZ to previous value. */ |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1576 newenv = environ; |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1577 environ = oldenv; |
16521
fe9cc0d392dd
(Fencode_time): Use xfree, not free.
Richard M. Stallman <rms@gnu.org>
parents:
16485
diff
changeset
|
1578 xfree (newenv); |
13025
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1579 #ifdef LOCALTIME_CACHE |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1580 tzset (); |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1581 #endif |
11468
772f49d1969d
(Fencode_time): Rewrite by Naggum.
Richard M. Stallman <rms@gnu.org>
parents:
11451
diff
changeset
|
1582 } |
11402
66d935214d8e
(Fencode_time): Use XINT to examine `zone'.
Richard M. Stallman <rms@gnu.org>
parents:
11263
diff
changeset
|
1583 |
13025
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1584 if (time == (time_t) -1) |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1585 error ("Specified time is not representable"); |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1586 |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1587 return make_time (time); |
11402
66d935214d8e
(Fencode_time): Use XINT to examine `zone'.
Richard M. Stallman <rms@gnu.org>
parents:
11263
diff
changeset
|
1588 } |
66d935214d8e
(Fencode_time): Use XINT to examine `zone'.
Richard M. Stallman <rms@gnu.org>
parents:
11263
diff
changeset
|
1589 |
2154
69c58e548ca5
(Fcurrent_time_string): Optional arg specifies time.
Richard M. Stallman <rms@gnu.org>
parents:
2049
diff
changeset
|
1590 DEFUN ("current-time-string", Fcurrent_time_string, Scurrent_time_string, 0, 1, 0, |
305 | 1591 "Return the current time, as a human-readable string.\n\ |
2154
69c58e548ca5
(Fcurrent_time_string): Optional arg specifies time.
Richard M. Stallman <rms@gnu.org>
parents:
2049
diff
changeset
|
1592 Programs can use this function to decode a time,\n\ |
69c58e548ca5
(Fcurrent_time_string): Optional arg specifies time.
Richard M. Stallman <rms@gnu.org>
parents:
2049
diff
changeset
|
1593 since the number of columns in each field is fixed.\n\ |
69c58e548ca5
(Fcurrent_time_string): Optional arg specifies time.
Richard M. Stallman <rms@gnu.org>
parents:
2049
diff
changeset
|
1594 The format is `Sun Sep 16 01:03:52 1973'.\n\ |
18031
9567ae426b73
(Fcurrent_time_string): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
18007
diff
changeset
|
1595 However, see also the functions `decode-time' and `format-time-string'\n\ |
9567ae426b73
(Fcurrent_time_string): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
18007
diff
changeset
|
1596 which provide a much more powerful and general facility.\n\ |
9567ae426b73
(Fcurrent_time_string): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
18007
diff
changeset
|
1597 \n\ |
2154
69c58e548ca5
(Fcurrent_time_string): Optional arg specifies time.
Richard M. Stallman <rms@gnu.org>
parents:
2049
diff
changeset
|
1598 If an argument is given, it specifies a time to format\n\ |
69c58e548ca5
(Fcurrent_time_string): Optional arg specifies time.
Richard M. Stallman <rms@gnu.org>
parents:
2049
diff
changeset
|
1599 instead of the current time. The argument should have the form:\n\ |
69c58e548ca5
(Fcurrent_time_string): Optional arg specifies time.
Richard M. Stallman <rms@gnu.org>
parents:
2049
diff
changeset
|
1600 (HIGH . LOW)\n\ |
69c58e548ca5
(Fcurrent_time_string): Optional arg specifies time.
Richard M. Stallman <rms@gnu.org>
parents:
2049
diff
changeset
|
1601 or the form:\n\ |
69c58e548ca5
(Fcurrent_time_string): Optional arg specifies time.
Richard M. Stallman <rms@gnu.org>
parents:
2049
diff
changeset
|
1602 (HIGH LOW . IGNORED).\n\ |
69c58e548ca5
(Fcurrent_time_string): Optional arg specifies time.
Richard M. Stallman <rms@gnu.org>
parents:
2049
diff
changeset
|
1603 Thus, you can use times obtained from `current-time'\n\ |
69c58e548ca5
(Fcurrent_time_string): Optional arg specifies time.
Richard M. Stallman <rms@gnu.org>
parents:
2049
diff
changeset
|
1604 and from `file-attributes'.") |
69c58e548ca5
(Fcurrent_time_string): Optional arg specifies time.
Richard M. Stallman <rms@gnu.org>
parents:
2049
diff
changeset
|
1605 (specified_time) |
69c58e548ca5
(Fcurrent_time_string): Optional arg specifies time.
Richard M. Stallman <rms@gnu.org>
parents:
2049
diff
changeset
|
1606 Lisp_Object specified_time; |
305 | 1607 { |
2921
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1608 time_t value; |
305 | 1609 char buf[30]; |
2154
69c58e548ca5
(Fcurrent_time_string): Optional arg specifies time.
Richard M. Stallman <rms@gnu.org>
parents:
2049
diff
changeset
|
1610 register char *tem; |
69c58e548ca5
(Fcurrent_time_string): Optional arg specifies time.
Richard M. Stallman <rms@gnu.org>
parents:
2049
diff
changeset
|
1611 |
30480 | 1612 if (! lisp_time_argument (specified_time, &value, NULL)) |
2921
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1613 value = -1; |
2154
69c58e548ca5
(Fcurrent_time_string): Optional arg specifies time.
Richard M. Stallman <rms@gnu.org>
parents:
2049
diff
changeset
|
1614 tem = (char *) ctime (&value); |
305 | 1615 |
1616 strncpy (buf, tem, 24); | |
1617 buf[24] = 0; | |
1618 | |
1619 return build_string (buf); | |
1620 } | |
962
3533821d6edc
* editfns.c (Fcurrent_time_zone): Doc fix.
Jim Blandy <jimb@redhat.com>
parents:
690
diff
changeset
|
1621 |
16269
79e6c47054c5
(tm_diff): Renamed from difftm. Yield int, not long.
Paul Eggert <eggert@twinsun.com>
parents:
16134
diff
changeset
|
1622 #define TM_YEAR_BASE 1900 |
2921
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1623 |
16269
79e6c47054c5
(tm_diff): Renamed from difftm. Yield int, not long.
Paul Eggert <eggert@twinsun.com>
parents:
16134
diff
changeset
|
1624 /* Yield A - B, measured in seconds. |
79e6c47054c5
(tm_diff): Renamed from difftm. Yield int, not long.
Paul Eggert <eggert@twinsun.com>
parents:
16134
diff
changeset
|
1625 This function is copied from the GNU C Library. */ |
79e6c47054c5
(tm_diff): Renamed from difftm. Yield int, not long.
Paul Eggert <eggert@twinsun.com>
parents:
16134
diff
changeset
|
1626 static int |
79e6c47054c5
(tm_diff): Renamed from difftm. Yield int, not long.
Paul Eggert <eggert@twinsun.com>
parents:
16134
diff
changeset
|
1627 tm_diff (a, b) |
2921
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1628 struct tm *a, *b; |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1629 { |
16269
79e6c47054c5
(tm_diff): Renamed from difftm. Yield int, not long.
Paul Eggert <eggert@twinsun.com>
parents:
16134
diff
changeset
|
1630 /* Compute intervening leap days correctly even if year is negative. |
79e6c47054c5
(tm_diff): Renamed from difftm. Yield int, not long.
Paul Eggert <eggert@twinsun.com>
parents:
16134
diff
changeset
|
1631 Take care to avoid int overflow in leap day calculations, |
79e6c47054c5
(tm_diff): Renamed from difftm. Yield int, not long.
Paul Eggert <eggert@twinsun.com>
parents:
16134
diff
changeset
|
1632 but it's OK to assume that A and B are close to each other. */ |
79e6c47054c5
(tm_diff): Renamed from difftm. Yield int, not long.
Paul Eggert <eggert@twinsun.com>
parents:
16134
diff
changeset
|
1633 int a4 = (a->tm_year >> 2) + (TM_YEAR_BASE >> 2) - ! (a->tm_year & 3); |
79e6c47054c5
(tm_diff): Renamed from difftm. Yield int, not long.
Paul Eggert <eggert@twinsun.com>
parents:
16134
diff
changeset
|
1634 int b4 = (b->tm_year >> 2) + (TM_YEAR_BASE >> 2) - ! (b->tm_year & 3); |
79e6c47054c5
(tm_diff): Renamed from difftm. Yield int, not long.
Paul Eggert <eggert@twinsun.com>
parents:
16134
diff
changeset
|
1635 int a100 = a4 / 25 - (a4 % 25 < 0); |
79e6c47054c5
(tm_diff): Renamed from difftm. Yield int, not long.
Paul Eggert <eggert@twinsun.com>
parents:
16134
diff
changeset
|
1636 int b100 = b4 / 25 - (b4 % 25 < 0); |
79e6c47054c5
(tm_diff): Renamed from difftm. Yield int, not long.
Paul Eggert <eggert@twinsun.com>
parents:
16134
diff
changeset
|
1637 int a400 = a100 >> 2; |
79e6c47054c5
(tm_diff): Renamed from difftm. Yield int, not long.
Paul Eggert <eggert@twinsun.com>
parents:
16134
diff
changeset
|
1638 int b400 = b100 >> 2; |
79e6c47054c5
(tm_diff): Renamed from difftm. Yield int, not long.
Paul Eggert <eggert@twinsun.com>
parents:
16134
diff
changeset
|
1639 int intervening_leap_days = (a4 - b4) - (a100 - b100) + (a400 - b400); |
79e6c47054c5
(tm_diff): Renamed from difftm. Yield int, not long.
Paul Eggert <eggert@twinsun.com>
parents:
16134
diff
changeset
|
1640 int years = a->tm_year - b->tm_year; |
79e6c47054c5
(tm_diff): Renamed from difftm. Yield int, not long.
Paul Eggert <eggert@twinsun.com>
parents:
16134
diff
changeset
|
1641 int days = (365 * years + intervening_leap_days |
79e6c47054c5
(tm_diff): Renamed from difftm. Yield int, not long.
Paul Eggert <eggert@twinsun.com>
parents:
16134
diff
changeset
|
1642 + (a->tm_yday - b->tm_yday)); |
79e6c47054c5
(tm_diff): Renamed from difftm. Yield int, not long.
Paul Eggert <eggert@twinsun.com>
parents:
16134
diff
changeset
|
1643 return (60 * (60 * (24 * days + (a->tm_hour - b->tm_hour)) |
79e6c47054c5
(tm_diff): Renamed from difftm. Yield int, not long.
Paul Eggert <eggert@twinsun.com>
parents:
16134
diff
changeset
|
1644 + (a->tm_min - b->tm_min)) |
5882 | 1645 + (a->tm_sec - b->tm_sec)); |
2921
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1646 } |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1647 |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1648 DEFUN ("current-time-zone", Fcurrent_time_zone, Scurrent_time_zone, 0, 1, 0, |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1649 "Return the offset and name for the local time zone.\n\ |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1650 This returns a list of the form (OFFSET NAME).\n\ |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1651 OFFSET is an integer number of seconds ahead of UTC (east of Greenwich).\n\ |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1652 A negative value means west of Greenwich.\n\ |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1653 NAME is a string giving the name of the time zone.\n\ |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1654 If an argument is given, it specifies when the time zone offset is determined\n\ |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1655 instead of using the current time. The argument should have the form:\n\ |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1656 (HIGH . LOW)\n\ |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1657 or the form:\n\ |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1658 (HIGH LOW . IGNORED).\n\ |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1659 Thus, you can use times obtained from `current-time'\n\ |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1660 and from `file-attributes'.\n\ |
2462
4a7e1c2a2a9e
* editfns.c (Fcurrent_time_zone): Return a list whose elements are
Jim Blandy <jimb@redhat.com>
parents:
2384
diff
changeset
|
1661 \n\ |
4a7e1c2a2a9e
* editfns.c (Fcurrent_time_zone): Return a list whose elements are
Jim Blandy <jimb@redhat.com>
parents:
2384
diff
changeset
|
1662 Some operating systems cannot provide all this information to Emacs;\n\ |
2976
6fe71a039fce
(Fcurrent_time_zone): Assign gmt, instead of init.
Richard M. Stallman <rms@gnu.org>
parents:
2962
diff
changeset
|
1663 in this case, `current-time-zone' returns a list containing nil for\n\ |
2462
4a7e1c2a2a9e
* editfns.c (Fcurrent_time_zone): Return a list whose elements are
Jim Blandy <jimb@redhat.com>
parents:
2384
diff
changeset
|
1664 the data it can't find.") |
2921
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1665 (specified_time) |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1666 Lisp_Object specified_time; |
962
3533821d6edc
* editfns.c (Fcurrent_time_zone): Doc fix.
Jim Blandy <jimb@redhat.com>
parents:
690
diff
changeset
|
1667 { |
2921
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1668 time_t value; |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1669 struct tm *t; |
23198
dddce768cf7a
(Fformat_time_string, Fdecode_time, Fcurrent_time_zone):
Paul Eggert <eggert@twinsun.com>
parents:
23197
diff
changeset
|
1670 struct tm gmt; |
962
3533821d6edc
* editfns.c (Fcurrent_time_zone): Doc fix.
Jim Blandy <jimb@redhat.com>
parents:
690
diff
changeset
|
1671 |
30480 | 1672 if (lisp_time_argument (specified_time, &value, NULL) |
23198
dddce768cf7a
(Fformat_time_string, Fdecode_time, Fcurrent_time_zone):
Paul Eggert <eggert@twinsun.com>
parents:
23197
diff
changeset
|
1673 && (t = gmtime (&value)) != 0 |
dddce768cf7a
(Fformat_time_string, Fdecode_time, Fcurrent_time_zone):
Paul Eggert <eggert@twinsun.com>
parents:
23197
diff
changeset
|
1674 && (gmt = *t, t = localtime (&value)) != 0) |
2921
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1675 { |
23198
dddce768cf7a
(Fformat_time_string, Fdecode_time, Fcurrent_time_zone):
Paul Eggert <eggert@twinsun.com>
parents:
23197
diff
changeset
|
1676 int offset = tm_diff (t, &gmt); |
dddce768cf7a
(Fformat_time_string, Fdecode_time, Fcurrent_time_zone):
Paul Eggert <eggert@twinsun.com>
parents:
23197
diff
changeset
|
1677 char *s = 0; |
dddce768cf7a
(Fformat_time_string, Fdecode_time, Fcurrent_time_zone):
Paul Eggert <eggert@twinsun.com>
parents:
23197
diff
changeset
|
1678 char buf[6]; |
2921
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1679 #ifdef HAVE_TM_ZONE |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1680 if (t->tm_zone) |
7506
9fa47d36798a
(Fcurrent_time_zone): Add cast.
Richard M. Stallman <rms@gnu.org>
parents:
7485
diff
changeset
|
1681 s = (char *)t->tm_zone; |
3522
dc9f7a107e28
(Fcurrent_time_zone): Add alternative for !HAVE_TM_ZONE.
Richard M. Stallman <rms@gnu.org>
parents:
2994
diff
changeset
|
1682 #else /* not HAVE_TM_ZONE */ |
dc9f7a107e28
(Fcurrent_time_zone): Add alternative for !HAVE_TM_ZONE.
Richard M. Stallman <rms@gnu.org>
parents:
2994
diff
changeset
|
1683 #ifdef HAVE_TZNAME |
dc9f7a107e28
(Fcurrent_time_zone): Add alternative for !HAVE_TM_ZONE.
Richard M. Stallman <rms@gnu.org>
parents:
2994
diff
changeset
|
1684 if (t->tm_isdst == 0 || t->tm_isdst == 1) |
dc9f7a107e28
(Fcurrent_time_zone): Add alternative for !HAVE_TM_ZONE.
Richard M. Stallman <rms@gnu.org>
parents:
2994
diff
changeset
|
1685 s = tzname[t->tm_isdst]; |
962
3533821d6edc
* editfns.c (Fcurrent_time_zone): Doc fix.
Jim Blandy <jimb@redhat.com>
parents:
690
diff
changeset
|
1686 #endif |
3522
dc9f7a107e28
(Fcurrent_time_zone): Add alternative for !HAVE_TM_ZONE.
Richard M. Stallman <rms@gnu.org>
parents:
2994
diff
changeset
|
1687 #endif /* not HAVE_TM_ZONE */ |
2921
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1688 if (!s) |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1689 { |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1690 /* No local time zone name is available; use "+-NNNN" instead. */ |
2994
b087b4fd6066
(Fcurrent_time_zone): Make `am' an int, not long.
Richard M. Stallman <rms@gnu.org>
parents:
2976
diff
changeset
|
1691 int am = (offset < 0 ? -offset : offset) / 60; |
2921
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1692 sprintf (buf, "%c%02d%02d", (offset < 0 ? '-' : '+'), am/60, am%60); |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1693 s = buf; |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1694 } |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1695 return Fcons (make_number (offset), Fcons (build_string (s), Qnil)); |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1696 } |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1697 else |
18745
192b3ebd108e
(Fcurrent_time_zone): Convert Fmake_list argument to Lisp_Integer.
Richard M. Stallman <rms@gnu.org>
parents:
18661
diff
changeset
|
1698 return Fmake_list (make_number (2), Qnil); |
962
3533821d6edc
* editfns.c (Fcurrent_time_zone): Doc fix.
Jim Blandy <jimb@redhat.com>
parents:
690
diff
changeset
|
1699 } |
3533821d6edc
* editfns.c (Fcurrent_time_zone): Doc fix.
Jim Blandy <jimb@redhat.com>
parents:
690
diff
changeset
|
1700 |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
1701 /* This holds the value of `environ' produced by the previous |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
1702 call to Fset_time_zone_rule, or 0 if Fset_time_zone_rule |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
1703 has never been called. */ |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
1704 static char **environbuf; |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
1705 |
13019
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1706 DEFUN ("set-time-zone-rule", Fset_time_zone_rule, Sset_time_zone_rule, 1, 1, 0, |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1707 "Set the local time zone using TZ, a string specifying a time zone rule.\n\ |
15910
8cd4f2fd5525
(Fencode_time, Fset_time_zone_rule): Use UTC if the zone is t.
Erik Naggum <erik@naggum.no>
parents:
15841
diff
changeset
|
1708 If TZ is nil, use implementation-defined default time zone information.\n\ |
8cd4f2fd5525
(Fencode_time, Fset_time_zone_rule): Use UTC if the zone is t.
Erik Naggum <erik@naggum.no>
parents:
15841
diff
changeset
|
1709 If TZ is t, use Universal Time.") |
13019
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1710 (tz) |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1711 Lisp_Object tz; |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1712 { |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1713 char *tzstring; |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1714 |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1715 if (NILP (tz)) |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1716 tzstring = 0; |
18613
614b916ff5bf
Fix bugs with inappropriate mixing of Lisp_Object with int.
Richard M. Stallman <rms@gnu.org>
parents:
18605
diff
changeset
|
1717 else if (EQ (tz, Qt)) |
15910
8cd4f2fd5525
(Fencode_time, Fset_time_zone_rule): Use UTC if the zone is t.
Erik Naggum <erik@naggum.no>
parents:
15841
diff
changeset
|
1718 tzstring = "UTC0"; |
13019
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1719 else |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1720 { |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1721 CHECK_STRING (tz, 0); |
13347
186d80572f4f
(Fencode_time): Add cast.
Richard M. Stallman <rms@gnu.org>
parents:
13238
diff
changeset
|
1722 tzstring = (char *) XSTRING (tz)->data; |
13019
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1723 } |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1724 |
13025
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1725 set_time_zone_rule (tzstring); |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1726 if (environbuf) |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1727 free (environbuf); |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1728 environbuf = environ; |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1729 |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1730 return Qnil; |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1731 } |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1732 |
16918
ab49512bcdff
(set_time_zone_rule_tz1, set_time_zone_rule_tz2):
Paul Eggert <eggert@twinsun.com>
parents:
16874
diff
changeset
|
1733 #ifdef LOCALTIME_CACHE |
ab49512bcdff
(set_time_zone_rule_tz1, set_time_zone_rule_tz2):
Paul Eggert <eggert@twinsun.com>
parents:
16874
diff
changeset
|
1734 |
ab49512bcdff
(set_time_zone_rule_tz1, set_time_zone_rule_tz2):
Paul Eggert <eggert@twinsun.com>
parents:
16874
diff
changeset
|
1735 /* These two values are known to load tz files in buggy implementations, |
ab49512bcdff
(set_time_zone_rule_tz1, set_time_zone_rule_tz2):
Paul Eggert <eggert@twinsun.com>
parents:
16874
diff
changeset
|
1736 i.e. Solaris 1 executables running under either Solaris 1 or Solaris 2. |
15841
80a852988718
(set_time_zone_rule): Don't put a string literal
Richard M. Stallman <rms@gnu.org>
parents:
15779
diff
changeset
|
1737 Their values shouldn't matter in non-buggy implementations. |
30480 | 1738 We don't use string literals for these strings, |
15841
80a852988718
(set_time_zone_rule): Don't put a string literal
Richard M. Stallman <rms@gnu.org>
parents:
15779
diff
changeset
|
1739 since if a string in the environment is in readonly |
80a852988718
(set_time_zone_rule): Don't put a string literal
Richard M. Stallman <rms@gnu.org>
parents:
15779
diff
changeset
|
1740 storage, it runs afoul of bugs in SVR4 and Solaris 2.3. |
80a852988718
(set_time_zone_rule): Don't put a string literal
Richard M. Stallman <rms@gnu.org>
parents:
15779
diff
changeset
|
1741 See Sun bugs 1113095 and 1114114, ``Timezone routines |
80a852988718
(set_time_zone_rule): Don't put a string literal
Richard M. Stallman <rms@gnu.org>
parents:
15779
diff
changeset
|
1742 improperly modify environment''. */ |
80a852988718
(set_time_zone_rule): Don't put a string literal
Richard M. Stallman <rms@gnu.org>
parents:
15779
diff
changeset
|
1743 |
16918
ab49512bcdff
(set_time_zone_rule_tz1, set_time_zone_rule_tz2):
Paul Eggert <eggert@twinsun.com>
parents:
16874
diff
changeset
|
1744 static char set_time_zone_rule_tz1[] = "TZ=GMT+0"; |
ab49512bcdff
(set_time_zone_rule_tz1, set_time_zone_rule_tz2):
Paul Eggert <eggert@twinsun.com>
parents:
16874
diff
changeset
|
1745 static char set_time_zone_rule_tz2[] = "TZ=GMT+1"; |
ab49512bcdff
(set_time_zone_rule_tz1, set_time_zone_rule_tz2):
Paul Eggert <eggert@twinsun.com>
parents:
16874
diff
changeset
|
1746 |
ab49512bcdff
(set_time_zone_rule_tz1, set_time_zone_rule_tz2):
Paul Eggert <eggert@twinsun.com>
parents:
16874
diff
changeset
|
1747 #endif |
15841
80a852988718
(set_time_zone_rule): Don't put a string literal
Richard M. Stallman <rms@gnu.org>
parents:
15779
diff
changeset
|
1748 |
13025
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1749 /* Set the local time zone rule to TZSTRING. |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1750 This allocates memory into `environ', which it is the caller's |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1751 responsibility to free. */ |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
1752 |
14201
ff372902386d
(set_time_zone_rule): No longer static.
Richard M. Stallman <rms@gnu.org>
parents:
14126
diff
changeset
|
1753 void |
13025
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1754 set_time_zone_rule (tzstring) |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1755 char *tzstring; |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1756 { |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1757 int envptrs; |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1758 char **from, **to, **newenv; |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1759 |
15334 | 1760 /* Make the ENVIRON vector longer with room for TZSTRING. */ |
13019
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1761 for (from = environ; *from; from++) |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1762 continue; |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1763 envptrs = from - environ + 2; |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1764 newenv = to = (char **) xmalloc (envptrs * sizeof (char *) |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1765 + (tzstring ? strlen (tzstring) + 4 : 0)); |
15334 | 1766 |
1767 /* Add TZSTRING to the end of environ, as a value for TZ. */ | |
13019
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1768 if (tzstring) |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1769 { |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1770 char *t = (char *) (to + envptrs); |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1771 strcpy (t, "TZ="); |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1772 strcat (t, tzstring); |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1773 *to++ = t; |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1774 } |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1775 |
15334 | 1776 /* Copy the old environ vector elements into NEWENV, |
1777 but don't copy the TZ variable. | |
1778 So we have only one definition of TZ, which came from TZSTRING. */ | |
13019
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1779 for (from = environ; *from; from++) |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1780 if (strncmp (*from, "TZ=", 3) != 0) |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1781 *to++ = *from; |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1782 *to = 0; |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1783 |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1784 environ = newenv; |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1785 |
15334 | 1786 /* If we do have a TZSTRING, NEWENV points to the vector slot where |
1787 the TZ variable is stored. If we do not have a TZSTRING, | |
1788 TO points to the vector slot which has the terminating null. */ | |
1789 | |
13019
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1790 #ifdef LOCALTIME_CACHE |
15334 | 1791 { |
1792 /* In SunOS 4.1.3_U1 and 4.1.4, if TZ has a value like | |
1793 "US/Pacific" that loads a tz file, then changes to a value like | |
1794 "XXX0" that does not load a tz file, and then changes back to | |
1795 its original value, the last change is (incorrectly) ignored. | |
1796 Also, if TZ changes twice in succession to values that do | |
1797 not load a tz file, tzset can dump core (see Sun bug#1225179). | |
1798 The following code works around these bugs. */ | |
1799 | |
1800 if (tzstring) | |
1801 { | |
1802 /* Temporarily set TZ to a value that loads a tz file | |
1803 and that differs from tzstring. */ | |
1804 char *tz = *newenv; | |
15841
80a852988718
(set_time_zone_rule): Don't put a string literal
Richard M. Stallman <rms@gnu.org>
parents:
15779
diff
changeset
|
1805 *newenv = (strcmp (tzstring, set_time_zone_rule_tz1 + 3) == 0 |
80a852988718
(set_time_zone_rule): Don't put a string literal
Richard M. Stallman <rms@gnu.org>
parents:
15779
diff
changeset
|
1806 ? set_time_zone_rule_tz2 : set_time_zone_rule_tz1); |
15334 | 1807 tzset (); |
1808 *newenv = tz; | |
1809 } | |
1810 else | |
1811 { | |
1812 /* The implied tzstring is unknown, so temporarily set TZ to | |
1813 two different values that each load a tz file. */ | |
15841
80a852988718
(set_time_zone_rule): Don't put a string literal
Richard M. Stallman <rms@gnu.org>
parents:
15779
diff
changeset
|
1814 *to = set_time_zone_rule_tz1; |
15334 | 1815 to[1] = 0; |
1816 tzset (); | |
15841
80a852988718
(set_time_zone_rule): Don't put a string literal
Richard M. Stallman <rms@gnu.org>
parents:
15779
diff
changeset
|
1817 *to = set_time_zone_rule_tz2; |
15334 | 1818 tzset (); |
1819 *to = 0; | |
1820 } | |
1821 | |
1822 /* Now TZ has the desired value, and tzset can be invoked safely. */ | |
1823 } | |
1824 | |
13019
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1825 tzset (); |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1826 #endif |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1827 } |
305 | 1828 |
17031 | 1829 /* Insert NARGS Lisp objects in the array ARGS by calling INSERT_FUNC |
1830 (if a type of object is Lisp_Int) or INSERT_FROM_STRING_FUNC (if a | |
1831 type of object is Lisp_String). INHERIT is passed to | |
1832 INSERT_FROM_STRING_FUNC as the last argument. */ | |
1833 | |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
1834 static void |
17031 | 1835 general_insert_function (insert_func, insert_from_string_func, |
1836 inherit, nargs, args) | |
20311
2841215c1cb4
(Fchar_to_string): Declare `workbuf' as unsigned char.
Andreas Schwab <schwab@suse.de>
parents:
20229
diff
changeset
|
1837 void (*insert_func) P_ ((unsigned char *, int)); |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
1838 void (*insert_from_string_func) P_ ((Lisp_Object, int, int, int, int, int)); |
17031 | 1839 int inherit, nargs; |
1840 register Lisp_Object *args; | |
1841 { | |
1842 register int argnum; | |
1843 register Lisp_Object val; | |
1844 | |
1845 for (argnum = 0; argnum < nargs; argnum++) | |
1846 { | |
1847 val = args[argnum]; | |
1848 retry: | |
1849 if (INTEGERP (val)) | |
1850 { | |
26853
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
1851 unsigned char str[MAX_MULTIBYTE_LENGTH]; |
17031 | 1852 int len; |
1853 | |
1854 if (!NILP (current_buffer->enable_multibyte_characters)) | |
26853
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
1855 len = CHAR_STRING (XFASTINT (val), str); |
17031 | 1856 else |
22929
6dda0a4b882f
(general_insert_function): If enable-multibyte-characters is
Kenichi Handa <handa@m17n.org>
parents:
22895
diff
changeset
|
1857 { |
26853
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
1858 str[0] = (SINGLE_BYTE_CHAR_P (XINT (val)) |
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
1859 ? XINT (val) |
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
1860 : multibyte_char_to_unibyte (XINT (val), Qnil)); |
22929
6dda0a4b882f
(general_insert_function): If enable-multibyte-characters is
Kenichi Handa <handa@m17n.org>
parents:
22895
diff
changeset
|
1861 len = 1; |
6dda0a4b882f
(general_insert_function): If enable-multibyte-characters is
Kenichi Handa <handa@m17n.org>
parents:
22895
diff
changeset
|
1862 } |
17031 | 1863 (*insert_func) (str, len); |
1864 } | |
1865 else if (STRINGP (val)) | |
1866 { | |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
1867 (*insert_from_string_func) (val, 0, 0, |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
1868 XSTRING (val)->size, |
21245
6cde55b7c9de
Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents:
21235
diff
changeset
|
1869 STRING_BYTES (XSTRING (val)), |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
1870 inherit); |
17031 | 1871 } |
1872 else | |
1873 { | |
1874 val = wrong_type_argument (Qchar_or_string_p, val); | |
1875 goto retry; | |
1876 } | |
1877 } | |
1878 } | |
1879 | |
305 | 1880 void |
1881 insert1 (arg) | |
1882 Lisp_Object arg; | |
1883 { | |
1884 Finsert (1, &arg); | |
1885 } | |
1886 | |
330 | 1887 |
1888 /* Callers passing one argument to Finsert need not gcpro the | |
1889 argument "array", since the only element of the array will | |
1890 not be used after calling insert or insert_from_string, so | |
1891 we don't care if it gets trashed. */ | |
1892 | |
305 | 1893 DEFUN ("insert", Finsert, Sinsert, 0, MANY, 0, |
1894 "Insert the arguments, either strings or characters, at point.\n\ | |
21717
2967063fe81c
(Fbuffer_substring): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
21521
diff
changeset
|
1895 Point and before-insertion markers move forward to end up\n\ |
17031 | 1896 after the inserted text.\n\ |
21717
2967063fe81c
(Fbuffer_substring): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
21521
diff
changeset
|
1897 Any other markers at the point of insertion remain before the text.\n\ |
2967063fe81c
(Fbuffer_substring): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
21521
diff
changeset
|
1898 \n\ |
2967063fe81c
(Fbuffer_substring): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
21521
diff
changeset
|
1899 If the current buffer is multibyte, unibyte strings are converted\n\ |
2967063fe81c
(Fbuffer_substring): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
21521
diff
changeset
|
1900 to multibyte for insertion (see `unibyte-char-to-multibyte').\n\ |
22669
ea5a8ef23b45
(Finsert): Typo in doc-string fixed.
Kenichi Handa <handa@m17n.org>
parents:
22645
diff
changeset
|
1901 If the current buffer is unibyte, multibyte strings are converted\n\ |
21717
2967063fe81c
(Fbuffer_substring): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
21521
diff
changeset
|
1902 to unibyte for insertion.") |
305 | 1903 (nargs, args) |
1904 int nargs; | |
1905 register Lisp_Object *args; | |
1906 { | |
17031 | 1907 general_insert_function (insert, insert_from_string, 0, nargs, args); |
4714
350231e38e68
(Finsert_and_inherit): New function.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
1908 return Qnil; |
350231e38e68
(Finsert_and_inherit): New function.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
1909 } |
350231e38e68
(Finsert_and_inherit): New function.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
1910 |
350231e38e68
(Finsert_and_inherit): New function.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
1911 DEFUN ("insert-and-inherit", Finsert_and_inherit, Sinsert_and_inherit, |
350231e38e68
(Finsert_and_inherit): New function.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
1912 0, MANY, 0, |
350231e38e68
(Finsert_and_inherit): New function.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
1913 "Insert the arguments at point, inheriting properties from adjoining text.\n\ |
21717
2967063fe81c
(Fbuffer_substring): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
21521
diff
changeset
|
1914 Point and before-insertion markers move forward to end up\n\ |
17031 | 1915 after the inserted text.\n\ |
21717
2967063fe81c
(Fbuffer_substring): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
21521
diff
changeset
|
1916 Any other markers at the point of insertion remain before the text.\n\ |
2967063fe81c
(Fbuffer_substring): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
21521
diff
changeset
|
1917 \n\ |
2967063fe81c
(Fbuffer_substring): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
21521
diff
changeset
|
1918 If the current buffer is multibyte, unibyte strings are converted\n\ |
2967063fe81c
(Fbuffer_substring): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
21521
diff
changeset
|
1919 to multibyte for insertion (see `unibyte-char-to-multibyte').\n\ |
22669
ea5a8ef23b45
(Finsert): Typo in doc-string fixed.
Kenichi Handa <handa@m17n.org>
parents:
22645
diff
changeset
|
1920 If the current buffer is unibyte, multibyte strings are converted\n\ |
21717
2967063fe81c
(Fbuffer_substring): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
21521
diff
changeset
|
1921 to unibyte for insertion.") |
4714
350231e38e68
(Finsert_and_inherit): New function.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
1922 (nargs, args) |
350231e38e68
(Finsert_and_inherit): New function.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
1923 int nargs; |
350231e38e68
(Finsert_and_inherit): New function.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
1924 register Lisp_Object *args; |
350231e38e68
(Finsert_and_inherit): New function.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
1925 { |
17031 | 1926 general_insert_function (insert_and_inherit, insert_from_string, 1, |
1927 nargs, args); | |
305 | 1928 return Qnil; |
1929 } | |
1930 | |
1931 DEFUN ("insert-before-markers", Finsert_before_markers, Sinsert_before_markers, 0, MANY, 0, | |
1932 "Insert strings or characters at point, relocating markers after the text.\n\ | |
21717
2967063fe81c
(Fbuffer_substring): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
21521
diff
changeset
|
1933 Point and markers move forward to end up after the inserted text.\n\ |
2967063fe81c
(Fbuffer_substring): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
21521
diff
changeset
|
1934 \n\ |
2967063fe81c
(Fbuffer_substring): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
21521
diff
changeset
|
1935 If the current buffer is multibyte, unibyte strings are converted\n\ |
2967063fe81c
(Fbuffer_substring): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
21521
diff
changeset
|
1936 to multibyte for insertion (see `unibyte-char-to-multibyte').\n\ |
22669
ea5a8ef23b45
(Finsert): Typo in doc-string fixed.
Kenichi Handa <handa@m17n.org>
parents:
22645
diff
changeset
|
1937 If the current buffer is unibyte, multibyte strings are converted\n\ |
21717
2967063fe81c
(Fbuffer_substring): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
21521
diff
changeset
|
1938 to unibyte for insertion.") |
305 | 1939 (nargs, args) |
1940 int nargs; | |
1941 register Lisp_Object *args; | |
1942 { | |
17031 | 1943 general_insert_function (insert_before_markers, |
1944 insert_from_string_before_markers, 0, | |
1945 nargs, args); | |
4714
350231e38e68
(Finsert_and_inherit): New function.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
1946 return Qnil; |
350231e38e68
(Finsert_and_inherit): New function.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
1947 } |
350231e38e68
(Finsert_and_inherit): New function.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
1948 |
16485
9b919c5464a4
Reorganize function definitions so etags finds them.
Erik Naggum <erik@naggum.no>
parents:
16298
diff
changeset
|
1949 DEFUN ("insert-before-markers-and-inherit", Finsert_and_inherit_before_markers, |
9b919c5464a4
Reorganize function definitions so etags finds them.
Erik Naggum <erik@naggum.no>
parents:
16298
diff
changeset
|
1950 Sinsert_and_inherit_before_markers, 0, MANY, 0, |
4714
350231e38e68
(Finsert_and_inherit): New function.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
1951 "Insert text at point, relocating markers and inheriting properties.\n\ |
21717
2967063fe81c
(Fbuffer_substring): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
21521
diff
changeset
|
1952 Point and markers move forward to end up after the inserted text.\n\ |
2967063fe81c
(Fbuffer_substring): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
21521
diff
changeset
|
1953 \n\ |
2967063fe81c
(Fbuffer_substring): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
21521
diff
changeset
|
1954 If the current buffer is multibyte, unibyte strings are converted\n\ |
2967063fe81c
(Fbuffer_substring): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
21521
diff
changeset
|
1955 to multibyte for insertion (see `unibyte-char-to-multibyte').\n\ |
22669
ea5a8ef23b45
(Finsert): Typo in doc-string fixed.
Kenichi Handa <handa@m17n.org>
parents:
22645
diff
changeset
|
1956 If the current buffer is unibyte, multibyte strings are converted\n\ |
21717
2967063fe81c
(Fbuffer_substring): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
21521
diff
changeset
|
1957 to unibyte for insertion.") |
4714
350231e38e68
(Finsert_and_inherit): New function.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
1958 (nargs, args) |
350231e38e68
(Finsert_and_inherit): New function.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
1959 int nargs; |
350231e38e68
(Finsert_and_inherit): New function.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
1960 register Lisp_Object *args; |
350231e38e68
(Finsert_and_inherit): New function.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
1961 { |
17031 | 1962 general_insert_function (insert_before_markers_and_inherit, |
1963 insert_from_string_before_markers, 1, | |
1964 nargs, args); | |
305 | 1965 return Qnil; |
1966 } | |
1967 | |
8646
0f05e3e89f87
(Finsert_char): New arg INHERIT.
Richard M. Stallman <rms@gnu.org>
parents:
8333
diff
changeset
|
1968 DEFUN ("insert-char", Finsert_char, Sinsert_char, 2, 3, 0, |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
1969 "Insert COUNT (second arg) copies of CHARACTER (first arg).\n\ |
8646
0f05e3e89f87
(Finsert_char): New arg INHERIT.
Richard M. Stallman <rms@gnu.org>
parents:
8333
diff
changeset
|
1970 Both arguments are required.\n\ |
21899
c2e75fe68665
(Finsert_char): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
21837
diff
changeset
|
1971 Point, and before-insertion markers, are relocated as in the function `insert'.\n\ |
8646
0f05e3e89f87
(Finsert_char): New arg INHERIT.
Richard M. Stallman <rms@gnu.org>
parents:
8333
diff
changeset
|
1972 The optional third arg INHERIT, if non-nil, says to inherit text properties\n\ |
0f05e3e89f87
(Finsert_char): New arg INHERIT.
Richard M. Stallman <rms@gnu.org>
parents:
8333
diff
changeset
|
1973 from adjoining text, if those properties are sticky.") |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
1974 (character, count, inherit) |
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
1975 Lisp_Object character, count, inherit; |
305 | 1976 { |
1977 register unsigned char *string; | |
1978 register int strlen; | |
1979 register int i, n; | |
17031 | 1980 int len; |
26853
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
1981 unsigned char str[MAX_MULTIBYTE_LENGTH]; |
305 | 1982 |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
1983 CHECK_NUMBER (character, 0); |
305 | 1984 CHECK_NUMBER (count, 1); |
1985 | |
17031 | 1986 if (!NILP (current_buffer->enable_multibyte_characters)) |
26853
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
1987 len = CHAR_STRING (XFASTINT (character), str); |
17031 | 1988 else |
26853
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
1989 str[0] = XFASTINT (character), len = 1; |
17031 | 1990 n = XINT (count) * len; |
305 | 1991 if (n <= 0) |
1992 return Qnil; | |
17031 | 1993 strlen = min (n, 256 * len); |
305 | 1994 string = (unsigned char *) alloca (strlen); |
1995 for (i = 0; i < strlen; i++) | |
17031 | 1996 string[i] = str[i % len]; |
305 | 1997 while (n >= strlen) |
1998 { | |
18194
c291aa915b85
(Finsert_char): Check QUIT.
Richard M. Stallman <rms@gnu.org>
parents:
18106
diff
changeset
|
1999 QUIT; |
8646
0f05e3e89f87
(Finsert_char): New arg INHERIT.
Richard M. Stallman <rms@gnu.org>
parents:
8333
diff
changeset
|
2000 if (!NILP (inherit)) |
0f05e3e89f87
(Finsert_char): New arg INHERIT.
Richard M. Stallman <rms@gnu.org>
parents:
8333
diff
changeset
|
2001 insert_and_inherit (string, strlen); |
0f05e3e89f87
(Finsert_char): New arg INHERIT.
Richard M. Stallman <rms@gnu.org>
parents:
8333
diff
changeset
|
2002 else |
0f05e3e89f87
(Finsert_char): New arg INHERIT.
Richard M. Stallman <rms@gnu.org>
parents:
8333
diff
changeset
|
2003 insert (string, strlen); |
305 | 2004 n -= strlen; |
2005 } | |
2006 if (n > 0) | |
10382
9738aad59697
(Finsert_char): Check inherit flag for long strings too.
Karl Heuer <kwzh@gnu.org>
parents:
10308
diff
changeset
|
2007 { |
9738aad59697
(Finsert_char): Check inherit flag for long strings too.
Karl Heuer <kwzh@gnu.org>
parents:
10308
diff
changeset
|
2008 if (!NILP (inherit)) |
9738aad59697
(Finsert_char): Check inherit flag for long strings too.
Karl Heuer <kwzh@gnu.org>
parents:
10308
diff
changeset
|
2009 insert_and_inherit (string, n); |
9738aad59697
(Finsert_char): Check inherit flag for long strings too.
Karl Heuer <kwzh@gnu.org>
parents:
10308
diff
changeset
|
2010 else |
9738aad59697
(Finsert_char): Check inherit flag for long strings too.
Karl Heuer <kwzh@gnu.org>
parents:
10308
diff
changeset
|
2011 insert (string, n); |
9738aad59697
(Finsert_char): Check inherit flag for long strings too.
Karl Heuer <kwzh@gnu.org>
parents:
10308
diff
changeset
|
2012 } |
305 | 2013 return Qnil; |
2014 } | |
2015 | |
2016 | |
648 | 2017 /* Making strings from buffer contents. */ |
2018 | |
2019 /* Return a Lisp_String containing the text of the current buffer from | |
1285
d50533e23dff
* editfns.c (make_buffer_string): Call copy_intervals_to_string().
Joseph Arceneaux <jla@gnu.org>
parents:
1254
diff
changeset
|
2020 START to END. If text properties are in use and the current buffer |
3591
507f64624555
Apply typo patches from Paul Eggert.
Jim Blandy <jimb@redhat.com>
parents:
3522
diff
changeset
|
2021 has properties in the range specified, the resulting string will also |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2022 have them, if PROPS is nonzero. |
648 | 2023 |
2024 We don't want to use plain old make_string here, because it calls | |
2025 make_uninit_string, which can cause the buffer arena to be | |
2026 compacted. make_string has no way of knowing that the data has | |
2027 been moved, and thus copies the wrong data into the string. This | |
2028 doesn't effect most of the other users of make_string, so it should | |
2029 be left as is. But we should use this function when conjuring | |
2030 buffer substrings. */ | |
1285
d50533e23dff
* editfns.c (make_buffer_string): Call copy_intervals_to_string().
Joseph Arceneaux <jla@gnu.org>
parents:
1254
diff
changeset
|
2031 |
648 | 2032 Lisp_Object |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2033 make_buffer_string (start, end, props) |
648 | 2034 int start, end; |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2035 int props; |
648 | 2036 { |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
2037 int start_byte = CHAR_TO_BYTE (start); |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
2038 int end_byte = CHAR_TO_BYTE (end); |
648 | 2039 |
21235
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2040 return make_buffer_string_both (start, start_byte, end, end_byte, props); |
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2041 } |
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2042 |
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2043 /* Return a Lisp_String containing the text of the current buffer from |
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2044 START / START_BYTE to END / END_BYTE. |
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2045 |
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2046 If text properties are in use and the current buffer |
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2047 has properties in the range specified, the resulting string will also |
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2048 have them, if PROPS is nonzero. |
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2049 |
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2050 We don't want to use plain old make_string here, because it calls |
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2051 make_uninit_string, which can cause the buffer arena to be |
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2052 compacted. make_string has no way of knowing that the data has |
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2053 been moved, and thus copies the wrong data into the string. This |
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2054 doesn't effect most of the other users of make_string, so it should |
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2055 be left as is. But we should use this function when conjuring |
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2056 buffer substrings. */ |
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2057 |
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2058 Lisp_Object |
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2059 make_buffer_string_both (start, start_byte, end, end_byte, props) |
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2060 int start, start_byte, end, end_byte; |
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2061 int props; |
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2062 { |
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2063 Lisp_Object result, tem, tem1; |
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2064 |
648 | 2065 if (start < GPT && GPT < end) |
2066 move_gap (start); | |
2067 | |
21257
205a5aa4aa2f
(Fchar_to_string): Use make_string_from_bytes.
Richard M. Stallman <rms@gnu.org>
parents:
21245
diff
changeset
|
2068 if (! NILP (current_buffer->enable_multibyte_characters)) |
205a5aa4aa2f
(Fchar_to_string): Use make_string_from_bytes.
Richard M. Stallman <rms@gnu.org>
parents:
21245
diff
changeset
|
2069 result = make_uninit_multibyte_string (end - start, end_byte - start_byte); |
205a5aa4aa2f
(Fchar_to_string): Use make_string_from_bytes.
Richard M. Stallman <rms@gnu.org>
parents:
21245
diff
changeset
|
2070 else |
205a5aa4aa2f
(Fchar_to_string): Use make_string_from_bytes.
Richard M. Stallman <rms@gnu.org>
parents:
21245
diff
changeset
|
2071 result = make_uninit_string (end - start); |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
2072 bcopy (BYTE_POS_ADDR (start_byte), XSTRING (result)->data, |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
2073 end_byte - start_byte); |
648 | 2074 |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2075 /* If desired, update and copy the text properties. */ |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2076 if (props) |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2077 { |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2078 update_buffer_properties (start, end); |
5130
ddee29e260d2
(make_buffer_string): Don't copy intervals
Richard M. Stallman <rms@gnu.org>
parents:
4943
diff
changeset
|
2079 |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2080 tem = Fnext_property_change (make_number (start), Qnil, make_number (end)); |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2081 tem1 = Ftext_properties_at (make_number (start), Qnil); |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2082 |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2083 if (XINT (tem) != end || !NILP (tem1)) |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
2084 copy_intervals_to_string (result, current_buffer, start, |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
2085 end - start); |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2086 } |
1285
d50533e23dff
* editfns.c (make_buffer_string): Call copy_intervals_to_string().
Joseph Arceneaux <jla@gnu.org>
parents:
1254
diff
changeset
|
2087 |
648 | 2088 return result; |
2089 } | |
305 | 2090 |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2091 /* Call Vbuffer_access_fontify_functions for the range START ... END |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2092 in the current buffer, if necessary. */ |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2093 |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2094 static void |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2095 update_buffer_properties (start, end) |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2096 int start, end; |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2097 { |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2098 /* If this buffer has some access functions, |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2099 call them, specifying the range of the buffer being accessed. */ |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2100 if (!NILP (Vbuffer_access_fontify_functions)) |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2101 { |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2102 Lisp_Object args[3]; |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2103 Lisp_Object tem; |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2104 |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2105 args[0] = Qbuffer_access_fontify_functions; |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2106 XSETINT (args[1], start); |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2107 XSETINT (args[2], end); |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2108 |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2109 /* But don't call them if we can tell that the work |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2110 has already been done. */ |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2111 if (!NILP (Vbuffer_access_fontified_property)) |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2112 { |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2113 tem = Ftext_property_any (args[1], args[2], |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2114 Vbuffer_access_fontified_property, |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2115 Qnil, Qnil); |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2116 if (! NILP (tem)) |
14126
edc94b82c3b3
(update_buffer_properties): Delete superfluous &'s.
Karl Heuer <kwzh@gnu.org>
parents:
14071
diff
changeset
|
2117 Frun_hook_with_args (3, args); |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2118 } |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2119 else |
14126
edc94b82c3b3
(update_buffer_properties): Delete superfluous &'s.
Karl Heuer <kwzh@gnu.org>
parents:
14071
diff
changeset
|
2120 Frun_hook_with_args (3, args); |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2121 } |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2122 } |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2123 |
305 | 2124 DEFUN ("buffer-substring", Fbuffer_substring, Sbuffer_substring, 2, 2, 0, |
2125 "Return the contents of part of the current buffer as a string.\n\ | |
2126 The two arguments START and END are character positions;\n\ | |
21717
2967063fe81c
(Fbuffer_substring): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
21521
diff
changeset
|
2127 they can be in either order.\n\ |
2967063fe81c
(Fbuffer_substring): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
21521
diff
changeset
|
2128 The string returned is multibyte if the buffer is multibyte.") |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2129 (start, end) |
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2130 Lisp_Object start, end; |
305 | 2131 { |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2132 register int b, e; |
305 | 2133 |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2134 validate_region (&start, &end); |
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2135 b = XINT (start); |
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2136 e = XINT (end); |
305 | 2137 |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2138 return make_buffer_string (b, e, 1); |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2139 } |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2140 |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2141 DEFUN ("buffer-substring-no-properties", Fbuffer_substring_no_properties, |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2142 Sbuffer_substring_no_properties, 2, 2, 0, |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2143 "Return the characters of part of the buffer, without the text properties.\n\ |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2144 The two arguments START and END are character positions;\n\ |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2145 they can be in either order.") |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2146 (start, end) |
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2147 Lisp_Object start, end; |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2148 { |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2149 register int b, e; |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2150 |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2151 validate_region (&start, &end); |
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2152 b = XINT (start); |
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2153 e = XINT (end); |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2154 |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2155 return make_buffer_string (b, e, 0); |
305 | 2156 } |
2157 | |
2158 DEFUN ("buffer-string", Fbuffer_string, Sbuffer_string, 0, 0, 0, | |
11433
6f7bdb6c3739
(Fbuffer_string): Doc clarification.
Karl Heuer <kwzh@gnu.org>
parents:
11402
diff
changeset
|
2159 "Return the contents of the current buffer as a string.\n\ |
6f7bdb6c3739
(Fbuffer_string): Doc clarification.
Karl Heuer <kwzh@gnu.org>
parents:
11402
diff
changeset
|
2160 If narrowing is in effect, this function returns only the visible part\n\ |
31531 | 2161 of the buffer.") |
305 | 2162 () |
2163 { | |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
2164 return make_buffer_string (BEGV, ZV, 1); |
305 | 2165 } |
2166 | |
2167 DEFUN ("insert-buffer-substring", Finsert_buffer_substring, Sinsert_buffer_substring, | |
2168 1, 3, 0, | |
3776
301e2dca5fd7
(Finsert_buffer_substring): Doc fix.
Roland McGrath <roland@gnu.org>
parents:
3591
diff
changeset
|
2169 "Insert before point a substring of the contents of buffer BUFFER.\n\ |
305 | 2170 BUFFER may be a buffer or a buffer name.\n\ |
2171 Arguments START and END are character numbers specifying the substring.\n\ | |
2172 They default to the beginning and the end of BUFFER.") | |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2173 (buf, start, end) |
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2174 Lisp_Object buf, start, end; |
305 | 2175 { |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2176 register int b, e, temp; |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2177 register struct buffer *bp, *obuf; |
1854
5a18c36181fa
(Finsert_buffer_substring): Proper error for non-ex buffer.
Richard M. Stallman <rms@gnu.org>
parents:
1853
diff
changeset
|
2178 Lisp_Object buffer; |
305 | 2179 |
1854
5a18c36181fa
(Finsert_buffer_substring): Proper error for non-ex buffer.
Richard M. Stallman <rms@gnu.org>
parents:
1853
diff
changeset
|
2180 buffer = Fget_buffer (buf); |
5a18c36181fa
(Finsert_buffer_substring): Proper error for non-ex buffer.
Richard M. Stallman <rms@gnu.org>
parents:
1853
diff
changeset
|
2181 if (NILP (buffer)) |
5a18c36181fa
(Finsert_buffer_substring): Proper error for non-ex buffer.
Richard M. Stallman <rms@gnu.org>
parents:
1853
diff
changeset
|
2182 nsberror (buf); |
5a18c36181fa
(Finsert_buffer_substring): Proper error for non-ex buffer.
Richard M. Stallman <rms@gnu.org>
parents:
1853
diff
changeset
|
2183 bp = XBUFFER (buffer); |
16134
7558d82368f9
(Finsert_buffer_substring): Check for deleted buffer.
Karl Heuer <kwzh@gnu.org>
parents:
16097
diff
changeset
|
2184 if (NILP (bp->name)) |
7558d82368f9
(Finsert_buffer_substring): Check for deleted buffer.
Karl Heuer <kwzh@gnu.org>
parents:
16097
diff
changeset
|
2185 error ("Selecting deleted buffer"); |
305 | 2186 |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2187 if (NILP (start)) |
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2188 b = BUF_BEGV (bp); |
305 | 2189 else |
2190 { | |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2191 CHECK_NUMBER_COERCE_MARKER (start, 0); |
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2192 b = XINT (start); |
305 | 2193 } |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2194 if (NILP (end)) |
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2195 e = BUF_ZV (bp); |
305 | 2196 else |
2197 { | |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2198 CHECK_NUMBER_COERCE_MARKER (end, 1); |
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2199 e = XINT (end); |
305 | 2200 } |
2201 | |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2202 if (b > e) |
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2203 temp = b, b = e, e = temp; |
305 | 2204 |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2205 if (!(BUF_BEGV (bp) <= b && e <= BUF_ZV (bp))) |
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2206 args_out_of_range (start, end); |
305 | 2207 |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2208 obuf = current_buffer; |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2209 set_buffer_internal_1 (bp); |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2210 update_buffer_properties (b, e); |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2211 set_buffer_internal_1 (obuf); |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2212 |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2213 insert_from_buffer (bp, b, e - b, 0); |
305 | 2214 return Qnil; |
2215 } | |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2216 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2217 DEFUN ("compare-buffer-substrings", Fcompare_buffer_substrings, Scompare_buffer_substrings, |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2218 6, 6, 0, |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2219 "Compare two substrings of two buffers; return result as number.\n\ |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2220 the value is -N if first string is less after N-1 chars,\n\ |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2221 +N if first string is greater after N-1 chars, or 0 if strings match.\n\ |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2222 Each substring is represented as three arguments: BUFFER, START and END.\n\ |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2223 That makes six args in all, three for each substring.\n\n\ |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2224 The value of `case-fold-search' in the current buffer\n\ |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2225 determines whether case is significant or ignored.") |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2226 (buffer1, start1, end1, buffer2, start2, end2) |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2227 Lisp_Object buffer1, start1, end1, buffer2, start2, end2; |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2228 { |
21837
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2229 register int begp1, endp1, begp2, endp2, temp; |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2230 register struct buffer *bp1, *bp2; |
14391
dfdf939f3e8c
(Fcompare_buffer_substrings): Access case_canon_table as a char_table.
Richard M. Stallman <rms@gnu.org>
parents:
14237
diff
changeset
|
2231 register Lisp_Object *trt |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2232 = (!NILP (current_buffer->case_fold_search) |
14391
dfdf939f3e8c
(Fcompare_buffer_substrings): Access case_canon_table as a char_table.
Richard M. Stallman <rms@gnu.org>
parents:
14237
diff
changeset
|
2233 ? XCHAR_TABLE (current_buffer->case_canon_table)->contents : 0); |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
2234 int chars = 0; |
21837
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2235 int i1, i2, i1_byte, i2_byte; |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2236 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2237 /* Find the first buffer and its substring. */ |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2238 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2239 if (NILP (buffer1)) |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2240 bp1 = current_buffer; |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2241 else |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2242 { |
1854
5a18c36181fa
(Finsert_buffer_substring): Proper error for non-ex buffer.
Richard M. Stallman <rms@gnu.org>
parents:
1853
diff
changeset
|
2243 Lisp_Object buf1; |
5a18c36181fa
(Finsert_buffer_substring): Proper error for non-ex buffer.
Richard M. Stallman <rms@gnu.org>
parents:
1853
diff
changeset
|
2244 buf1 = Fget_buffer (buffer1); |
5a18c36181fa
(Finsert_buffer_substring): Proper error for non-ex buffer.
Richard M. Stallman <rms@gnu.org>
parents:
1853
diff
changeset
|
2245 if (NILP (buf1)) |
5a18c36181fa
(Finsert_buffer_substring): Proper error for non-ex buffer.
Richard M. Stallman <rms@gnu.org>
parents:
1853
diff
changeset
|
2246 nsberror (buffer1); |
5a18c36181fa
(Finsert_buffer_substring): Proper error for non-ex buffer.
Richard M. Stallman <rms@gnu.org>
parents:
1853
diff
changeset
|
2247 bp1 = XBUFFER (buf1); |
16134
7558d82368f9
(Finsert_buffer_substring): Check for deleted buffer.
Karl Heuer <kwzh@gnu.org>
parents:
16097
diff
changeset
|
2248 if (NILP (bp1->name)) |
7558d82368f9
(Finsert_buffer_substring): Check for deleted buffer.
Karl Heuer <kwzh@gnu.org>
parents:
16097
diff
changeset
|
2249 error ("Selecting deleted buffer"); |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2250 } |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2251 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2252 if (NILP (start1)) |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2253 begp1 = BUF_BEGV (bp1); |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2254 else |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2255 { |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2256 CHECK_NUMBER_COERCE_MARKER (start1, 1); |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2257 begp1 = XINT (start1); |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2258 } |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2259 if (NILP (end1)) |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2260 endp1 = BUF_ZV (bp1); |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2261 else |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2262 { |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2263 CHECK_NUMBER_COERCE_MARKER (end1, 2); |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2264 endp1 = XINT (end1); |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2265 } |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2266 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2267 if (begp1 > endp1) |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2268 temp = begp1, begp1 = endp1, endp1 = temp; |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2269 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2270 if (!(BUF_BEGV (bp1) <= begp1 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2271 && begp1 <= endp1 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2272 && endp1 <= BUF_ZV (bp1))) |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2273 args_out_of_range (start1, end1); |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2274 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2275 /* Likewise for second substring. */ |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2276 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2277 if (NILP (buffer2)) |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2278 bp2 = current_buffer; |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2279 else |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2280 { |
1854
5a18c36181fa
(Finsert_buffer_substring): Proper error for non-ex buffer.
Richard M. Stallman <rms@gnu.org>
parents:
1853
diff
changeset
|
2281 Lisp_Object buf2; |
5a18c36181fa
(Finsert_buffer_substring): Proper error for non-ex buffer.
Richard M. Stallman <rms@gnu.org>
parents:
1853
diff
changeset
|
2282 buf2 = Fget_buffer (buffer2); |
5a18c36181fa
(Finsert_buffer_substring): Proper error for non-ex buffer.
Richard M. Stallman <rms@gnu.org>
parents:
1853
diff
changeset
|
2283 if (NILP (buf2)) |
5a18c36181fa
(Finsert_buffer_substring): Proper error for non-ex buffer.
Richard M. Stallman <rms@gnu.org>
parents:
1853
diff
changeset
|
2284 nsberror (buffer2); |
15015
8f8d48ab0a53
(Fcompare_buffer_substrings): Fix dumb bug handling buffer name as second arg.
Richard M. Stallman <rms@gnu.org>
parents:
15004
diff
changeset
|
2285 bp2 = XBUFFER (buf2); |
16134
7558d82368f9
(Finsert_buffer_substring): Check for deleted buffer.
Karl Heuer <kwzh@gnu.org>
parents:
16097
diff
changeset
|
2286 if (NILP (bp2->name)) |
7558d82368f9
(Finsert_buffer_substring): Check for deleted buffer.
Karl Heuer <kwzh@gnu.org>
parents:
16097
diff
changeset
|
2287 error ("Selecting deleted buffer"); |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2288 } |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2289 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2290 if (NILP (start2)) |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2291 begp2 = BUF_BEGV (bp2); |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2292 else |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2293 { |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2294 CHECK_NUMBER_COERCE_MARKER (start2, 4); |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2295 begp2 = XINT (start2); |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2296 } |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2297 if (NILP (end2)) |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2298 endp2 = BUF_ZV (bp2); |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2299 else |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2300 { |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2301 CHECK_NUMBER_COERCE_MARKER (end2, 5); |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2302 endp2 = XINT (end2); |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2303 } |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2304 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2305 if (begp2 > endp2) |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2306 temp = begp2, begp2 = endp2, endp2 = temp; |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2307 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2308 if (!(BUF_BEGV (bp2) <= begp2 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2309 && begp2 <= endp2 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2310 && endp2 <= BUF_ZV (bp2))) |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2311 args_out_of_range (start2, end2); |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2312 |
21837
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2313 i1 = begp1; |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2314 i2 = begp2; |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2315 i1_byte = buf_charpos_to_bytepos (bp1, i1); |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2316 i2_byte = buf_charpos_to_bytepos (bp2, i2); |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2317 |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2318 while (i1 < endp1 && i2 < endp2) |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2319 { |
21837
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2320 /* When we find a mismatch, we must compare the |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2321 characters, not just the bytes. */ |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2322 int c1, c2; |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2323 |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2324 if (! NILP (bp1->enable_multibyte_characters)) |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2325 { |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2326 c1 = BUF_FETCH_MULTIBYTE_CHAR (bp1, i1_byte); |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2327 BUF_INC_POS (bp1, i1_byte); |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2328 i1++; |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2329 } |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2330 else |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2331 { |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2332 c1 = BUF_FETCH_BYTE (bp1, i1); |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2333 c1 = unibyte_char_to_multibyte (c1); |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2334 i1++; |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2335 } |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2336 |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2337 if (! NILP (bp2->enable_multibyte_characters)) |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2338 { |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2339 c2 = BUF_FETCH_MULTIBYTE_CHAR (bp2, i2_byte); |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2340 BUF_INC_POS (bp2, i2_byte); |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2341 i2++; |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2342 } |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2343 else |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2344 { |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2345 c2 = BUF_FETCH_BYTE (bp2, i2); |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2346 c2 = unibyte_char_to_multibyte (c2); |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2347 i2++; |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2348 } |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
2349 |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2350 if (trt) |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2351 { |
18106
b129c5fd7925
(Fcompare_buffer_substrings): trt contains Lisp_Objects.
Richard M. Stallman <rms@gnu.org>
parents:
18031
diff
changeset
|
2352 c1 = XINT (trt[c1]); |
b129c5fd7925
(Fcompare_buffer_substrings): trt contains Lisp_Objects.
Richard M. Stallman <rms@gnu.org>
parents:
18031
diff
changeset
|
2353 c2 = XINT (trt[c2]); |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2354 } |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2355 if (c1 < c2) |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
2356 return make_number (- 1 - chars); |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2357 if (c1 > c2) |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
2358 return make_number (chars + 1); |
21837
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2359 |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2360 chars++; |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2361 } |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2362 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2363 /* The strings match as far as they go. |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2364 If one is shorter, that one is less. */ |
21837
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2365 if (chars < endp1 - begp1) |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
2366 return make_number (chars + 1); |
21837
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2367 else if (chars < endp2 - begp2) |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
2368 return make_number (- chars - 1); |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2369 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2370 /* Same length too => they are equal. */ |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2371 return make_number (0); |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2372 } |
305 | 2373 |
10480
fbb254882b9f
(subst_char_in_region_unwind): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10383
diff
changeset
|
2374 static Lisp_Object |
fbb254882b9f
(subst_char_in_region_unwind): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10383
diff
changeset
|
2375 subst_char_in_region_unwind (arg) |
fbb254882b9f
(subst_char_in_region_unwind): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10383
diff
changeset
|
2376 Lisp_Object arg; |
fbb254882b9f
(subst_char_in_region_unwind): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10383
diff
changeset
|
2377 { |
fbb254882b9f
(subst_char_in_region_unwind): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10383
diff
changeset
|
2378 return current_buffer->undo_list = arg; |
fbb254882b9f
(subst_char_in_region_unwind): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10383
diff
changeset
|
2379 } |
fbb254882b9f
(subst_char_in_region_unwind): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10383
diff
changeset
|
2380 |
12622
205232bb7efe
(Fsubst_char_in_region): Bind buffer-file-name to nil if NOUNDO is true.
Richard M. Stallman <rms@gnu.org>
parents:
12603
diff
changeset
|
2381 static Lisp_Object |
205232bb7efe
(Fsubst_char_in_region): Bind buffer-file-name to nil if NOUNDO is true.
Richard M. Stallman <rms@gnu.org>
parents:
12603
diff
changeset
|
2382 subst_char_in_region_unwind_1 (arg) |
205232bb7efe
(Fsubst_char_in_region): Bind buffer-file-name to nil if NOUNDO is true.
Richard M. Stallman <rms@gnu.org>
parents:
12603
diff
changeset
|
2383 Lisp_Object arg; |
205232bb7efe
(Fsubst_char_in_region): Bind buffer-file-name to nil if NOUNDO is true.
Richard M. Stallman <rms@gnu.org>
parents:
12603
diff
changeset
|
2384 { |
205232bb7efe
(Fsubst_char_in_region): Bind buffer-file-name to nil if NOUNDO is true.
Richard M. Stallman <rms@gnu.org>
parents:
12603
diff
changeset
|
2385 return current_buffer->filename = arg; |
205232bb7efe
(Fsubst_char_in_region): Bind buffer-file-name to nil if NOUNDO is true.
Richard M. Stallman <rms@gnu.org>
parents:
12603
diff
changeset
|
2386 } |
205232bb7efe
(Fsubst_char_in_region): Bind buffer-file-name to nil if NOUNDO is true.
Richard M. Stallman <rms@gnu.org>
parents:
12603
diff
changeset
|
2387 |
305 | 2388 DEFUN ("subst-char-in-region", Fsubst_char_in_region, |
2389 Ssubst_char_in_region, 4, 5, 0, | |
2390 "From START to END, replace FROMCHAR with TOCHAR each time it occurs.\n\ | |
2391 If optional arg NOUNDO is non-nil, don't record this change for undo\n\ | |
17031 | 2392 and don't mark the buffer as really changed.\n\ |
2393 Both characters must have the same length of multi-byte form.") | |
305 | 2394 (start, end, fromchar, tochar, noundo) |
2395 Lisp_Object start, end, fromchar, tochar, noundo; | |
2396 { | |
20834
95a80c1e06c3
(Fsubst_char_in_region): Handle character-base
Kenichi Handa <handa@m17n.org>
parents:
20826
diff
changeset
|
2397 register int pos, pos_byte, stop, i, len, end_byte; |
5130
ddee29e260d2
(make_buffer_string): Don't copy intervals
Richard M. Stallman <rms@gnu.org>
parents:
4943
diff
changeset
|
2398 int changed = 0; |
26853
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2399 unsigned char fromstr[MAX_MULTIBYTE_LENGTH], tostr[MAX_MULTIBYTE_LENGTH]; |
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2400 unsigned char *p; |
10480
fbb254882b9f
(subst_char_in_region_unwind): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10383
diff
changeset
|
2401 int count = specpdl_ptr - specpdl; |
25507
b9b4581adf36
(Fsubst_char_in_region): Adjust the way to check byte-combining
Kenichi Handa <handa@m17n.org>
parents:
25346
diff
changeset
|
2402 #define COMBINING_NO 0 |
b9b4581adf36
(Fsubst_char_in_region): Adjust the way to check byte-combining
Kenichi Handa <handa@m17n.org>
parents:
25346
diff
changeset
|
2403 #define COMBINING_BEFORE 1 |
b9b4581adf36
(Fsubst_char_in_region): Adjust the way to check byte-combining
Kenichi Handa <handa@m17n.org>
parents:
25346
diff
changeset
|
2404 #define COMBINING_AFTER 2 |
b9b4581adf36
(Fsubst_char_in_region): Adjust the way to check byte-combining
Kenichi Handa <handa@m17n.org>
parents:
25346
diff
changeset
|
2405 #define COMBINING_BOTH (COMBINING_BEFORE | COMBINING_AFTER) |
b9b4581adf36
(Fsubst_char_in_region): Adjust the way to check byte-combining
Kenichi Handa <handa@m17n.org>
parents:
25346
diff
changeset
|
2406 int maybe_byte_combining = COMBINING_NO; |
26853
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2407 int last_changed; |
28358
7ae3851c0a19
(Fsubst_char_in_region): Don't use INC_POS in unibyte
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2408 int multibyte_p = !NILP (current_buffer->enable_multibyte_characters); |
305 | 2409 |
2410 validate_region (&start, &end); | |
2411 CHECK_NUMBER (fromchar, 2); | |
2412 CHECK_NUMBER (tochar, 3); | |
2413 | |
28358
7ae3851c0a19
(Fsubst_char_in_region): Don't use INC_POS in unibyte
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2414 if (multibyte_p) |
17031 | 2415 { |
26853
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2416 len = CHAR_STRING (XFASTINT (fromchar), fromstr); |
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2417 if (CHAR_STRING (XFASTINT (tochar), tostr) != len) |
17031 | 2418 error ("Characters in subst-char-in-region have different byte-lengths"); |
25507
b9b4581adf36
(Fsubst_char_in_region): Adjust the way to check byte-combining
Kenichi Handa <handa@m17n.org>
parents:
25346
diff
changeset
|
2419 if (!ASCII_BYTE_P (*tostr)) |
b9b4581adf36
(Fsubst_char_in_region): Adjust the way to check byte-combining
Kenichi Handa <handa@m17n.org>
parents:
25346
diff
changeset
|
2420 { |
b9b4581adf36
(Fsubst_char_in_region): Adjust the way to check byte-combining
Kenichi Handa <handa@m17n.org>
parents:
25346
diff
changeset
|
2421 /* If *TOSTR is in the range 0x80..0x9F and TOCHAR is not a |
b9b4581adf36
(Fsubst_char_in_region): Adjust the way to check byte-combining
Kenichi Handa <handa@m17n.org>
parents:
25346
diff
changeset
|
2422 complete multibyte character, it may be combined with the |
b9b4581adf36
(Fsubst_char_in_region): Adjust the way to check byte-combining
Kenichi Handa <handa@m17n.org>
parents:
25346
diff
changeset
|
2423 after bytes. If it is in the range 0xA0..0xFF, it may be |
b9b4581adf36
(Fsubst_char_in_region): Adjust the way to check byte-combining
Kenichi Handa <handa@m17n.org>
parents:
25346
diff
changeset
|
2424 combined with the before and after bytes. */ |
b9b4581adf36
(Fsubst_char_in_region): Adjust the way to check byte-combining
Kenichi Handa <handa@m17n.org>
parents:
25346
diff
changeset
|
2425 if (!CHAR_HEAD_P (*tostr)) |
b9b4581adf36
(Fsubst_char_in_region): Adjust the way to check byte-combining
Kenichi Handa <handa@m17n.org>
parents:
25346
diff
changeset
|
2426 maybe_byte_combining = COMBINING_BOTH; |
b9b4581adf36
(Fsubst_char_in_region): Adjust the way to check byte-combining
Kenichi Handa <handa@m17n.org>
parents:
25346
diff
changeset
|
2427 else if (BYTES_BY_CHAR_HEAD (*tostr) > len) |
b9b4581adf36
(Fsubst_char_in_region): Adjust the way to check byte-combining
Kenichi Handa <handa@m17n.org>
parents:
25346
diff
changeset
|
2428 maybe_byte_combining = COMBINING_AFTER; |
b9b4581adf36
(Fsubst_char_in_region): Adjust the way to check byte-combining
Kenichi Handa <handa@m17n.org>
parents:
25346
diff
changeset
|
2429 } |
17031 | 2430 } |
2431 else | |
2432 { | |
2433 len = 1; | |
26853
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2434 fromstr[0] = XFASTINT (fromchar); |
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2435 tostr[0] = XFASTINT (tochar); |
17031 | 2436 } |
2437 | |
20834
95a80c1e06c3
(Fsubst_char_in_region): Handle character-base
Kenichi Handa <handa@m17n.org>
parents:
20826
diff
changeset
|
2438 pos = XINT (start); |
95a80c1e06c3
(Fsubst_char_in_region): Handle character-base
Kenichi Handa <handa@m17n.org>
parents:
20826
diff
changeset
|
2439 pos_byte = CHAR_TO_BYTE (pos); |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
2440 stop = CHAR_TO_BYTE (XINT (end)); |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
2441 end_byte = stop; |
305 | 2442 |
10480
fbb254882b9f
(subst_char_in_region_unwind): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10383
diff
changeset
|
2443 /* If we don't want undo, turn off putting stuff on the list. |
fbb254882b9f
(subst_char_in_region_unwind): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10383
diff
changeset
|
2444 That's faster than getting rid of things, |
12622
205232bb7efe
(Fsubst_char_in_region): Bind buffer-file-name to nil if NOUNDO is true.
Richard M. Stallman <rms@gnu.org>
parents:
12603
diff
changeset
|
2445 and it prevents even the entry for a first change. |
205232bb7efe
(Fsubst_char_in_region): Bind buffer-file-name to nil if NOUNDO is true.
Richard M. Stallman <rms@gnu.org>
parents:
12603
diff
changeset
|
2446 Also inhibit locking the file. */ |
10480
fbb254882b9f
(subst_char_in_region_unwind): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10383
diff
changeset
|
2447 if (!NILP (noundo)) |
fbb254882b9f
(subst_char_in_region_unwind): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10383
diff
changeset
|
2448 { |
fbb254882b9f
(subst_char_in_region_unwind): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10383
diff
changeset
|
2449 record_unwind_protect (subst_char_in_region_unwind, |
fbb254882b9f
(subst_char_in_region_unwind): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10383
diff
changeset
|
2450 current_buffer->undo_list); |
fbb254882b9f
(subst_char_in_region_unwind): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10383
diff
changeset
|
2451 current_buffer->undo_list = Qt; |
12622
205232bb7efe
(Fsubst_char_in_region): Bind buffer-file-name to nil if NOUNDO is true.
Richard M. Stallman <rms@gnu.org>
parents:
12603
diff
changeset
|
2452 /* Don't do file-locking. */ |
205232bb7efe
(Fsubst_char_in_region): Bind buffer-file-name to nil if NOUNDO is true.
Richard M. Stallman <rms@gnu.org>
parents:
12603
diff
changeset
|
2453 record_unwind_protect (subst_char_in_region_unwind_1, |
205232bb7efe
(Fsubst_char_in_region): Bind buffer-file-name to nil if NOUNDO is true.
Richard M. Stallman <rms@gnu.org>
parents:
12603
diff
changeset
|
2454 current_buffer->filename); |
205232bb7efe
(Fsubst_char_in_region): Bind buffer-file-name to nil if NOUNDO is true.
Richard M. Stallman <rms@gnu.org>
parents:
12603
diff
changeset
|
2455 current_buffer->filename = Qnil; |
10480
fbb254882b9f
(subst_char_in_region_unwind): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10383
diff
changeset
|
2456 } |
fbb254882b9f
(subst_char_in_region_unwind): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10383
diff
changeset
|
2457 |
20834
95a80c1e06c3
(Fsubst_char_in_region): Handle character-base
Kenichi Handa <handa@m17n.org>
parents:
20826
diff
changeset
|
2458 if (pos_byte < GPT_BYTE) |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
2459 stop = min (stop, GPT_BYTE); |
17031 | 2460 while (1) |
305 | 2461 { |
23554
e06e84c477fa
(Fsubst_char_in_region): Correctly handle the case
Kenichi Handa <handa@m17n.org>
parents:
23553
diff
changeset
|
2462 int pos_byte_next = pos_byte; |
e06e84c477fa
(Fsubst_char_in_region): Correctly handle the case
Kenichi Handa <handa@m17n.org>
parents:
23553
diff
changeset
|
2463 |
20834
95a80c1e06c3
(Fsubst_char_in_region): Handle character-base
Kenichi Handa <handa@m17n.org>
parents:
20826
diff
changeset
|
2464 if (pos_byte >= stop) |
17031 | 2465 { |
20834
95a80c1e06c3
(Fsubst_char_in_region): Handle character-base
Kenichi Handa <handa@m17n.org>
parents:
20826
diff
changeset
|
2466 if (pos_byte >= end_byte) break; |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
2467 stop = end_byte; |
17031 | 2468 } |
20834
95a80c1e06c3
(Fsubst_char_in_region): Handle character-base
Kenichi Handa <handa@m17n.org>
parents:
20826
diff
changeset
|
2469 p = BYTE_POS_ADDR (pos_byte); |
28358
7ae3851c0a19
(Fsubst_char_in_region): Don't use INC_POS in unibyte
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2470 if (multibyte_p) |
7ae3851c0a19
(Fsubst_char_in_region): Don't use INC_POS in unibyte
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2471 INC_POS (pos_byte_next); |
7ae3851c0a19
(Fsubst_char_in_region): Don't use INC_POS in unibyte
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2472 else |
7ae3851c0a19
(Fsubst_char_in_region): Don't use INC_POS in unibyte
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2473 ++pos_byte_next; |
23554
e06e84c477fa
(Fsubst_char_in_region): Correctly handle the case
Kenichi Handa <handa@m17n.org>
parents:
23553
diff
changeset
|
2474 if (pos_byte_next - pos_byte == len |
e06e84c477fa
(Fsubst_char_in_region): Correctly handle the case
Kenichi Handa <handa@m17n.org>
parents:
23553
diff
changeset
|
2475 && p[0] == fromstr[0] |
17031 | 2476 && (len == 1 |
2477 || (p[1] == fromstr[1] | |
2478 && (len == 2 || (p[2] == fromstr[2] | |
2479 && (len == 3 || p[3] == fromstr[3])))))) | |
305 | 2480 { |
5130
ddee29e260d2
(make_buffer_string): Don't copy intervals
Richard M. Stallman <rms@gnu.org>
parents:
4943
diff
changeset
|
2481 if (! changed) |
ddee29e260d2
(make_buffer_string): Don't copy intervals
Richard M. Stallman <rms@gnu.org>
parents:
4943
diff
changeset
|
2482 { |
26853
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2483 changed = pos; |
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2484 modify_region (current_buffer, changed, XINT (end)); |
5242
0e99ea9941e2
(Fmessage): Use message2.
Richard M. Stallman <rms@gnu.org>
parents:
5130
diff
changeset
|
2485 |
0e99ea9941e2
(Fmessage): Use message2.
Richard M. Stallman <rms@gnu.org>
parents:
5130
diff
changeset
|
2486 if (! NILP (noundo)) |
0e99ea9941e2
(Fmessage): Use message2.
Richard M. Stallman <rms@gnu.org>
parents:
5130
diff
changeset
|
2487 { |
10308
90784ed0416f
Use SAVE_MODIFF and BUF_SAVE_MODIFF
Richard M. Stallman <rms@gnu.org>
parents:
9812
diff
changeset
|
2488 if (MODIFF - 1 == SAVE_MODIFF) |
90784ed0416f
Use SAVE_MODIFF and BUF_SAVE_MODIFF
Richard M. Stallman <rms@gnu.org>
parents:
9812
diff
changeset
|
2489 SAVE_MODIFF++; |
5242
0e99ea9941e2
(Fmessage): Use message2.
Richard M. Stallman <rms@gnu.org>
parents:
5130
diff
changeset
|
2490 if (MODIFF - 1 == current_buffer->auto_save_modified) |
0e99ea9941e2
(Fmessage): Use message2.
Richard M. Stallman <rms@gnu.org>
parents:
5130
diff
changeset
|
2491 current_buffer->auto_save_modified++; |
0e99ea9941e2
(Fmessage): Use message2.
Richard M. Stallman <rms@gnu.org>
parents:
5130
diff
changeset
|
2492 } |
5130
ddee29e260d2
(make_buffer_string): Don't copy intervals
Richard M. Stallman <rms@gnu.org>
parents:
4943
diff
changeset
|
2493 } |
ddee29e260d2
(make_buffer_string): Don't copy intervals
Richard M. Stallman <rms@gnu.org>
parents:
4943
diff
changeset
|
2494 |
22895
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2495 /* Take care of the case where the new character |
30480 | 2496 combines with neighboring bytes. */ |
23554
e06e84c477fa
(Fsubst_char_in_region): Correctly handle the case
Kenichi Handa <handa@m17n.org>
parents:
23553
diff
changeset
|
2497 if (maybe_byte_combining |
25507
b9b4581adf36
(Fsubst_char_in_region): Adjust the way to check byte-combining
Kenichi Handa <handa@m17n.org>
parents:
25346
diff
changeset
|
2498 && (maybe_byte_combining == COMBINING_AFTER |
b9b4581adf36
(Fsubst_char_in_region): Adjust the way to check byte-combining
Kenichi Handa <handa@m17n.org>
parents:
25346
diff
changeset
|
2499 ? (pos_byte_next < Z_BYTE |
b9b4581adf36
(Fsubst_char_in_region): Adjust the way to check byte-combining
Kenichi Handa <handa@m17n.org>
parents:
25346
diff
changeset
|
2500 && ! CHAR_HEAD_P (FETCH_BYTE (pos_byte_next))) |
b9b4581adf36
(Fsubst_char_in_region): Adjust the way to check byte-combining
Kenichi Handa <handa@m17n.org>
parents:
25346
diff
changeset
|
2501 : ((pos_byte_next < Z_BYTE |
b9b4581adf36
(Fsubst_char_in_region): Adjust the way to check byte-combining
Kenichi Handa <handa@m17n.org>
parents:
25346
diff
changeset
|
2502 && ! CHAR_HEAD_P (FETCH_BYTE (pos_byte_next))) |
b9b4581adf36
(Fsubst_char_in_region): Adjust the way to check byte-combining
Kenichi Handa <handa@m17n.org>
parents:
25346
diff
changeset
|
2503 || (pos_byte > BEG_BYTE |
b9b4581adf36
(Fsubst_char_in_region): Adjust the way to check byte-combining
Kenichi Handa <handa@m17n.org>
parents:
25346
diff
changeset
|
2504 && ! ASCII_BYTE_P (FETCH_BYTE (pos_byte - 1)))))) |
22895
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2505 { |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2506 Lisp_Object tem, string; |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2507 |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2508 struct gcpro gcpro1; |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2509 |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2510 tem = current_buffer->undo_list; |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2511 GCPRO1 (tem); |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2512 |
25507
b9b4581adf36
(Fsubst_char_in_region): Adjust the way to check byte-combining
Kenichi Handa <handa@m17n.org>
parents:
25346
diff
changeset
|
2513 /* Make a multibyte string containing this single character. */ |
b9b4581adf36
(Fsubst_char_in_region): Adjust the way to check byte-combining
Kenichi Handa <handa@m17n.org>
parents:
25346
diff
changeset
|
2514 string = make_multibyte_string (tostr, 1, len); |
22895
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2515 /* replace_range is less efficient, because it moves the gap, |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2516 but it handles combining correctly. */ |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2517 replace_range (pos, pos + 1, string, |
23211
d7bd20e02b1d
(Fsubst_char_in_region): Call replace_range with the
Kenichi Handa <handa@m17n.org>
parents:
23198
diff
changeset
|
2518 0, 0, 1); |
23554
e06e84c477fa
(Fsubst_char_in_region): Correctly handle the case
Kenichi Handa <handa@m17n.org>
parents:
23553
diff
changeset
|
2519 pos_byte_next = CHAR_TO_BYTE (pos); |
e06e84c477fa
(Fsubst_char_in_region): Correctly handle the case
Kenichi Handa <handa@m17n.org>
parents:
23553
diff
changeset
|
2520 if (pos_byte_next > pos_byte) |
e06e84c477fa
(Fsubst_char_in_region): Correctly handle the case
Kenichi Handa <handa@m17n.org>
parents:
23553
diff
changeset
|
2521 /* Before combining happened. We should not increment |
23565
077655e1e014
(Fsubst_char_in_region): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23554
diff
changeset
|
2522 POS. So, to cancel the later increment of POS, |
077655e1e014
(Fsubst_char_in_region): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23554
diff
changeset
|
2523 decrease it now. */ |
077655e1e014
(Fsubst_char_in_region): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23554
diff
changeset
|
2524 pos--; |
23554
e06e84c477fa
(Fsubst_char_in_region): Correctly handle the case
Kenichi Handa <handa@m17n.org>
parents:
23553
diff
changeset
|
2525 else |
23565
077655e1e014
(Fsubst_char_in_region): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23554
diff
changeset
|
2526 INC_POS (pos_byte_next); |
30480 | 2527 |
22895
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2528 if (! NILP (noundo)) |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2529 current_buffer->undo_list = tem; |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2530 |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2531 UNGCPRO; |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2532 } |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2533 else |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2534 { |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2535 if (NILP (noundo)) |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2536 record_change (pos, 1); |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2537 for (i = 0; i < len; i++) *p++ = tostr[i]; |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2538 } |
26853
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2539 last_changed = pos + 1; |
305 | 2540 } |
23565
077655e1e014
(Fsubst_char_in_region): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23554
diff
changeset
|
2541 pos_byte = pos_byte_next; |
077655e1e014
(Fsubst_char_in_region): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23554
diff
changeset
|
2542 pos++; |
305 | 2543 } |
2544 | |
5130
ddee29e260d2
(make_buffer_string): Don't copy intervals
Richard M. Stallman <rms@gnu.org>
parents:
4943
diff
changeset
|
2545 if (changed) |
26853
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2546 { |
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2547 signal_after_change (changed, |
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2548 last_changed - changed, last_changed - changed); |
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2549 update_compositions (changed, last_changed, CHECK_ALL); |
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2550 } |
5130
ddee29e260d2
(make_buffer_string): Don't copy intervals
Richard M. Stallman <rms@gnu.org>
parents:
4943
diff
changeset
|
2551 |
10480
fbb254882b9f
(subst_char_in_region_unwind): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10383
diff
changeset
|
2552 unbind_to (count, Qnil); |
305 | 2553 return Qnil; |
2554 } | |
2555 | |
2556 DEFUN ("translate-region", Ftranslate_region, Stranslate_region, 3, 3, 0, | |
2557 "From START to END, translate characters according to TABLE.\n\ | |
2558 TABLE is a string; the Nth character in it is the mapping\n\ | |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
2559 for the character with code N.\n\ |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
2560 This function does not alter multibyte characters.\n\ |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
2561 It returns the number of characters changed.") |
305 | 2562 (start, end, table) |
2563 Lisp_Object start; | |
2564 Lisp_Object end; | |
2565 register Lisp_Object table; | |
2566 { | |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
2567 register int pos_byte, stop; /* Limits of the region. */ |
305 | 2568 register unsigned char *tt; /* Trans table. */ |
2569 register int nc; /* New character. */ | |
2570 int cnt; /* Number of changes made. */ | |
2571 int size; /* Size of translate table. */ | |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
2572 int pos; |
26415
bda6a3a2bf96
(Ftranslate_region): Check the buffer multibyteness.
Kenichi Handa <handa@m17n.org>
parents:
26389
diff
changeset
|
2573 int multibyte = !NILP (current_buffer->enable_multibyte_characters); |
305 | 2574 |
2575 validate_region (&start, &end); | |
2576 CHECK_STRING (table, 2); | |
2577 | |
21245
6cde55b7c9de
Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents:
21235
diff
changeset
|
2578 size = STRING_BYTES (XSTRING (table)); |
305 | 2579 tt = XSTRING (table)->data; |
2580 | |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
2581 pos_byte = CHAR_TO_BYTE (XINT (start)); |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
2582 stop = CHAR_TO_BYTE (XINT (end)); |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
2583 modify_region (current_buffer, XINT (start), XINT (end)); |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
2584 pos = XINT (start); |
305 | 2585 |
2586 cnt = 0; | |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
2587 for (; pos_byte < stop; ) |
305 | 2588 { |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
2589 register unsigned char *p = BYTE_POS_ADDR (pos_byte); |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
2590 int len; |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
2591 int oc; |
23554
e06e84c477fa
(Fsubst_char_in_region): Correctly handle the case
Kenichi Handa <handa@m17n.org>
parents:
23553
diff
changeset
|
2592 int pos_byte_next; |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
2593 |
26415
bda6a3a2bf96
(Ftranslate_region): Check the buffer multibyteness.
Kenichi Handa <handa@m17n.org>
parents:
26389
diff
changeset
|
2594 if (multibyte) |
bda6a3a2bf96
(Ftranslate_region): Check the buffer multibyteness.
Kenichi Handa <handa@m17n.org>
parents:
26389
diff
changeset
|
2595 oc = STRING_CHAR_AND_LENGTH (p, stop - pos_byte, len); |
bda6a3a2bf96
(Ftranslate_region): Check the buffer multibyteness.
Kenichi Handa <handa@m17n.org>
parents:
26389
diff
changeset
|
2596 else |
bda6a3a2bf96
(Ftranslate_region): Check the buffer multibyteness.
Kenichi Handa <handa@m17n.org>
parents:
26389
diff
changeset
|
2597 oc = *p, len = 1; |
23554
e06e84c477fa
(Fsubst_char_in_region): Correctly handle the case
Kenichi Handa <handa@m17n.org>
parents:
23553
diff
changeset
|
2598 pos_byte_next = pos_byte + len; |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
2599 if (oc < size && len == 1) |
305 | 2600 { |
2601 nc = tt[oc]; | |
2602 if (nc != oc) | |
2603 { | |
22895
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2604 /* Take care of the case where the new character |
30480 | 2605 combines with neighboring bytes. */ |
23554
e06e84c477fa
(Fsubst_char_in_region): Correctly handle the case
Kenichi Handa <handa@m17n.org>
parents:
23553
diff
changeset
|
2606 if (!ASCII_BYTE_P (nc) |
e06e84c477fa
(Fsubst_char_in_region): Correctly handle the case
Kenichi Handa <handa@m17n.org>
parents:
23553
diff
changeset
|
2607 && (CHAR_HEAD_P (nc) |
e06e84c477fa
(Fsubst_char_in_region): Correctly handle the case
Kenichi Handa <handa@m17n.org>
parents:
23553
diff
changeset
|
2608 ? ! CHAR_HEAD_P (FETCH_BYTE (pos_byte + 1)) |
23596
8dcbcad4482c
(Fsubst_char_in_region): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23577
diff
changeset
|
2609 : (pos_byte > BEG_BYTE |
23554
e06e84c477fa
(Fsubst_char_in_region): Correctly handle the case
Kenichi Handa <handa@m17n.org>
parents:
23553
diff
changeset
|
2610 && ! ASCII_BYTE_P (FETCH_BYTE (pos_byte - 1))))) |
22895
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2611 { |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2612 Lisp_Object string; |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2613 |
23554
e06e84c477fa
(Fsubst_char_in_region): Correctly handle the case
Kenichi Handa <handa@m17n.org>
parents:
23553
diff
changeset
|
2614 string = make_multibyte_string (tt + oc, 1, 1); |
22895
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2615 /* This is less efficient, because it moves the gap, |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2616 but it handles combining correctly. */ |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2617 replace_range (pos, pos + 1, string, |
23554
e06e84c477fa
(Fsubst_char_in_region): Correctly handle the case
Kenichi Handa <handa@m17n.org>
parents:
23553
diff
changeset
|
2618 1, 0, 1); |
e06e84c477fa
(Fsubst_char_in_region): Correctly handle the case
Kenichi Handa <handa@m17n.org>
parents:
23553
diff
changeset
|
2619 pos_byte_next = CHAR_TO_BYTE (pos); |
e06e84c477fa
(Fsubst_char_in_region): Correctly handle the case
Kenichi Handa <handa@m17n.org>
parents:
23553
diff
changeset
|
2620 if (pos_byte_next > pos_byte) |
e06e84c477fa
(Fsubst_char_in_region): Correctly handle the case
Kenichi Handa <handa@m17n.org>
parents:
23553
diff
changeset
|
2621 /* Before combining happened. We should not |
23565
077655e1e014
(Fsubst_char_in_region): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23554
diff
changeset
|
2622 increment POS. So, to cancel the later |
077655e1e014
(Fsubst_char_in_region): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23554
diff
changeset
|
2623 increment of POS, we decrease it now. */ |
077655e1e014
(Fsubst_char_in_region): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23554
diff
changeset
|
2624 pos--; |
23554
e06e84c477fa
(Fsubst_char_in_region): Correctly handle the case
Kenichi Handa <handa@m17n.org>
parents:
23553
diff
changeset
|
2625 else |
23565
077655e1e014
(Fsubst_char_in_region): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23554
diff
changeset
|
2626 INC_POS (pos_byte_next); |
22895
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2627 } |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2628 else |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2629 { |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2630 record_change (pos, 1); |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2631 *p = nc; |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2632 signal_after_change (pos, 1, 1); |
26853
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2633 update_compositions (pos, pos + 1, CHECK_BORDER); |
22895
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2634 } |
305 | 2635 ++cnt; |
2636 } | |
2637 } | |
23565
077655e1e014
(Fsubst_char_in_region): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23554
diff
changeset
|
2638 pos_byte = pos_byte_next; |
077655e1e014
(Fsubst_char_in_region): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23554
diff
changeset
|
2639 pos++; |
305 | 2640 } |
2641 | |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
2642 return make_number (cnt); |
305 | 2643 } |
2644 | |
2645 DEFUN ("delete-region", Fdelete_region, Sdelete_region, 2, 2, "r", | |
2646 "Delete the text between point and mark.\n\ | |
2647 When called from a program, expects two arguments,\n\ | |
2648 positions (integers or markers) specifying the stretch to be deleted.") | |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2649 (start, end) |
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2650 Lisp_Object start, end; |
305 | 2651 { |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2652 validate_region (&start, &end); |
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2653 del_range (XINT (start), XINT (end)); |
305 | 2654 return Qnil; |
2655 } | |
26742
936b39bd05b4
* editfns.c (Fdelete_and_extract_region): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
26699
diff
changeset
|
2656 |
936b39bd05b4
* editfns.c (Fdelete_and_extract_region): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
26699
diff
changeset
|
2657 DEFUN ("delete-and-extract-region", Fdelete_and_extract_region, |
936b39bd05b4
* editfns.c (Fdelete_and_extract_region): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
26699
diff
changeset
|
2658 Sdelete_and_extract_region, 2, 2, 0, |
936b39bd05b4
* editfns.c (Fdelete_and_extract_region): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
26699
diff
changeset
|
2659 "Delete the text between START and END and return it.") |
936b39bd05b4
* editfns.c (Fdelete_and_extract_region): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
26699
diff
changeset
|
2660 (start, end) |
936b39bd05b4
* editfns.c (Fdelete_and_extract_region): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
26699
diff
changeset
|
2661 Lisp_Object start, end; |
936b39bd05b4
* editfns.c (Fdelete_and_extract_region): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
26699
diff
changeset
|
2662 { |
936b39bd05b4
* editfns.c (Fdelete_and_extract_region): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
26699
diff
changeset
|
2663 validate_region (&start, &end); |
936b39bd05b4
* editfns.c (Fdelete_and_extract_region): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
26699
diff
changeset
|
2664 return del_range_1 (XINT (start), XINT (end), 1, 1); |
936b39bd05b4
* editfns.c (Fdelete_and_extract_region): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
26699
diff
changeset
|
2665 } |
305 | 2666 |
2667 DEFUN ("widen", Fwiden, Swiden, 0, 0, "", | |
2668 "Remove restrictions (narrowing) from current buffer.\n\ | |
2669 This allows the buffer's full text to be seen and edited.") | |
2670 () | |
2671 { | |
19207
be370e94fb42
(Fwiden, Fnarrow_to_region, save_restriction_restore):
Richard M. Stallman <rms@gnu.org>
parents:
19032
diff
changeset
|
2672 if (BEG != BEGV || Z != ZV) |
be370e94fb42
(Fwiden, Fnarrow_to_region, save_restriction_restore):
Richard M. Stallman <rms@gnu.org>
parents:
19032
diff
changeset
|
2673 current_buffer->clip_changed = 1; |
305 | 2674 BEGV = BEG; |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
2675 BEGV_BYTE = BEG_BYTE; |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
2676 SET_BUF_ZV_BOTH (current_buffer, Z, Z_BYTE); |
330 | 2677 /* Changing the buffer bounds invalidates any recorded current column. */ |
2678 invalidate_current_column (); | |
305 | 2679 return Qnil; |
2680 } | |
2681 | |
2682 DEFUN ("narrow-to-region", Fnarrow_to_region, Snarrow_to_region, 2, 2, "r", | |
2683 "Restrict editing in this buffer to the current region.\n\ | |
2684 The rest of the text becomes temporarily invisible and untouchable\n\ | |
2685 but is not deleted; if you save the buffer in a file, the invisible\n\ | |
2686 text is included in the file. \\[widen] makes all visible again.\n\ | |
2687 See also `save-restriction'.\n\ | |
2688 \n\ | |
2689 When calling from a program, pass two arguments; positions (integers\n\ | |
2690 or markers) bounding the text that should remain visible.") | |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2691 (start, end) |
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2692 register Lisp_Object start, end; |
305 | 2693 { |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2694 CHECK_NUMBER_COERCE_MARKER (start, 0); |
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2695 CHECK_NUMBER_COERCE_MARKER (end, 1); |
305 | 2696 |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2697 if (XINT (start) > XINT (end)) |
305 | 2698 { |
10383
a7fe0fb11314
(Fnarrow_to_region): Swap using temp Lisp_Object, not int.
Karl Heuer <kwzh@gnu.org>
parents:
10382
diff
changeset
|
2699 Lisp_Object tem; |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2700 tem = start; start = end; end = tem; |
305 | 2701 } |
2702 | |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2703 if (!(BEG <= XINT (start) && XINT (start) <= XINT (end) && XINT (end) <= Z)) |
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2704 args_out_of_range (start, end); |
305 | 2705 |
19207
be370e94fb42
(Fwiden, Fnarrow_to_region, save_restriction_restore):
Richard M. Stallman <rms@gnu.org>
parents:
19032
diff
changeset
|
2706 if (BEGV != XFASTINT (start) || ZV != XFASTINT (end)) |
be370e94fb42
(Fwiden, Fnarrow_to_region, save_restriction_restore):
Richard M. Stallman <rms@gnu.org>
parents:
19032
diff
changeset
|
2707 current_buffer->clip_changed = 1; |
be370e94fb42
(Fwiden, Fnarrow_to_region, save_restriction_restore):
Richard M. Stallman <rms@gnu.org>
parents:
19032
diff
changeset
|
2708 |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
2709 SET_BUF_BEGV (current_buffer, XFASTINT (start)); |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2710 SET_BUF_ZV (current_buffer, XFASTINT (end)); |
16039
855c8d8ba0f0
Change all references from point to PT.
Karl Heuer <kwzh@gnu.org>
parents:
15910
diff
changeset
|
2711 if (PT < XFASTINT (start)) |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2712 SET_PT (XFASTINT (start)); |
16039
855c8d8ba0f0
Change all references from point to PT.
Karl Heuer <kwzh@gnu.org>
parents:
15910
diff
changeset
|
2713 if (PT > XFASTINT (end)) |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2714 SET_PT (XFASTINT (end)); |
330 | 2715 /* Changing the buffer bounds invalidates any recorded current column. */ |
2716 invalidate_current_column (); | |
305 | 2717 return Qnil; |
2718 } | |
2719 | |
2720 Lisp_Object | |
2721 save_restriction_save () | |
2722 { | |
30931
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
2723 if (BEGV == BEG && ZV == Z) |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
2724 /* The common case that the buffer isn't narrowed. |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
2725 We return just the buffer object, which save_restriction_restore |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
2726 recognizes as meaning `no restriction'. */ |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
2727 return Fcurrent_buffer (); |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
2728 else |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
2729 /* We have to save a restriction, so return a pair of markers, one |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
2730 for the beginning and one for the end. */ |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
2731 { |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
2732 Lisp_Object beg, end; |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
2733 |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
2734 beg = buildmark (BEGV, BEGV_BYTE); |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
2735 end = buildmark (ZV, ZV_BYTE); |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
2736 |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
2737 /* END must move forward if text is inserted at its exact location. */ |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
2738 XMARKER(end)->insertion_type = 1; |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
2739 |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
2740 return Fcons (beg, end); |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
2741 } |
305 | 2742 } |
2743 | |
2744 Lisp_Object | |
2745 save_restriction_restore (data) | |
2746 Lisp_Object data; | |
2747 { | |
30931
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
2748 if (CONSP (data)) |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
2749 /* A pair of marks bounding a saved restriction. */ |
305 | 2750 { |
30931
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
2751 struct Lisp_Marker *beg = XMARKER (XCAR (data)); |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
2752 struct Lisp_Marker *end = XMARKER (XCDR (data)); |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
2753 struct buffer *buf = beg->buffer; /* END should have the same buffer. */ |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
2754 |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
2755 if (beg->charpos != BUF_BEGV(buf) || end->charpos != BUF_ZV(buf)) |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
2756 /* The restriction has changed from the saved one, so restore |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
2757 the saved restriction. */ |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
2758 { |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
2759 int pt = BUF_PT (buf); |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
2760 |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
2761 SET_BUF_BEGV_BOTH (buf, beg->charpos, beg->bytepos); |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
2762 SET_BUF_ZV_BOTH (buf, end->charpos, end->bytepos); |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
2763 |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
2764 if (pt < beg->charpos || pt > end->charpos) |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
2765 /* The point is outside the new visible range, move it inside. */ |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
2766 SET_BUF_PT_BOTH (buf, |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
2767 clip_to_bounds (beg->charpos, pt, end->charpos), |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
2768 clip_to_bounds (beg->bytepos, BUF_PT_BYTE(buf), |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
2769 end->bytepos)); |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
2770 |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
2771 buf->clip_changed = 1; /* Remember that the narrowing changed. */ |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
2772 } |
305 | 2773 } |
30931
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
2774 else |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
2775 /* A buffer, which means that there was no old restriction. */ |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
2776 { |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
2777 struct buffer *buf = XBUFFER (data); |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
2778 |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
2779 if (BUF_BEGV(buf) != BUF_BEG(buf) || BUF_ZV(buf) != BUF_Z(buf)) |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
2780 /* The buffer has been narrowed, get rid of the narrowing. */ |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
2781 { |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
2782 SET_BUF_BEGV_BOTH (buf, BUF_BEG(buf), BUF_BEG_BYTE(buf)); |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
2783 SET_BUF_ZV_BOTH (buf, BUF_Z(buf), BUF_Z_BYTE(buf)); |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
2784 |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
2785 buf->clip_changed = 1; /* Remember that the narrowing changed. */ |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
2786 } |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
2787 } |
305 | 2788 |
2789 return Qnil; | |
2790 } | |
2791 | |
2792 DEFUN ("save-restriction", Fsave_restriction, Ssave_restriction, 0, UNEVALLED, 0, | |
2793 "Execute BODY, saving and restoring current buffer's restrictions.\n\ | |
2794 The buffer's restrictions make parts of the beginning and end invisible.\n\ | |
2795 \(They are set up with `narrow-to-region' and eliminated with `widen'.)\n\ | |
2796 This special form, `save-restriction', saves the current buffer's restrictions\n\ | |
2797 when it is entered, and restores them when it is exited.\n\ | |
2798 So any `narrow-to-region' within BODY lasts only until the end of the form.\n\ | |
2799 The old restrictions settings are restored\n\ | |
2800 even in case of abnormal exit (throw or error).\n\ | |
2801 \n\ | |
2802 The value returned is the value of the last form in BODY.\n\ | |
2803 \n\ | |
2804 Note: if you are using both `save-excursion' and `save-restriction',\n\ | |
2805 use `save-excursion' outermost:\n\ | |
2806 (save-excursion (save-restriction ...))") | |
2807 (body) | |
2808 Lisp_Object body; | |
2809 { | |
2810 register Lisp_Object val; | |
2811 int count = specpdl_ptr - specpdl; | |
2812 | |
2813 record_unwind_protect (save_restriction_restore, save_restriction_save ()); | |
2814 val = Fprogn (body); | |
2815 return unbind_to (count, val); | |
2816 } | |
2817 | |
25782
8f59abd3a02b
(init_editfns): Remove unused variables.
Gerd Moellmann <gerd@gnu.org>
parents:
25662
diff
changeset
|
2818 #ifndef HAVE_MENUS |
8f59abd3a02b
(init_editfns): Remove unused variables.
Gerd Moellmann <gerd@gnu.org>
parents:
25662
diff
changeset
|
2819 |
5884
d02095ea13a5
(Fmessage): Copy the text to be displayed into a malloc'd buffer.
Karl Heuer <kwzh@gnu.org>
parents:
5882
diff
changeset
|
2820 /* Buffer for the most recent text displayed by Fmessage. */ |
d02095ea13a5
(Fmessage): Copy the text to be displayed into a malloc'd buffer.
Karl Heuer <kwzh@gnu.org>
parents:
5882
diff
changeset
|
2821 static char *message_text; |
d02095ea13a5
(Fmessage): Copy the text to be displayed into a malloc'd buffer.
Karl Heuer <kwzh@gnu.org>
parents:
5882
diff
changeset
|
2822 |
d02095ea13a5
(Fmessage): Copy the text to be displayed into a malloc'd buffer.
Karl Heuer <kwzh@gnu.org>
parents:
5882
diff
changeset
|
2823 /* Allocated length of that buffer. */ |
d02095ea13a5
(Fmessage): Copy the text to be displayed into a malloc'd buffer.
Karl Heuer <kwzh@gnu.org>
parents:
5882
diff
changeset
|
2824 static int message_length; |
d02095ea13a5
(Fmessage): Copy the text to be displayed into a malloc'd buffer.
Karl Heuer <kwzh@gnu.org>
parents:
5882
diff
changeset
|
2825 |
25782
8f59abd3a02b
(init_editfns): Remove unused variables.
Gerd Moellmann <gerd@gnu.org>
parents:
25662
diff
changeset
|
2826 #endif /* not HAVE_MENUS */ |
8f59abd3a02b
(init_editfns): Remove unused variables.
Gerd Moellmann <gerd@gnu.org>
parents:
25662
diff
changeset
|
2827 |
305 | 2828 DEFUN ("message", Fmessage, Smessage, 1, MANY, 0, |
2829 "Print a one-line message at the bottom of the screen.\n\ | |
12602 | 2830 The first argument is a format control string, and the rest are data\n\ |
2831 to be formatted under control of the string. See `format' for details.\n\ | |
2832 \n\ | |
1426
67fd35416ba3
* * editfns.c (Fmessage): With no arguments, clear any active
Jim Blandy <jimb@redhat.com>
parents:
1285
diff
changeset
|
2833 If the first argument is nil, clear any existing message; let the\n\ |
67fd35416ba3
* * editfns.c (Fmessage): With no arguments, clear any active
Jim Blandy <jimb@redhat.com>
parents:
1285
diff
changeset
|
2834 minibuffer contents show.") |
305 | 2835 (nargs, args) |
2836 int nargs; | |
2837 Lisp_Object *args; | |
2838 { | |
1426
67fd35416ba3
* * editfns.c (Fmessage): With no arguments, clear any active
Jim Blandy <jimb@redhat.com>
parents:
1285
diff
changeset
|
2839 if (NILP (args[0])) |
1916
e21c1f3e37cb
* editfns.c (Fmessage): Don't forget to return a value when
Jim Blandy <jimb@redhat.com>
parents:
1854
diff
changeset
|
2840 { |
e21c1f3e37cb
* editfns.c (Fmessage): Don't forget to return a value when
Jim Blandy <jimb@redhat.com>
parents:
1854
diff
changeset
|
2841 message (0); |
e21c1f3e37cb
* editfns.c (Fmessage): Don't forget to return a value when
Jim Blandy <jimb@redhat.com>
parents:
1854
diff
changeset
|
2842 return Qnil; |
e21c1f3e37cb
* editfns.c (Fmessage): Don't forget to return a value when
Jim Blandy <jimb@redhat.com>
parents:
1854
diff
changeset
|
2843 } |
1426
67fd35416ba3
* * editfns.c (Fmessage): With no arguments, clear any active
Jim Blandy <jimb@redhat.com>
parents:
1285
diff
changeset
|
2844 else |
67fd35416ba3
* * editfns.c (Fmessage): With no arguments, clear any active
Jim Blandy <jimb@redhat.com>
parents:
1285
diff
changeset
|
2845 { |
67fd35416ba3
* * editfns.c (Fmessage): With no arguments, clear any active
Jim Blandy <jimb@redhat.com>
parents:
1285
diff
changeset
|
2846 register Lisp_Object val; |
67fd35416ba3
* * editfns.c (Fmessage): With no arguments, clear any active
Jim Blandy <jimb@redhat.com>
parents:
1285
diff
changeset
|
2847 val = Fformat (nargs, args); |
25018 | 2848 message3 (val, STRING_BYTES (XSTRING (val)), STRING_MULTIBYTE (val)); |
1426
67fd35416ba3
* * editfns.c (Fmessage): With no arguments, clear any active
Jim Blandy <jimb@redhat.com>
parents:
1285
diff
changeset
|
2849 return val; |
67fd35416ba3
* * editfns.c (Fmessage): With no arguments, clear any active
Jim Blandy <jimb@redhat.com>
parents:
1285
diff
changeset
|
2850 } |
305 | 2851 } |
2852 | |
8975
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
2853 DEFUN ("message-box", Fmessage_box, Smessage_box, 1, MANY, 0, |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
2854 "Display a message, in a dialog box if possible.\n\ |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
2855 If a dialog box is not available, use the echo area.\n\ |
13878
2a71500dfb93
(Fmessage_box, Fmessage_or_box):
Richard M. Stallman <rms@gnu.org>
parents:
13767
diff
changeset
|
2856 The first argument is a format control string, and the rest are data\n\ |
2a71500dfb93
(Fmessage_box, Fmessage_or_box):
Richard M. Stallman <rms@gnu.org>
parents:
13767
diff
changeset
|
2857 to be formatted under control of the string. See `format' for details.\n\ |
2a71500dfb93
(Fmessage_box, Fmessage_or_box):
Richard M. Stallman <rms@gnu.org>
parents:
13767
diff
changeset
|
2858 \n\ |
8975
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
2859 If the first argument is nil, clear any existing message; let the\n\ |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
2860 minibuffer contents show.") |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
2861 (nargs, args) |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
2862 int nargs; |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
2863 Lisp_Object *args; |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
2864 { |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
2865 if (NILP (args[0])) |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
2866 { |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
2867 message (0); |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
2868 return Qnil; |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
2869 } |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
2870 else |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
2871 { |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
2872 register Lisp_Object val; |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
2873 val = Fformat (nargs, args); |
13878
2a71500dfb93
(Fmessage_box, Fmessage_or_box):
Richard M. Stallman <rms@gnu.org>
parents:
13767
diff
changeset
|
2874 #ifdef HAVE_MENUS |
8975
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
2875 { |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
2876 Lisp_Object pane, menu, obj; |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
2877 struct gcpro gcpro1; |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
2878 pane = Fcons (Fcons (build_string ("OK"), Qt), Qnil); |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
2879 GCPRO1 (pane); |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
2880 menu = Fcons (val, pane); |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
2881 obj = Fx_popup_dialog (Qt, menu); |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
2882 UNGCPRO; |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
2883 return val; |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
2884 } |
13878
2a71500dfb93
(Fmessage_box, Fmessage_or_box):
Richard M. Stallman <rms@gnu.org>
parents:
13767
diff
changeset
|
2885 #else /* not HAVE_MENUS */ |
8975
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
2886 /* Copy the data so that it won't move when we GC. */ |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
2887 if (! message_text) |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
2888 { |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
2889 message_text = (char *)xmalloc (80); |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
2890 message_length = 80; |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
2891 } |
21245
6cde55b7c9de
Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents:
21235
diff
changeset
|
2892 if (STRING_BYTES (XSTRING (val)) > message_length) |
8975
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
2893 { |
21245
6cde55b7c9de
Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents:
21235
diff
changeset
|
2894 message_length = STRING_BYTES (XSTRING (val)); |
8975
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
2895 message_text = (char *)xrealloc (message_text, message_length); |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
2896 } |
21245
6cde55b7c9de
Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents:
21235
diff
changeset
|
2897 bcopy (XSTRING (val)->data, message_text, STRING_BYTES (XSTRING (val))); |
21358
e9f7d8708bae
(Fmessage_box): Pass the missing third argument
Richard M. Stallman <rms@gnu.org>
parents:
21257
diff
changeset
|
2898 message2 (message_text, STRING_BYTES (XSTRING (val)), |
e9f7d8708bae
(Fmessage_box): Pass the missing third argument
Richard M. Stallman <rms@gnu.org>
parents:
21257
diff
changeset
|
2899 STRING_MULTIBYTE (val)); |
8975
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
2900 return val; |
13878
2a71500dfb93
(Fmessage_box, Fmessage_or_box):
Richard M. Stallman <rms@gnu.org>
parents:
13767
diff
changeset
|
2901 #endif /* not HAVE_MENUS */ |
8975
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
2902 } |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
2903 } |
13878
2a71500dfb93
(Fmessage_box, Fmessage_or_box):
Richard M. Stallman <rms@gnu.org>
parents:
13767
diff
changeset
|
2904 #ifdef HAVE_MENUS |
8975
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
2905 extern Lisp_Object last_nonmenu_event; |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
2906 #endif |
13878
2a71500dfb93
(Fmessage_box, Fmessage_or_box):
Richard M. Stallman <rms@gnu.org>
parents:
13767
diff
changeset
|
2907 |
8975
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
2908 DEFUN ("message-or-box", Fmessage_or_box, Smessage_or_box, 1, MANY, 0, |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
2909 "Display a message in a dialog box or in the echo area.\n\ |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
2910 If this command was invoked with the mouse, use a dialog box.\n\ |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
2911 Otherwise, use the echo area.\n\ |
13878
2a71500dfb93
(Fmessage_box, Fmessage_or_box):
Richard M. Stallman <rms@gnu.org>
parents:
13767
diff
changeset
|
2912 The first argument is a format control string, and the rest are data\n\ |
2a71500dfb93
(Fmessage_box, Fmessage_or_box):
Richard M. Stallman <rms@gnu.org>
parents:
13767
diff
changeset
|
2913 to be formatted under control of the string. See `format' for details.\n\ |
8975
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
2914 \n\ |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
2915 If the first argument is nil, clear any existing message; let the\n\ |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
2916 minibuffer contents show.") |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
2917 (nargs, args) |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
2918 int nargs; |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
2919 Lisp_Object *args; |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
2920 { |
13878
2a71500dfb93
(Fmessage_box, Fmessage_or_box):
Richard M. Stallman <rms@gnu.org>
parents:
13767
diff
changeset
|
2921 #ifdef HAVE_MENUS |
26699
ed4ab9d24450
(Fmessage_or_box): Use use_dialog_box.
Dave Love <fx@gnu.org>
parents:
26629
diff
changeset
|
2922 if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event)) |
28470
93996c44b23a
* editfns.c (text_property_stickiness, Fmessage_or_box): Use NILP to test
Ken Raeburn <raeburn@raeburn.org>
parents:
28358
diff
changeset
|
2923 && use_dialog_box) |
8981
6e1a5ff3d795
(Fmessage_or_box): Use Fmessage_box with new name.
Richard M. Stallman <rms@gnu.org>
parents:
8975
diff
changeset
|
2924 return Fmessage_box (nargs, args); |
8975
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
2925 #endif |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
2926 return Fmessage (nargs, args); |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
2927 } |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
2928 |
18937
ddb91108a9d2
(Fcurrent_message): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18756
diff
changeset
|
2929 DEFUN ("current-message", Fcurrent_message, Scurrent_message, 0, 0, 0, |
ddb91108a9d2
(Fcurrent_message): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18756
diff
changeset
|
2930 "Return the string currently displayed in the echo area, or nil if none.") |
ddb91108a9d2
(Fcurrent_message): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18756
diff
changeset
|
2931 () |
ddb91108a9d2
(Fcurrent_message): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18756
diff
changeset
|
2932 { |
25346
15ec35852b48
Remove conditional compilation on NO_PROMPT_IN_BUFFER.
Gerd Moellmann <gerd@gnu.org>
parents:
25018
diff
changeset
|
2933 return current_message (); |
18937
ddb91108a9d2
(Fcurrent_message): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18756
diff
changeset
|
2934 } |
ddb91108a9d2
(Fcurrent_message): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18756
diff
changeset
|
2935 |
25815 | 2936 |
25833
65cab65c4a28
(Fpropertize): Renamed from Fproperties.
Gerd Moellmann <gerd@gnu.org>
parents:
25815
diff
changeset
|
2937 DEFUN ("propertize", Fpropertize, Spropertize, 3, MANY, 0, |
25815 | 2938 "Return a copy of STRING with text properties added.\n\ |
2939 First argument is the string to copy.\n\ | |
27559 | 2940 Remaining arguments form a sequence of PROPERTY VALUE pairs for text\n\ |
25815 | 2941 properties to add to the result ") |
2942 (nargs, args) | |
2943 int nargs; | |
2944 Lisp_Object *args; | |
2945 { | |
2946 Lisp_Object properties, string; | |
2947 struct gcpro gcpro1, gcpro2; | |
2948 int i; | |
2949 | |
2950 /* Number of args must be odd. */ | |
2951 if ((nargs & 1) == 0 || nargs < 3) | |
2952 error ("Wrong number of arguments"); | |
2953 | |
2954 properties = string = Qnil; | |
2955 GCPRO2 (properties, string); | |
30480 | 2956 |
25815 | 2957 /* First argument must be a string. */ |
2958 CHECK_STRING (args[0], 0); | |
2959 string = Fcopy_sequence (args[0]); | |
2960 | |
2961 for (i = 1; i < nargs; i += 2) | |
2962 { | |
2963 CHECK_SYMBOL (args[i], i); | |
2964 properties = Fcons (args[i], Fcons (args[i + 1], properties)); | |
2965 } | |
2966 | |
2967 Fadd_text_properties (make_number (0), | |
2968 make_number (XSTRING (string)->size), | |
2969 properties, string); | |
2970 RETURN_UNGCPRO (string); | |
2971 } | |
2972 | |
2973 | |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
2974 /* Number of bytes that STRING will occupy when put into the result. |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
2975 MULTIBYTE is nonzero if the result should be multibyte. */ |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
2976 |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
2977 #define CONVERTED_BYTE_SIZE(MULTIBYTE, STRING) \ |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
2978 (((MULTIBYTE) && ! STRING_MULTIBYTE (STRING)) \ |
20804
14fa73136e64
(CONVERTED_BYTE_SIZE): Fix the logic.
Kenichi Handa <handa@m17n.org>
parents:
20706
diff
changeset
|
2979 ? count_size_as_multibyte (XSTRING (STRING)->data, \ |
21245
6cde55b7c9de
Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents:
21235
diff
changeset
|
2980 STRING_BYTES (XSTRING (STRING))) \ |
6cde55b7c9de
Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents:
21235
diff
changeset
|
2981 : STRING_BYTES (XSTRING (STRING))) |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
2982 |
305 | 2983 DEFUN ("format", Fformat, Sformat, 1, MANY, 0, |
2984 "Format a string out of a control-string and arguments.\n\ | |
2985 The first argument is a control string.\n\ | |
2986 The other arguments are substituted into it to make the result, a string.\n\ | |
2987 It may contain %-sequences meaning to substitute the next argument.\n\ | |
2988 %s means print a string argument. Actually, prints any object, with `princ'.\n\ | |
2989 %d means print as number in decimal (%o octal, %x hex).\n\ | |
12623 | 2990 %e means print a number in exponential notation.\n\ |
2991 %f means print a number in decimal-point notation.\n\ | |
2992 %g means print a number in exponential notation\n\ | |
2993 or decimal-point notation, whichever uses fewer characters.\n\ | |
305 | 2994 %c means print a number as a single character.\n\ |
24272 | 2995 %S means print any object as an s-expression (using `prin1').\n\ |
12623 | 2996 The argument used for %d, %o, %x, %e, %f, %g or %c must be a number.\n\ |
330 | 2997 Use %% to put a single % into the output.") |
305 | 2998 (nargs, args) |
2999 int nargs; | |
3000 register Lisp_Object *args; | |
3001 { | |
3002 register int n; /* The number of the next arg to substitute */ | |
20826
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3003 register int total; /* An estimate of the final length */ |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3004 char *buf, *p; |
305 | 3005 register unsigned char *format, *end; |
25782
8f59abd3a02b
(init_editfns): Remove unused variables.
Gerd Moellmann <gerd@gnu.org>
parents:
25662
diff
changeset
|
3006 int nchars; |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3007 /* Nonzero if the output should be a multibyte string, |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3008 which is true if any of the inputs is one. */ |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3009 int multibyte = 0; |
22698
ea6ef56295b4
(Fformat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents:
22669
diff
changeset
|
3010 /* When we make a multibyte string, we must pay attention to the |
ea6ef56295b4
(Fformat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents:
22669
diff
changeset
|
3011 byte combining problem, i.e., a byte may be combined with a |
ea6ef56295b4
(Fformat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents:
22669
diff
changeset
|
3012 multibyte charcter of the previous string. This flag tells if we |
ea6ef56295b4
(Fformat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents:
22669
diff
changeset
|
3013 must consider such a situation or not. */ |
ea6ef56295b4
(Fformat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents:
22669
diff
changeset
|
3014 int maybe_combine_byte; |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3015 unsigned char *this_format; |
20826
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3016 int longest_format; |
20804
14fa73136e64
(CONVERTED_BYTE_SIZE): Fix the logic.
Kenichi Handa <handa@m17n.org>
parents:
20706
diff
changeset
|
3017 Lisp_Object val; |
25018 | 3018 struct info |
3019 { | |
3020 int start, end; | |
3021 } *info = 0; | |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3022 |
305 | 3023 /* It should not be necessary to GCPRO ARGS, because |
3024 the caller in the interpreter should take care of that. */ | |
3025 | |
20826
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3026 /* Try to determine whether the result should be multibyte. |
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3027 This is not always right; sometimes the result needs to be multibyte |
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3028 because of an object that we will pass through prin1, |
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3029 and in that case, we won't know it here. */ |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3030 for (n = 0; n < nargs; n++) |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3031 if (STRINGP (args[n]) && STRING_MULTIBYTE (args[n])) |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3032 multibyte = 1; |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3033 |
305 | 3034 CHECK_STRING (args[0], 0); |
20826
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3035 |
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3036 /* If we start out planning a unibyte result, |
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3037 and later find it has to be multibyte, we jump back to retry. */ |
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3038 retry: |
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3039 |
305 | 3040 format = XSTRING (args[0])->data; |
21245
6cde55b7c9de
Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents:
21235
diff
changeset
|
3041 end = format + STRING_BYTES (XSTRING (args[0])); |
20826
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3042 longest_format = 0; |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3043 |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3044 /* Make room in result for all the non-%-codes in the control string. */ |
20826
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3045 total = 5 + CONVERTED_BYTE_SIZE (multibyte, args[0]); |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3046 |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3047 /* Add to TOTAL enough space to hold the converted arguments. */ |
305 | 3048 |
3049 n = 0; | |
3050 while (format != end) | |
3051 if (*format++ == '%') | |
3052 { | |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3053 int minlen, thissize = 0; |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3054 unsigned char *this_format_start = format - 1; |
305 | 3055 |
3056 /* Process a numeric arg and skip it. */ | |
3057 minlen = atoi (format); | |
12831
3917c5d131d3
(Fformat): Limit minlen to avoid stack overflow.
Richard M. Stallman <rms@gnu.org>
parents:
12623
diff
changeset
|
3058 if (minlen < 0) |
3917c5d131d3
(Fformat): Limit minlen to avoid stack overflow.
Richard M. Stallman <rms@gnu.org>
parents:
12623
diff
changeset
|
3059 minlen = - minlen; |
3917c5d131d3
(Fformat): Limit minlen to avoid stack overflow.
Richard M. Stallman <rms@gnu.org>
parents:
12623
diff
changeset
|
3060 |
305 | 3061 while ((*format >= '0' && *format <= '9') |
3062 || *format == '-' || *format == ' ' || *format == '.') | |
3063 format++; | |
3064 | |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3065 if (format - this_format_start + 1 > longest_format) |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3066 longest_format = format - this_format_start + 1; |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3067 |
23197
0d3baa5514b7
(Fformat): Detect incomplete format spec at string's end.
Karl Heuer <kwzh@gnu.org>
parents:
23166
diff
changeset
|
3068 if (format == end) |
0d3baa5514b7
(Fformat): Detect incomplete format spec at string's end.
Karl Heuer <kwzh@gnu.org>
parents:
23166
diff
changeset
|
3069 error ("Format string ends in middle of format specifier"); |
305 | 3070 if (*format == '%') |
3071 format++; | |
3072 else if (++n >= nargs) | |
12831
3917c5d131d3
(Fformat): Limit minlen to avoid stack overflow.
Richard M. Stallman <rms@gnu.org>
parents:
12623
diff
changeset
|
3073 error ("Not enough arguments for format string"); |
305 | 3074 else if (*format == 'S') |
3075 { | |
3076 /* For `S', prin1 the argument and then treat like a string. */ | |
3077 register Lisp_Object tem; | |
3078 tem = Fprin1_to_string (args[n], Qnil); | |
20826
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3079 if (STRING_MULTIBYTE (tem) && ! multibyte) |
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3080 { |
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3081 multibyte = 1; |
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3082 goto retry; |
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3083 } |
305 | 3084 args[n] = tem; |
3085 goto string; | |
3086 } | |
9163
41fe5f636879
(lisp_time_argument, Finsert, Finsert_and_inherit, Finsert_before_markers,
Karl Heuer <kwzh@gnu.org>
parents:
9154
diff
changeset
|
3087 else if (SYMBOLP (args[n])) |
305 | 3088 { |
28470
93996c44b23a
* editfns.c (text_property_stickiness, Fmessage_or_box): Use NILP to test
Ken Raeburn <raeburn@raeburn.org>
parents:
28358
diff
changeset
|
3089 /* Use a temp var to avoid problems when ENABLE_CHECKING |
93996c44b23a
* editfns.c (text_property_stickiness, Fmessage_or_box): Use NILP to test
Ken Raeburn <raeburn@raeburn.org>
parents:
28358
diff
changeset
|
3090 is turned on. */ |
93996c44b23a
* editfns.c (text_property_stickiness, Fmessage_or_box): Use NILP to test
Ken Raeburn <raeburn@raeburn.org>
parents:
28358
diff
changeset
|
3091 struct Lisp_String *t = XSYMBOL (args[n])->name; |
93996c44b23a
* editfns.c (text_property_stickiness, Fmessage_or_box): Use NILP to test
Ken Raeburn <raeburn@raeburn.org>
parents:
28358
diff
changeset
|
3092 XSETSTRING (args[n], t); |
20861
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
3093 if (STRING_MULTIBYTE (args[n]) && ! multibyte) |
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
3094 { |
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
3095 multibyte = 1; |
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
3096 goto retry; |
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
3097 } |
305 | 3098 goto string; |
3099 } | |
9163
41fe5f636879
(lisp_time_argument, Finsert, Finsert_and_inherit, Finsert_before_markers,
Karl Heuer <kwzh@gnu.org>
parents:
9154
diff
changeset
|
3100 else if (STRINGP (args[n])) |
305 | 3101 { |
3102 string: | |
6528
d0f6a386b7cb
(Fformat): Validate number and type of arguments.
Karl Heuer <kwzh@gnu.org>
parents:
6206
diff
changeset
|
3103 if (*format != 's' && *format != 'S') |
23197
0d3baa5514b7
(Fformat): Detect incomplete format spec at string's end.
Karl Heuer <kwzh@gnu.org>
parents:
23166
diff
changeset
|
3104 error ("Format specifier doesn't match argument type"); |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3105 thissize = CONVERTED_BYTE_SIZE (multibyte, args[n]); |
305 | 3106 } |
3107 /* Would get MPV otherwise, since Lisp_Int's `point' to low memory. */ | |
9163
41fe5f636879
(lisp_time_argument, Finsert, Finsert_and_inherit, Finsert_before_markers,
Karl Heuer <kwzh@gnu.org>
parents:
9154
diff
changeset
|
3108 else if (INTEGERP (args[n]) && *format != 's') |
305 | 3109 { |
3591
507f64624555
Apply typo patches from Paul Eggert.
Jim Blandy <jimb@redhat.com>
parents:
3522
diff
changeset
|
3110 /* The following loop assumes the Lisp type indicates |
305 | 3111 the proper way to pass the argument. |
3112 So make sure we have a flonum if the argument should | |
3113 be a double. */ | |
3114 if (*format == 'e' || *format == 'f' || *format == 'g') | |
3115 args[n] = Ffloat (args[n]); | |
23326
df3f641c9ca1
(Fformat): Check format control characters.
Kenichi Handa <handa@m17n.org>
parents:
23292
diff
changeset
|
3116 else |
df3f641c9ca1
(Fformat): Check format control characters.
Kenichi Handa <handa@m17n.org>
parents:
23292
diff
changeset
|
3117 if (*format != 'd' && *format != 'o' && *format != 'x' |
24505 | 3118 && *format != 'i' && *format != 'X' && *format != 'c') |
23326
df3f641c9ca1
(Fformat): Check format control characters.
Kenichi Handa <handa@m17n.org>
parents:
23292
diff
changeset
|
3119 error ("Invalid format operation %%%c", *format); |
df3f641c9ca1
(Fformat): Check format control characters.
Kenichi Handa <handa@m17n.org>
parents:
23292
diff
changeset
|
3120 |
30480 | 3121 thissize = 30; |
21225
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3122 if (*format == 'c' |
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3123 && (! SINGLE_BYTE_CHAR_P (XINT (args[n])) |
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3124 || XINT (args[n]) == 0)) |
21064
90bdbe2754c8
(Fformat): Format multibyte characters by "%c"
Kenichi Handa <handa@m17n.org>
parents:
21052
diff
changeset
|
3125 { |
90bdbe2754c8
(Fformat): Format multibyte characters by "%c"
Kenichi Handa <handa@m17n.org>
parents:
21052
diff
changeset
|
3126 if (! multibyte) |
90bdbe2754c8
(Fformat): Format multibyte characters by "%c"
Kenichi Handa <handa@m17n.org>
parents:
21052
diff
changeset
|
3127 { |
90bdbe2754c8
(Fformat): Format multibyte characters by "%c"
Kenichi Handa <handa@m17n.org>
parents:
21052
diff
changeset
|
3128 multibyte = 1; |
90bdbe2754c8
(Fformat): Format multibyte characters by "%c"
Kenichi Handa <handa@m17n.org>
parents:
21052
diff
changeset
|
3129 goto retry; |
90bdbe2754c8
(Fformat): Format multibyte characters by "%c"
Kenichi Handa <handa@m17n.org>
parents:
21052
diff
changeset
|
3130 } |
90bdbe2754c8
(Fformat): Format multibyte characters by "%c"
Kenichi Handa <handa@m17n.org>
parents:
21052
diff
changeset
|
3131 args[n] = Fchar_to_string (args[n]); |
21245
6cde55b7c9de
Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents:
21235
diff
changeset
|
3132 thissize = STRING_BYTES (XSTRING (args[n])); |
21064
90bdbe2754c8
(Fformat): Format multibyte characters by "%c"
Kenichi Handa <handa@m17n.org>
parents:
21052
diff
changeset
|
3133 } |
305 | 3134 } |
9163
41fe5f636879
(lisp_time_argument, Finsert, Finsert_and_inherit, Finsert_before_markers,
Karl Heuer <kwzh@gnu.org>
parents:
9154
diff
changeset
|
3135 else if (FLOATP (args[n]) && *format != 's') |
305 | 3136 { |
3137 if (! (*format == 'e' || *format == 'f' || *format == 'g')) | |
18605
0567c4086813
(Fformat): Add second argument in call to Ftruncate.
Richard M. Stallman <rms@gnu.org>
parents:
18511
diff
changeset
|
3138 args[n] = Ftruncate (args[n], Qnil); |
23553
b6d888e0dfcc
(Fformat): Increase buffer size for floating format.
Richard M. Stallman <rms@gnu.org>
parents:
23326
diff
changeset
|
3139 thissize = 200; |
305 | 3140 } |
3141 else | |
3142 { | |
3143 /* Anything but a string, convert to a string using princ. */ | |
3144 register Lisp_Object tem; | |
3145 tem = Fprin1_to_string (args[n], Qt); | |
21052
eea2c6235bd1
(Fformat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
21035
diff
changeset
|
3146 if (STRING_MULTIBYTE (tem) & ! multibyte) |
20826
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3147 { |
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3148 multibyte = 1; |
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3149 goto retry; |
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3150 } |
305 | 3151 args[n] = tem; |
3152 goto string; | |
3153 } | |
30480 | 3154 |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3155 if (thissize < minlen) |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3156 thissize = minlen; |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3157 |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3158 total += thissize + 4; |
305 | 3159 } |
3160 | |
20826
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3161 /* Now we can no longer jump to retry. |
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3162 TOTAL and LONGEST_FORMAT are known for certain. */ |
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3163 |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3164 this_format = (unsigned char *) alloca (longest_format + 1); |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3165 |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3166 /* Allocate the space for the result. |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3167 Note that TOTAL is an overestimate. */ |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3168 if (total < 1000) |
21914
d1f79bb20a20
(Fformat): Fix casts when assigning buf.
Richard M. Stallman <rms@gnu.org>
parents:
21899
diff
changeset
|
3169 buf = (char *) alloca (total + 1); |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3170 else |
21914
d1f79bb20a20
(Fformat): Fix casts when assigning buf.
Richard M. Stallman <rms@gnu.org>
parents:
21899
diff
changeset
|
3171 buf = (char *) xmalloc (total + 1); |
4019
0463aae99f4e
* editfns.c (Fformat): Since floats occupy two elements in the
Jim Blandy <jimb@redhat.com>
parents:
3776
diff
changeset
|
3172 |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3173 p = buf; |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3174 nchars = 0; |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3175 n = 0; |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3176 |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3177 /* Scan the format and store result in BUF. */ |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3178 format = XSTRING (args[0])->data; |
22698
ea6ef56295b4
(Fformat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents:
22669
diff
changeset
|
3179 maybe_combine_byte = 0; |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3180 while (format != end) |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3181 { |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3182 if (*format == '%') |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3183 { |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3184 int minlen; |
21225
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3185 int negative = 0; |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3186 unsigned char *this_format_start = format; |
305 | 3187 |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3188 format++; |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3189 |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3190 /* Process a numeric arg and skip it. */ |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3191 minlen = atoi (format); |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3192 if (minlen < 0) |
21225
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3193 minlen = - minlen, negative = 1; |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3194 |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3195 while ((*format >= '0' && *format <= '9') |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3196 || *format == '-' || *format == ' ' || *format == '.') |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3197 format++; |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3198 |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3199 if (*format++ == '%') |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3200 { |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3201 *p++ = '%'; |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3202 nchars++; |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3203 continue; |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3204 } |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3205 |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3206 ++n; |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3207 |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3208 if (STRINGP (args[n])) |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3209 { |
21225
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3210 int padding, nbytes; |
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3211 int width = strwidth (XSTRING (args[n])->data, |
21245
6cde55b7c9de
Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents:
21235
diff
changeset
|
3212 STRING_BYTES (XSTRING (args[n]))); |
25018 | 3213 int start = nchars; |
21225
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3214 |
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3215 /* If spec requires it, pad on right with spaces. */ |
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3216 padding = minlen - width; |
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3217 if (! negative) |
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3218 while (padding-- > 0) |
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3219 { |
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3220 *p++ = ' '; |
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3221 nchars++; |
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3222 } |
305 | 3223 |
22698
ea6ef56295b4
(Fformat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents:
22669
diff
changeset
|
3224 if (p > buf |
ea6ef56295b4
(Fformat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents:
22669
diff
changeset
|
3225 && multibyte |
22712
6f129ed55108
(Fformat): Replace explicit numeric constants with proper macros.
Kenichi Handa <handa@m17n.org>
parents:
22698
diff
changeset
|
3226 && !ASCII_BYTE_P (*((unsigned char *) p - 1)) |
22698
ea6ef56295b4
(Fformat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents:
22669
diff
changeset
|
3227 && STRING_MULTIBYTE (args[n]) |
22712
6f129ed55108
(Fformat): Replace explicit numeric constants with proper macros.
Kenichi Handa <handa@m17n.org>
parents:
22698
diff
changeset
|
3228 && !CHAR_HEAD_P (XSTRING (args[n])->data[0])) |
22698
ea6ef56295b4
(Fformat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents:
22669
diff
changeset
|
3229 maybe_combine_byte = 1; |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3230 nbytes = copy_text (XSTRING (args[n])->data, p, |
21245
6cde55b7c9de
Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents:
21235
diff
changeset
|
3231 STRING_BYTES (XSTRING (args[n])), |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3232 STRING_MULTIBYTE (args[n]), multibyte); |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3233 p += nbytes; |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3234 nchars += XSTRING (args[n])->size; |
305 | 3235 |
21225
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3236 if (negative) |
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3237 while (padding-- > 0) |
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3238 { |
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3239 *p++ = ' '; |
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3240 nchars++; |
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3241 } |
25018 | 3242 |
3243 /* If this argument has text properties, record where | |
3244 in the result string it appears. */ | |
3245 if (XSTRING (args[n])->intervals) | |
3246 { | |
3247 if (!info) | |
3248 { | |
3249 int nbytes = nargs * sizeof *info; | |
3250 info = (struct info *) alloca (nbytes); | |
3251 bzero (info, nbytes); | |
3252 } | |
30480 | 3253 |
25018 | 3254 info[n].start = start; |
3255 info[n].end = nchars; | |
3256 } | |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3257 } |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3258 else if (INTEGERP (args[n]) || FLOATP (args[n])) |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3259 { |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3260 int this_nchars; |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3261 |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3262 bcopy (this_format_start, this_format, |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3263 format - this_format_start); |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3264 this_format[format - this_format_start] = 0; |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3265 |
21202
ef954087e7b9
(Fformat): Properly print floats.
Richard M. Stallman <rms@gnu.org>
parents:
21200
diff
changeset
|
3266 if (INTEGERP (args[n])) |
ef954087e7b9
(Fformat): Properly print floats.
Richard M. Stallman <rms@gnu.org>
parents:
21200
diff
changeset
|
3267 sprintf (p, this_format, XINT (args[n])); |
ef954087e7b9
(Fformat): Properly print floats.
Richard M. Stallman <rms@gnu.org>
parents:
21200
diff
changeset
|
3268 else |
25662
0a7261c1d487
Use XCAR, XCDR, and XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25656
diff
changeset
|
3269 sprintf (p, this_format, XFLOAT_DATA (args[n])); |
12603
6d033c8501d4
(Fformat): Increment total for size of control string.
Richard M. Stallman <rms@gnu.org>
parents:
12602
diff
changeset
|
3270 |
22698
ea6ef56295b4
(Fformat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents:
22669
diff
changeset
|
3271 if (p > buf |
ea6ef56295b4
(Fformat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents:
22669
diff
changeset
|
3272 && multibyte |
22712
6f129ed55108
(Fformat): Replace explicit numeric constants with proper macros.
Kenichi Handa <handa@m17n.org>
parents:
22698
diff
changeset
|
3273 && !ASCII_BYTE_P (*((unsigned char *) p - 1)) |
6f129ed55108
(Fformat): Replace explicit numeric constants with proper macros.
Kenichi Handa <handa@m17n.org>
parents:
22698
diff
changeset
|
3274 && !CHAR_HEAD_P (*((unsigned char *) p))) |
22698
ea6ef56295b4
(Fformat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents:
22669
diff
changeset
|
3275 maybe_combine_byte = 1; |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3276 this_nchars = strlen (p); |
29008
939760ef7379
(Fformat): Be sure to convert 8-bit characters to
Kenichi Handa <handa@m17n.org>
parents:
28545
diff
changeset
|
3277 if (multibyte) |
939760ef7379
(Fformat): Be sure to convert 8-bit characters to
Kenichi Handa <handa@m17n.org>
parents:
28545
diff
changeset
|
3278 p += str_to_multibyte (p, buf + total - p, this_nchars); |
939760ef7379
(Fformat): Be sure to convert 8-bit characters to
Kenichi Handa <handa@m17n.org>
parents:
28545
diff
changeset
|
3279 else |
939760ef7379
(Fformat): Be sure to convert 8-bit characters to
Kenichi Handa <handa@m17n.org>
parents:
28545
diff
changeset
|
3280 p += this_nchars; |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3281 nchars += this_nchars; |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3282 } |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3283 } |
20861
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
3284 else if (STRING_MULTIBYTE (args[0])) |
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
3285 { |
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
3286 /* Copy a whole multibyte character. */ |
22698
ea6ef56295b4
(Fformat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents:
22669
diff
changeset
|
3287 if (p > buf |
ea6ef56295b4
(Fformat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents:
22669
diff
changeset
|
3288 && multibyte |
22712
6f129ed55108
(Fformat): Replace explicit numeric constants with proper macros.
Kenichi Handa <handa@m17n.org>
parents:
22698
diff
changeset
|
3289 && !ASCII_BYTE_P (*((unsigned char *) p - 1)) |
6f129ed55108
(Fformat): Replace explicit numeric constants with proper macros.
Kenichi Handa <handa@m17n.org>
parents:
22698
diff
changeset
|
3290 && !CHAR_HEAD_P (*format)) |
22698
ea6ef56295b4
(Fformat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents:
22669
diff
changeset
|
3291 maybe_combine_byte = 1; |
20861
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
3292 *p++ = *format++; |
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
3293 while (! CHAR_HEAD_P (*format)) *p++ = *format++; |
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
3294 nchars++; |
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
3295 } |
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
3296 else if (multibyte) |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3297 { |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3298 /* Convert a single-byte character to multibyte. */ |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3299 int len = copy_text (format, p, 1, 0, 1); |
305 | 3300 |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3301 p += len; |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3302 format++; |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3303 nchars++; |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3304 } |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3305 else |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3306 *p++ = *format++, nchars++; |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3307 } |
305 | 3308 |
22698
ea6ef56295b4
(Fformat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents:
22669
diff
changeset
|
3309 if (maybe_combine_byte) |
ea6ef56295b4
(Fformat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents:
22669
diff
changeset
|
3310 nchars = multibyte_chars_in_text (buf, p - buf); |
21257
205a5aa4aa2f
(Fchar_to_string): Use make_string_from_bytes.
Richard M. Stallman <rms@gnu.org>
parents:
21245
diff
changeset
|
3311 val = make_specified_string (buf, nchars, p - buf, multibyte); |
20804
14fa73136e64
(CONVERTED_BYTE_SIZE): Fix the logic.
Kenichi Handa <handa@m17n.org>
parents:
20706
diff
changeset
|
3312 |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3313 /* If we allocated BUF with malloc, free it too. */ |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3314 if (total >= 1000) |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3315 xfree (buf); |
305 | 3316 |
25018 | 3317 /* If the format string has text properties, or any of the string |
3318 arguments has text properties, set up text properties of the | |
3319 result string. */ | |
30480 | 3320 |
25018 | 3321 if (XSTRING (args[0])->intervals || info) |
3322 { | |
3323 Lisp_Object len, new_len, props; | |
3324 struct gcpro gcpro1; | |
30480 | 3325 |
25018 | 3326 /* Add text properties from the format string. */ |
3327 len = make_number (XSTRING (args[0])->size); | |
3328 props = text_property_list (args[0], make_number (0), len, Qnil); | |
3329 GCPRO1 (props); | |
30480 | 3330 |
25018 | 3331 if (CONSP (props)) |
3332 { | |
3333 new_len = make_number (XSTRING (val)->size); | |
3334 extend_property_ranges (props, len, new_len); | |
3335 add_text_properties_from_list (val, props, make_number (0)); | |
3336 } | |
3337 | |
3338 /* Add text properties from arguments. */ | |
3339 if (info) | |
3340 for (n = 1; n < nargs; ++n) | |
3341 if (info[n].end) | |
3342 { | |
3343 len = make_number (XSTRING (args[n])->size); | |
3344 new_len = make_number (info[n].end - info[n].start); | |
3345 props = text_property_list (args[n], make_number (0), len, Qnil); | |
3346 extend_property_ranges (props, len, new_len); | |
30023
ec25786e4705
(Fformat): While copying text properties, make each composition
Kenichi Handa <handa@m17n.org>
parents:
29008
diff
changeset
|
3347 /* If successive arguments have properites, be sure that |
ec25786e4705
(Fformat): While copying text properties, make each composition
Kenichi Handa <handa@m17n.org>
parents:
29008
diff
changeset
|
3348 the value of `composition' property be the copy. */ |
ec25786e4705
(Fformat): While copying text properties, make each composition
Kenichi Handa <handa@m17n.org>
parents:
29008
diff
changeset
|
3349 if (n > 1 && info[n - 1].end) |
ec25786e4705
(Fformat): While copying text properties, make each composition
Kenichi Handa <handa@m17n.org>
parents:
29008
diff
changeset
|
3350 make_composition_value_copy (props); |
25018 | 3351 add_text_properties_from_list (val, props, |
3352 make_number (info[n].start)); | |
3353 } | |
3354 | |
3355 UNGCPRO; | |
3356 } | |
3357 | |
20804
14fa73136e64
(CONVERTED_BYTE_SIZE): Fix the logic.
Kenichi Handa <handa@m17n.org>
parents:
20706
diff
changeset
|
3358 return val; |
305 | 3359 } |
3360 | |
25815 | 3361 |
305 | 3362 /* VARARGS 1 */ |
3363 Lisp_Object | |
3364 #ifdef NO_ARG_ARRAY | |
3365 format1 (string1, arg0, arg1, arg2, arg3, arg4) | |
8824
589f82d1bb32
(Fnarrow_to_region, format1): Use EMACS_INT.
Richard M. Stallman <rms@gnu.org>
parents:
8771
diff
changeset
|
3366 EMACS_INT arg0, arg1, arg2, arg3, arg4; |
305 | 3367 #else |
3368 format1 (string1) | |
3369 #endif | |
3370 char *string1; | |
3371 { | |
3372 char buf[100]; | |
3373 #ifdef NO_ARG_ARRAY | |
8824
589f82d1bb32
(Fnarrow_to_region, format1): Use EMACS_INT.
Richard M. Stallman <rms@gnu.org>
parents:
8771
diff
changeset
|
3374 EMACS_INT args[5]; |
305 | 3375 args[0] = arg0; |
3376 args[1] = arg1; | |
3377 args[2] = arg2; | |
3378 args[3] = arg3; | |
3379 args[4] = arg4; | |
21035
5d18067080d0
(general_insert_function): Use
Kenichi Handa <handa@m17n.org>
parents:
20946
diff
changeset
|
3380 doprnt (buf, sizeof buf, string1, (char *)0, 5, (char **) args); |
305 | 3381 #else |
11912 | 3382 doprnt (buf, sizeof buf, string1, (char *)0, 5, &string1 + 1); |
305 | 3383 #endif |
3384 return build_string (buf); | |
3385 } | |
3386 | |
3387 DEFUN ("char-equal", Fchar_equal, Schar_equal, 2, 2, 0, | |
3388 "Return t if two characters match, optionally ignoring case.\n\ | |
3389 Both arguments must be characters (i.e. integers).\n\ | |
3390 Case is ignored if `case-fold-search' is non-nil in the current buffer.") | |
3391 (c1, c2) | |
3392 register Lisp_Object c1, c2; | |
3393 { | |
20688
16c458803c32
(Fchar_equal): Fix case-conversion code.
Richard M. Stallman <rms@gnu.org>
parents:
20606
diff
changeset
|
3394 int i1, i2; |
305 | 3395 CHECK_NUMBER (c1, 0); |
3396 CHECK_NUMBER (c2, 1); | |
3397 | |
20688
16c458803c32
(Fchar_equal): Fix case-conversion code.
Richard M. Stallman <rms@gnu.org>
parents:
20606
diff
changeset
|
3398 if (XINT (c1) == XINT (c2)) |
305 | 3399 return Qt; |
20688
16c458803c32
(Fchar_equal): Fix case-conversion code.
Richard M. Stallman <rms@gnu.org>
parents:
20606
diff
changeset
|
3400 if (NILP (current_buffer->case_fold_search)) |
16c458803c32
(Fchar_equal): Fix case-conversion code.
Richard M. Stallman <rms@gnu.org>
parents:
20606
diff
changeset
|
3401 return Qnil; |
16c458803c32
(Fchar_equal): Fix case-conversion code.
Richard M. Stallman <rms@gnu.org>
parents:
20606
diff
changeset
|
3402 |
16c458803c32
(Fchar_equal): Fix case-conversion code.
Richard M. Stallman <rms@gnu.org>
parents:
20606
diff
changeset
|
3403 /* Do these in separate statements, |
16c458803c32
(Fchar_equal): Fix case-conversion code.
Richard M. Stallman <rms@gnu.org>
parents:
20606
diff
changeset
|
3404 then compare the variables. |
16c458803c32
(Fchar_equal): Fix case-conversion code.
Richard M. Stallman <rms@gnu.org>
parents:
20606
diff
changeset
|
3405 because of the way DOWNCASE uses temp variables. */ |
16c458803c32
(Fchar_equal): Fix case-conversion code.
Richard M. Stallman <rms@gnu.org>
parents:
20606
diff
changeset
|
3406 i1 = DOWNCASE (XFASTINT (c1)); |
16c458803c32
(Fchar_equal): Fix case-conversion code.
Richard M. Stallman <rms@gnu.org>
parents:
20606
diff
changeset
|
3407 i2 = DOWNCASE (XFASTINT (c2)); |
16c458803c32
(Fchar_equal): Fix case-conversion code.
Richard M. Stallman <rms@gnu.org>
parents:
20606
diff
changeset
|
3408 return (i1 == i2 ? Qt : Qnil); |
305 | 3409 } |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3410 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3411 /* Transpose the markers in two regions of the current buffer, and |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3412 adjust the ones between them if necessary (i.e.: if the regions |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3413 differ in size). |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3414 |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3415 START1, END1 are the character positions of the first region. |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3416 START1_BYTE, END1_BYTE are the byte positions. |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3417 START2, END2 are the character positions of the second region. |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3418 START2_BYTE, END2_BYTE are the byte positions. |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3419 |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3420 Traverses the entire marker list of the buffer to do so, adding an |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3421 appropriate amount to some, subtracting from some, and leaving the |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3422 rest untouched. Most of this is copied from adjust_markers in insdel.c. |
30480 | 3423 |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3424 It's the caller's job to ensure that START1 <= END1 <= START2 <= END2. */ |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3425 |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
3426 static void |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3427 transpose_markers (start1, end1, start2, end2, |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3428 start1_byte, end1_byte, start2_byte, end2_byte) |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3429 register int start1, end1, start2, end2; |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3430 register int start1_byte, end1_byte, start2_byte, end2_byte; |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3431 { |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3432 register int amt1, amt1_byte, amt2, amt2_byte, diff, diff_byte, mpos; |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3433 register Lisp_Object marker; |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3434 |
7862
0b6f46029ea2
(transpose_markers): Allow for gap at start of region.
Karl Heuer <kwzh@gnu.org>
parents:
7710
diff
changeset
|
3435 /* Update point as if it were a marker. */ |
7519
987ab382275c
(Ftranspose_regions): Fix overlays after moving markers.
Karl Heuer <kwzh@gnu.org>
parents:
7506
diff
changeset
|
3436 if (PT < start1) |
987ab382275c
(Ftranspose_regions): Fix overlays after moving markers.
Karl Heuer <kwzh@gnu.org>
parents:
7506
diff
changeset
|
3437 ; |
987ab382275c
(Ftranspose_regions): Fix overlays after moving markers.
Karl Heuer <kwzh@gnu.org>
parents:
7506
diff
changeset
|
3438 else if (PT < end1) |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3439 TEMP_SET_PT_BOTH (PT + (end2 - end1), |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3440 PT_BYTE + (end2_byte - end1_byte)); |
7519
987ab382275c
(Ftranspose_regions): Fix overlays after moving markers.
Karl Heuer <kwzh@gnu.org>
parents:
7506
diff
changeset
|
3441 else if (PT < start2) |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3442 TEMP_SET_PT_BOTH (PT + (end2 - start2) - (end1 - start1), |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3443 (PT_BYTE + (end2_byte - start2_byte) |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3444 - (end1_byte - start1_byte))); |
7519
987ab382275c
(Ftranspose_regions): Fix overlays after moving markers.
Karl Heuer <kwzh@gnu.org>
parents:
7506
diff
changeset
|
3445 else if (PT < end2) |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3446 TEMP_SET_PT_BOTH (PT - (start2 - start1), |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3447 PT_BYTE - (start2_byte - start1_byte)); |
7519
987ab382275c
(Ftranspose_regions): Fix overlays after moving markers.
Karl Heuer <kwzh@gnu.org>
parents:
7506
diff
changeset
|
3448 |
7862
0b6f46029ea2
(transpose_markers): Allow for gap at start of region.
Karl Heuer <kwzh@gnu.org>
parents:
7710
diff
changeset
|
3449 /* We used to adjust the endpoints here to account for the gap, but that |
0b6f46029ea2
(transpose_markers): Allow for gap at start of region.
Karl Heuer <kwzh@gnu.org>
parents:
7710
diff
changeset
|
3450 isn't good enough. Even if we assume the caller has tried to move the |
0b6f46029ea2
(transpose_markers): Allow for gap at start of region.
Karl Heuer <kwzh@gnu.org>
parents:
7710
diff
changeset
|
3451 gap out of our way, it might still be at start1 exactly, for example; |
0b6f46029ea2
(transpose_markers): Allow for gap at start of region.
Karl Heuer <kwzh@gnu.org>
parents:
7710
diff
changeset
|
3452 and that places it `inside' the interval, for our purposes. The amount |
0b6f46029ea2
(transpose_markers): Allow for gap at start of region.
Karl Heuer <kwzh@gnu.org>
parents:
7710
diff
changeset
|
3453 of adjustment is nontrivial if there's a `denormalized' marker whose |
0b6f46029ea2
(transpose_markers): Allow for gap at start of region.
Karl Heuer <kwzh@gnu.org>
parents:
7710
diff
changeset
|
3454 position is between GPT and GPT + GAP_SIZE, so it's simpler to leave |
0b6f46029ea2
(transpose_markers): Allow for gap at start of region.
Karl Heuer <kwzh@gnu.org>
parents:
7710
diff
changeset
|
3455 the dirty work to Fmarker_position, below. */ |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3456 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3457 /* The difference between the region's lengths */ |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3458 diff = (end2 - start2) - (end1 - start1); |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3459 diff_byte = (end2_byte - start2_byte) - (end1_byte - start1_byte); |
30480 | 3460 |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3461 /* For shifting each marker in a region by the length of the other |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3462 region plus the distance between the regions. */ |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3463 amt1 = (end2 - start2) + (start2 - end1); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3464 amt2 = (end1 - start1) + (start2 - end1); |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3465 amt1_byte = (end2_byte - start2_byte) + (start2_byte - end1_byte); |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3466 amt2_byte = (end1_byte - start1_byte) + (start2_byte - end1_byte); |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3467 |
10308
90784ed0416f
Use SAVE_MODIFF and BUF_SAVE_MODIFF
Richard M. Stallman <rms@gnu.org>
parents:
9812
diff
changeset
|
3468 for (marker = BUF_MARKERS (current_buffer); !NILP (marker); |
7862
0b6f46029ea2
(transpose_markers): Allow for gap at start of region.
Karl Heuer <kwzh@gnu.org>
parents:
7710
diff
changeset
|
3469 marker = XMARKER (marker)->chain) |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3470 { |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3471 mpos = marker_byte_position (marker); |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3472 if (mpos >= start1_byte && mpos < end2_byte) |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3473 { |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3474 if (mpos < end1_byte) |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3475 mpos += amt1_byte; |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3476 else if (mpos < start2_byte) |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3477 mpos += diff_byte; |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3478 else |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3479 mpos -= amt2_byte; |
20564
4d06099b7e09
(transpose_markers): Update marker's bytepos.
Richard M. Stallman <rms@gnu.org>
parents:
20561
diff
changeset
|
3480 XMARKER (marker)->bytepos = mpos; |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3481 } |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3482 mpos = XMARKER (marker)->charpos; |
7862
0b6f46029ea2
(transpose_markers): Allow for gap at start of region.
Karl Heuer <kwzh@gnu.org>
parents:
7710
diff
changeset
|
3483 if (mpos >= start1 && mpos < end2) |
0b6f46029ea2
(transpose_markers): Allow for gap at start of region.
Karl Heuer <kwzh@gnu.org>
parents:
7710
diff
changeset
|
3484 { |
0b6f46029ea2
(transpose_markers): Allow for gap at start of region.
Karl Heuer <kwzh@gnu.org>
parents:
7710
diff
changeset
|
3485 if (mpos < end1) |
0b6f46029ea2
(transpose_markers): Allow for gap at start of region.
Karl Heuer <kwzh@gnu.org>
parents:
7710
diff
changeset
|
3486 mpos += amt1; |
0b6f46029ea2
(transpose_markers): Allow for gap at start of region.
Karl Heuer <kwzh@gnu.org>
parents:
7710
diff
changeset
|
3487 else if (mpos < start2) |
0b6f46029ea2
(transpose_markers): Allow for gap at start of region.
Karl Heuer <kwzh@gnu.org>
parents:
7710
diff
changeset
|
3488 mpos += diff; |
0b6f46029ea2
(transpose_markers): Allow for gap at start of region.
Karl Heuer <kwzh@gnu.org>
parents:
7710
diff
changeset
|
3489 else |
0b6f46029ea2
(transpose_markers): Allow for gap at start of region.
Karl Heuer <kwzh@gnu.org>
parents:
7710
diff
changeset
|
3490 mpos -= amt2; |
0b6f46029ea2
(transpose_markers): Allow for gap at start of region.
Karl Heuer <kwzh@gnu.org>
parents:
7710
diff
changeset
|
3491 } |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3492 XMARKER (marker)->charpos = mpos; |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3493 } |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3494 } |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3495 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3496 DEFUN ("transpose-regions", Ftranspose_regions, Stranspose_regions, 4, 5, 0, |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3497 "Transpose region START1 to END1 with START2 to END2.\n\ |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3498 The regions may not be overlapping, because the size of the buffer is\n\ |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3499 never changed in a transposition.\n\ |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3500 \n\ |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3501 Optional fifth arg LEAVE_MARKERS, if non-nil, means don't update\n\ |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3502 any markers that happen to be located in the regions.\n\ |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3503 \n\ |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3504 Transposing beyond buffer boundaries is an error.") |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3505 (startr1, endr1, startr2, endr2, leave_markers) |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3506 Lisp_Object startr1, endr1, startr2, endr2, leave_markers; |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3507 { |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3508 register int start1, end1, start2, end2; |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3509 int start1_byte, start2_byte, len1_byte, len2_byte; |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3510 int gap, len1, len_mid, len2; |
7250
67bb3bb1b62d
(Ftranspose_regions): Take addresses only after move gap.
Richard M. Stallman <rms@gnu.org>
parents:
7207
diff
changeset
|
3511 unsigned char *start1_addr, *start2_addr, *temp; |
21245
6cde55b7c9de
Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents:
21235
diff
changeset
|
3512 struct gcpro gcpro1, gcpro2; |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3513 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3514 INTERVAL cur_intv, tmp_interval1, tmp_interval_mid, tmp_interval2; |
10308
90784ed0416f
Use SAVE_MODIFF and BUF_SAVE_MODIFF
Richard M. Stallman <rms@gnu.org>
parents:
9812
diff
changeset
|
3515 cur_intv = BUF_INTERVALS (current_buffer); |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3516 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3517 validate_region (&startr1, &endr1); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3518 validate_region (&startr2, &endr2); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3519 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3520 start1 = XFASTINT (startr1); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3521 end1 = XFASTINT (endr1); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3522 start2 = XFASTINT (startr2); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3523 end2 = XFASTINT (endr2); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3524 gap = GPT; |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3525 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3526 /* Swap the regions if they're reversed. */ |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3527 if (start2 < end1) |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3528 { |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3529 register int glumph = start1; |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3530 start1 = start2; |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3531 start2 = glumph; |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3532 glumph = end1; |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3533 end1 = end2; |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3534 end2 = glumph; |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3535 } |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3536 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3537 len1 = end1 - start1; |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3538 len2 = end2 - start2; |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3539 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3540 if (start2 < end1) |
21245
6cde55b7c9de
Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents:
21235
diff
changeset
|
3541 error ("Transposed regions overlap"); |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3542 else if (start1 == end1 || start2 == end2) |
21245
6cde55b7c9de
Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents:
21235
diff
changeset
|
3543 error ("Transposed region has length 0"); |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3544 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3545 /* The possibilities are: |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3546 1. Adjacent (contiguous) regions, or separate but equal regions |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3547 (no, really equal, in this case!), or |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3548 2. Separate regions of unequal size. |
30480 | 3549 |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3550 The worst case is usually No. 2. It means that (aside from |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3551 potential need for getting the gap out of the way), there also |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3552 needs to be a shifting of the text between the two regions. So |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3553 if they are spread far apart, we are that much slower... sigh. */ |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3554 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3555 /* It must be pointed out that the really studly thing to do would |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3556 be not to move the gap at all, but to leave it in place and work |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3557 around it if necessary. This would be extremely efficient, |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3558 especially considering that people are likely to do |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3559 transpositions near where they are working interactively, which |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3560 is exactly where the gap would be found. However, such code |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3561 would be much harder to write and to read. So, if you are |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3562 reading this comment and are feeling squirrely, by all means have |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3563 a go! I just didn't feel like doing it, so I will simply move |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3564 the gap the minimum distance to get it out of the way, and then |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3565 deal with an unbroken array. */ |
7250
67bb3bb1b62d
(Ftranspose_regions): Take addresses only after move gap.
Richard M. Stallman <rms@gnu.org>
parents:
7207
diff
changeset
|
3566 |
67bb3bb1b62d
(Ftranspose_regions): Take addresses only after move gap.
Richard M. Stallman <rms@gnu.org>
parents:
7207
diff
changeset
|
3567 /* Make sure the gap won't interfere, by moving it out of the text |
67bb3bb1b62d
(Ftranspose_regions): Take addresses only after move gap.
Richard M. Stallman <rms@gnu.org>
parents:
7207
diff
changeset
|
3568 we will operate on. */ |
67bb3bb1b62d
(Ftranspose_regions): Take addresses only after move gap.
Richard M. Stallman <rms@gnu.org>
parents:
7207
diff
changeset
|
3569 if (start1 < gap && gap < end2) |
67bb3bb1b62d
(Ftranspose_regions): Take addresses only after move gap.
Richard M. Stallman <rms@gnu.org>
parents:
7207
diff
changeset
|
3570 { |
67bb3bb1b62d
(Ftranspose_regions): Take addresses only after move gap.
Richard M. Stallman <rms@gnu.org>
parents:
7207
diff
changeset
|
3571 if (gap - start1 < end2 - gap) |
67bb3bb1b62d
(Ftranspose_regions): Take addresses only after move gap.
Richard M. Stallman <rms@gnu.org>
parents:
7207
diff
changeset
|
3572 move_gap (start1); |
67bb3bb1b62d
(Ftranspose_regions): Take addresses only after move gap.
Richard M. Stallman <rms@gnu.org>
parents:
7207
diff
changeset
|
3573 else |
67bb3bb1b62d
(Ftranspose_regions): Take addresses only after move gap.
Richard M. Stallman <rms@gnu.org>
parents:
7207
diff
changeset
|
3574 move_gap (end2); |
67bb3bb1b62d
(Ftranspose_regions): Take addresses only after move gap.
Richard M. Stallman <rms@gnu.org>
parents:
7207
diff
changeset
|
3575 } |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3576 |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3577 start1_byte = CHAR_TO_BYTE (start1); |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3578 start2_byte = CHAR_TO_BYTE (start2); |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3579 len1_byte = CHAR_TO_BYTE (end1) - start1_byte; |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3580 len2_byte = CHAR_TO_BYTE (end2) - start2_byte; |
21245
6cde55b7c9de
Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents:
21235
diff
changeset
|
3581 |
29008
939760ef7379
(Fformat): Be sure to convert 8-bit characters to
Kenichi Handa <handa@m17n.org>
parents:
28545
diff
changeset
|
3582 #ifdef BYTE_COMBINING_DEBUG |
21245
6cde55b7c9de
Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents:
21235
diff
changeset
|
3583 if (end1 == start2) |
6cde55b7c9de
Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents:
21235
diff
changeset
|
3584 { |
29008
939760ef7379
(Fformat): Be sure to convert 8-bit characters to
Kenichi Handa <handa@m17n.org>
parents:
28545
diff
changeset
|
3585 if (count_combining_before (BYTE_POS_ADDR (start2_byte), |
939760ef7379
(Fformat): Be sure to convert 8-bit characters to
Kenichi Handa <handa@m17n.org>
parents:
28545
diff
changeset
|
3586 len2_byte, start1, start1_byte) |
939760ef7379
(Fformat): Be sure to convert 8-bit characters to
Kenichi Handa <handa@m17n.org>
parents:
28545
diff
changeset
|
3587 || count_combining_before (BYTE_POS_ADDR (start1_byte), |
939760ef7379
(Fformat): Be sure to convert 8-bit characters to
Kenichi Handa <handa@m17n.org>
parents:
28545
diff
changeset
|
3588 len1_byte, end2, start2_byte + len2_byte) |
939760ef7379
(Fformat): Be sure to convert 8-bit characters to
Kenichi Handa <handa@m17n.org>
parents:
28545
diff
changeset
|
3589 || count_combining_after (BYTE_POS_ADDR (start1_byte), |
939760ef7379
(Fformat): Be sure to convert 8-bit characters to
Kenichi Handa <handa@m17n.org>
parents:
28545
diff
changeset
|
3590 len1_byte, end2, start2_byte + len2_byte)) |
939760ef7379
(Fformat): Be sure to convert 8-bit characters to
Kenichi Handa <handa@m17n.org>
parents:
28545
diff
changeset
|
3591 abort (); |
21245
6cde55b7c9de
Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents:
21235
diff
changeset
|
3592 } |
6cde55b7c9de
Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents:
21235
diff
changeset
|
3593 else |
6cde55b7c9de
Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents:
21235
diff
changeset
|
3594 { |
29008
939760ef7379
(Fformat): Be sure to convert 8-bit characters to
Kenichi Handa <handa@m17n.org>
parents:
28545
diff
changeset
|
3595 if (count_combining_before (BYTE_POS_ADDR (start2_byte), |
939760ef7379
(Fformat): Be sure to convert 8-bit characters to
Kenichi Handa <handa@m17n.org>
parents:
28545
diff
changeset
|
3596 len2_byte, start1, start1_byte) |
939760ef7379
(Fformat): Be sure to convert 8-bit characters to
Kenichi Handa <handa@m17n.org>
parents:
28545
diff
changeset
|
3597 || count_combining_before (BYTE_POS_ADDR (start1_byte), |
939760ef7379
(Fformat): Be sure to convert 8-bit characters to
Kenichi Handa <handa@m17n.org>
parents:
28545
diff
changeset
|
3598 len1_byte, start2, start2_byte) |
939760ef7379
(Fformat): Be sure to convert 8-bit characters to
Kenichi Handa <handa@m17n.org>
parents:
28545
diff
changeset
|
3599 || count_combining_after (BYTE_POS_ADDR (start2_byte), |
939760ef7379
(Fformat): Be sure to convert 8-bit characters to
Kenichi Handa <handa@m17n.org>
parents:
28545
diff
changeset
|
3600 len2_byte, end1, start1_byte + len1_byte) |
939760ef7379
(Fformat): Be sure to convert 8-bit characters to
Kenichi Handa <handa@m17n.org>
parents:
28545
diff
changeset
|
3601 || count_combining_after (BYTE_POS_ADDR (start1_byte), |
939760ef7379
(Fformat): Be sure to convert 8-bit characters to
Kenichi Handa <handa@m17n.org>
parents:
28545
diff
changeset
|
3602 len1_byte, end2, start2_byte + len2_byte)) |
939760ef7379
(Fformat): Be sure to convert 8-bit characters to
Kenichi Handa <handa@m17n.org>
parents:
28545
diff
changeset
|
3603 abort (); |
21245
6cde55b7c9de
Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents:
21235
diff
changeset
|
3604 } |
29008
939760ef7379
(Fformat): Be sure to convert 8-bit characters to
Kenichi Handa <handa@m17n.org>
parents:
28545
diff
changeset
|
3605 #endif |
939760ef7379
(Fformat): Be sure to convert 8-bit characters to
Kenichi Handa <handa@m17n.org>
parents:
28545
diff
changeset
|
3606 |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3607 /* Hmmm... how about checking to see if the gap is large |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3608 enough to use as the temporary storage? That would avoid an |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3609 allocation... interesting. Later, don't fool with it now. */ |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3610 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3611 /* Working without memmove, for portability (sigh), so must be |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3612 careful of overlapping subsections of the array... */ |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3613 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3614 if (end1 == start2) /* adjacent regions */ |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3615 { |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3616 modify_region (current_buffer, start1, end2); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3617 record_change (start1, len1 + len2); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3618 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3619 tmp_interval1 = copy_intervals (cur_intv, start1, len1); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3620 tmp_interval2 = copy_intervals (cur_intv, start2, len2); |
18745
192b3ebd108e
(Fcurrent_time_zone): Convert Fmake_list argument to Lisp_Integer.
Richard M. Stallman <rms@gnu.org>
parents:
18661
diff
changeset
|
3621 Fset_text_properties (make_number (start1), make_number (end2), |
192b3ebd108e
(Fcurrent_time_zone): Convert Fmake_list argument to Lisp_Integer.
Richard M. Stallman <rms@gnu.org>
parents:
18661
diff
changeset
|
3622 Qnil, Qnil); |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3623 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3624 /* First region smaller than second. */ |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3625 if (len1_byte < len2_byte) |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3626 { |
7250
67bb3bb1b62d
(Ftranspose_regions): Take addresses only after move gap.
Richard M. Stallman <rms@gnu.org>
parents:
7207
diff
changeset
|
3627 /* We use alloca only if it is small, |
67bb3bb1b62d
(Ftranspose_regions): Take addresses only after move gap.
Richard M. Stallman <rms@gnu.org>
parents:
7207
diff
changeset
|
3628 because we want to avoid stack overflow. */ |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3629 if (len2_byte > 20000) |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3630 temp = (unsigned char *) xmalloc (len2_byte); |
7250
67bb3bb1b62d
(Ftranspose_regions): Take addresses only after move gap.
Richard M. Stallman <rms@gnu.org>
parents:
7207
diff
changeset
|
3631 else |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3632 temp = (unsigned char *) alloca (len2_byte); |
7862
0b6f46029ea2
(transpose_markers): Allow for gap at start of region.
Karl Heuer <kwzh@gnu.org>
parents:
7710
diff
changeset
|
3633 |
0b6f46029ea2
(transpose_markers): Allow for gap at start of region.
Karl Heuer <kwzh@gnu.org>
parents:
7710
diff
changeset
|
3634 /* Don't precompute these addresses. We have to compute them |
0b6f46029ea2
(transpose_markers): Allow for gap at start of region.
Karl Heuer <kwzh@gnu.org>
parents:
7710
diff
changeset
|
3635 at the last minute, because the relocating allocator might |
0b6f46029ea2
(transpose_markers): Allow for gap at start of region.
Karl Heuer <kwzh@gnu.org>
parents:
7710
diff
changeset
|
3636 have moved the buffer around during the xmalloc. */ |
23166
6072f28afec9
(Ftranspose_regions): Use BYTE_POS_ADDR to get an
Kenichi Handa <handa@m17n.org>
parents:
23132
diff
changeset
|
3637 start1_addr = BYTE_POS_ADDR (start1_byte); |
6072f28afec9
(Ftranspose_regions): Use BYTE_POS_ADDR to get an
Kenichi Handa <handa@m17n.org>
parents:
23132
diff
changeset
|
3638 start2_addr = BYTE_POS_ADDR (start2_byte); |
7862
0b6f46029ea2
(transpose_markers): Allow for gap at start of region.
Karl Heuer <kwzh@gnu.org>
parents:
7710
diff
changeset
|
3639 |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3640 bcopy (start2_addr, temp, len2_byte); |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3641 bcopy (start1_addr, start1_addr + len2_byte, len1_byte); |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3642 bcopy (temp, start1_addr, len2_byte); |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3643 if (len2_byte > 20000) |
30606
438ad5366a03
(Ftranspose_regions): Use xfree instead of free.
Gerd Moellmann <gerd@gnu.org>
parents:
30550
diff
changeset
|
3644 xfree (temp); |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3645 } |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3646 else |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3647 /* First region not smaller than second. */ |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3648 { |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3649 if (len1_byte > 20000) |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3650 temp = (unsigned char *) xmalloc (len1_byte); |
7250
67bb3bb1b62d
(Ftranspose_regions): Take addresses only after move gap.
Richard M. Stallman <rms@gnu.org>
parents:
7207
diff
changeset
|
3651 else |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3652 temp = (unsigned char *) alloca (len1_byte); |
23166
6072f28afec9
(Ftranspose_regions): Use BYTE_POS_ADDR to get an
Kenichi Handa <handa@m17n.org>
parents:
23132
diff
changeset
|
3653 start1_addr = BYTE_POS_ADDR (start1_byte); |
6072f28afec9
(Ftranspose_regions): Use BYTE_POS_ADDR to get an
Kenichi Handa <handa@m17n.org>
parents:
23132
diff
changeset
|
3654 start2_addr = BYTE_POS_ADDR (start2_byte); |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3655 bcopy (start1_addr, temp, len1_byte); |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3656 bcopy (start2_addr, start1_addr, len2_byte); |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3657 bcopy (temp, start1_addr + len2_byte, len1_byte); |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3658 if (len1_byte > 20000) |
30606
438ad5366a03
(Ftranspose_regions): Use xfree instead of free.
Gerd Moellmann <gerd@gnu.org>
parents:
30550
diff
changeset
|
3659 xfree (temp); |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3660 } |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3661 graft_intervals_into_buffer (tmp_interval1, start1 + len2, |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3662 len1, current_buffer, 0); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3663 graft_intervals_into_buffer (tmp_interval2, start1, |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3664 len2, current_buffer, 0); |
26853
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
3665 update_compositions (start1, start1 + len2, CHECK_BORDER); |
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
3666 update_compositions (start1 + len2, end2, CHECK_TAIL); |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3667 } |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3668 /* Non-adjacent regions, because end1 != start2, bleagh... */ |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3669 else |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3670 { |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3671 len_mid = start2_byte - (start1_byte + len1_byte); |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3672 |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3673 if (len1_byte == len2_byte) |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3674 /* Regions are same size, though, how nice. */ |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3675 { |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3676 modify_region (current_buffer, start1, end1); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3677 modify_region (current_buffer, start2, end2); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3678 record_change (start1, len1); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3679 record_change (start2, len2); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3680 tmp_interval1 = copy_intervals (cur_intv, start1, len1); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3681 tmp_interval2 = copy_intervals (cur_intv, start2, len2); |
18745
192b3ebd108e
(Fcurrent_time_zone): Convert Fmake_list argument to Lisp_Integer.
Richard M. Stallman <rms@gnu.org>
parents:
18661
diff
changeset
|
3682 Fset_text_properties (make_number (start1), make_number (end1), |
192b3ebd108e
(Fcurrent_time_zone): Convert Fmake_list argument to Lisp_Integer.
Richard M. Stallman <rms@gnu.org>
parents:
18661
diff
changeset
|
3683 Qnil, Qnil); |
192b3ebd108e
(Fcurrent_time_zone): Convert Fmake_list argument to Lisp_Integer.
Richard M. Stallman <rms@gnu.org>
parents:
18661
diff
changeset
|
3684 Fset_text_properties (make_number (start2), make_number (end2), |
192b3ebd108e
(Fcurrent_time_zone): Convert Fmake_list argument to Lisp_Integer.
Richard M. Stallman <rms@gnu.org>
parents:
18661
diff
changeset
|
3685 Qnil, Qnil); |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3686 |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3687 if (len1_byte > 20000) |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3688 temp = (unsigned char *) xmalloc (len1_byte); |
7250
67bb3bb1b62d
(Ftranspose_regions): Take addresses only after move gap.
Richard M. Stallman <rms@gnu.org>
parents:
7207
diff
changeset
|
3689 else |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3690 temp = (unsigned char *) alloca (len1_byte); |
23166
6072f28afec9
(Ftranspose_regions): Use BYTE_POS_ADDR to get an
Kenichi Handa <handa@m17n.org>
parents:
23132
diff
changeset
|
3691 start1_addr = BYTE_POS_ADDR (start1_byte); |
6072f28afec9
(Ftranspose_regions): Use BYTE_POS_ADDR to get an
Kenichi Handa <handa@m17n.org>
parents:
23132
diff
changeset
|
3692 start2_addr = BYTE_POS_ADDR (start2_byte); |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3693 bcopy (start1_addr, temp, len1_byte); |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3694 bcopy (start2_addr, start1_addr, len2_byte); |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3695 bcopy (temp, start2_addr, len1_byte); |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3696 if (len1_byte > 20000) |
30606
438ad5366a03
(Ftranspose_regions): Use xfree instead of free.
Gerd Moellmann <gerd@gnu.org>
parents:
30550
diff
changeset
|
3697 xfree (temp); |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3698 graft_intervals_into_buffer (tmp_interval1, start2, |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3699 len1, current_buffer, 0); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3700 graft_intervals_into_buffer (tmp_interval2, start1, |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3701 len2, current_buffer, 0); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3702 } |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3703 |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3704 else if (len1_byte < len2_byte) /* Second region larger than first */ |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3705 /* Non-adjacent & unequal size, area between must also be shifted. */ |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3706 { |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3707 modify_region (current_buffer, start1, end2); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3708 record_change (start1, (end2 - start1)); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3709 tmp_interval1 = copy_intervals (cur_intv, start1, len1); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3710 tmp_interval_mid = copy_intervals (cur_intv, end1, len_mid); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3711 tmp_interval2 = copy_intervals (cur_intv, start2, len2); |
18745
192b3ebd108e
(Fcurrent_time_zone): Convert Fmake_list argument to Lisp_Integer.
Richard M. Stallman <rms@gnu.org>
parents:
18661
diff
changeset
|
3712 Fset_text_properties (make_number (start1), make_number (end2), |
192b3ebd108e
(Fcurrent_time_zone): Convert Fmake_list argument to Lisp_Integer.
Richard M. Stallman <rms@gnu.org>
parents:
18661
diff
changeset
|
3713 Qnil, Qnil); |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3714 |
7250
67bb3bb1b62d
(Ftranspose_regions): Take addresses only after move gap.
Richard M. Stallman <rms@gnu.org>
parents:
7207
diff
changeset
|
3715 /* holds region 2 */ |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3716 if (len2_byte > 20000) |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3717 temp = (unsigned char *) xmalloc (len2_byte); |
7250
67bb3bb1b62d
(Ftranspose_regions): Take addresses only after move gap.
Richard M. Stallman <rms@gnu.org>
parents:
7207
diff
changeset
|
3718 else |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3719 temp = (unsigned char *) alloca (len2_byte); |
23166
6072f28afec9
(Ftranspose_regions): Use BYTE_POS_ADDR to get an
Kenichi Handa <handa@m17n.org>
parents:
23132
diff
changeset
|
3720 start1_addr = BYTE_POS_ADDR (start1_byte); |
6072f28afec9
(Ftranspose_regions): Use BYTE_POS_ADDR to get an
Kenichi Handa <handa@m17n.org>
parents:
23132
diff
changeset
|
3721 start2_addr = BYTE_POS_ADDR (start2_byte); |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3722 bcopy (start2_addr, temp, len2_byte); |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3723 bcopy (start1_addr, start1_addr + len_mid + len2_byte, len1_byte); |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3724 safe_bcopy (start1_addr + len1_byte, start1_addr + len2_byte, len_mid); |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3725 bcopy (temp, start1_addr, len2_byte); |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3726 if (len2_byte > 20000) |
30606
438ad5366a03
(Ftranspose_regions): Use xfree instead of free.
Gerd Moellmann <gerd@gnu.org>
parents:
30550
diff
changeset
|
3727 xfree (temp); |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3728 graft_intervals_into_buffer (tmp_interval1, end2 - len1, |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3729 len1, current_buffer, 0); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3730 graft_intervals_into_buffer (tmp_interval_mid, start1 + len2, |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3731 len_mid, current_buffer, 0); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3732 graft_intervals_into_buffer (tmp_interval2, start1, |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3733 len2, current_buffer, 0); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3734 } |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3735 else |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3736 /* Second region smaller than first. */ |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3737 { |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3738 record_change (start1, (end2 - start1)); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3739 modify_region (current_buffer, start1, end2); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3740 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3741 tmp_interval1 = copy_intervals (cur_intv, start1, len1); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3742 tmp_interval_mid = copy_intervals (cur_intv, end1, len_mid); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3743 tmp_interval2 = copy_intervals (cur_intv, start2, len2); |
18745
192b3ebd108e
(Fcurrent_time_zone): Convert Fmake_list argument to Lisp_Integer.
Richard M. Stallman <rms@gnu.org>
parents:
18661
diff
changeset
|
3744 Fset_text_properties (make_number (start1), make_number (end2), |
192b3ebd108e
(Fcurrent_time_zone): Convert Fmake_list argument to Lisp_Integer.
Richard M. Stallman <rms@gnu.org>
parents:
18661
diff
changeset
|
3745 Qnil, Qnil); |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3746 |
7250
67bb3bb1b62d
(Ftranspose_regions): Take addresses only after move gap.
Richard M. Stallman <rms@gnu.org>
parents:
7207
diff
changeset
|
3747 /* holds region 1 */ |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3748 if (len1_byte > 20000) |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3749 temp = (unsigned char *) xmalloc (len1_byte); |
7250
67bb3bb1b62d
(Ftranspose_regions): Take addresses only after move gap.
Richard M. Stallman <rms@gnu.org>
parents:
7207
diff
changeset
|
3750 else |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3751 temp = (unsigned char *) alloca (len1_byte); |
23166
6072f28afec9
(Ftranspose_regions): Use BYTE_POS_ADDR to get an
Kenichi Handa <handa@m17n.org>
parents:
23132
diff
changeset
|
3752 start1_addr = BYTE_POS_ADDR (start1_byte); |
6072f28afec9
(Ftranspose_regions): Use BYTE_POS_ADDR to get an
Kenichi Handa <handa@m17n.org>
parents:
23132
diff
changeset
|
3753 start2_addr = BYTE_POS_ADDR (start2_byte); |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3754 bcopy (start1_addr, temp, len1_byte); |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3755 bcopy (start2_addr, start1_addr, len2_byte); |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3756 bcopy (start1_addr + len1_byte, start1_addr + len2_byte, len_mid); |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3757 bcopy (temp, start1_addr + len2_byte + len_mid, len1_byte); |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3758 if (len1_byte > 20000) |
30606
438ad5366a03
(Ftranspose_regions): Use xfree instead of free.
Gerd Moellmann <gerd@gnu.org>
parents:
30550
diff
changeset
|
3759 xfree (temp); |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3760 graft_intervals_into_buffer (tmp_interval1, end2 - len1, |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3761 len1, current_buffer, 0); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3762 graft_intervals_into_buffer (tmp_interval_mid, start1 + len2, |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3763 len_mid, current_buffer, 0); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3764 graft_intervals_into_buffer (tmp_interval2, start1, |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3765 len2, current_buffer, 0); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3766 } |
26853
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
3767 |
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
3768 update_compositions (start1, start1 + len2, CHECK_BORDER); |
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
3769 update_compositions (end2 - len1, end2, CHECK_BORDER); |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3770 } |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3771 |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3772 /* When doing multiple transpositions, it might be nice |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3773 to optimize this. Perhaps the markers in any one buffer |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3774 should be organized in some sorted data tree. */ |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3775 if (NILP (leave_markers)) |
7519
987ab382275c
(Ftranspose_regions): Fix overlays after moving markers.
Karl Heuer <kwzh@gnu.org>
parents:
7506
diff
changeset
|
3776 { |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3777 transpose_markers (start1, end1, start2, end2, |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3778 start1_byte, start1_byte + len1_byte, |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3779 start2_byte, start2_byte + len2_byte); |
7519
987ab382275c
(Ftranspose_regions): Fix overlays after moving markers.
Karl Heuer <kwzh@gnu.org>
parents:
7506
diff
changeset
|
3780 fix_overlays_in_range (start1, end2); |
987ab382275c
(Ftranspose_regions): Fix overlays after moving markers.
Karl Heuer <kwzh@gnu.org>
parents:
7506
diff
changeset
|
3781 } |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3782 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3783 return Qnil; |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3784 } |
305 | 3785 |
3786 | |
3787 void | |
3788 syms_of_editfns () | |
3789 { | |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
3790 environbuf = 0; |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
3791 |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
3792 Qbuffer_access_fontify_functions |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
3793 = intern ("buffer-access-fontify-functions"); |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
3794 staticpro (&Qbuffer_access_fontify_functions); |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
3795 |
27077
19a664c654ab
(Vinhibit_field_text_motion): New variable.
Gerd Moellmann <gerd@gnu.org>
parents:
26853
diff
changeset
|
3796 DEFVAR_LISP ("inhibit-field-text-motion", &Vinhibit_field_text_motion, |
19a664c654ab
(Vinhibit_field_text_motion): New variable.
Gerd Moellmann <gerd@gnu.org>
parents:
26853
diff
changeset
|
3797 "Non-nil means.text motion commands don't notice fields."); |
19a664c654ab
(Vinhibit_field_text_motion): New variable.
Gerd Moellmann <gerd@gnu.org>
parents:
26853
diff
changeset
|
3798 Vinhibit_field_text_motion = Qnil; |
19a664c654ab
(Vinhibit_field_text_motion): New variable.
Gerd Moellmann <gerd@gnu.org>
parents:
26853
diff
changeset
|
3799 |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
3800 DEFVAR_LISP ("buffer-access-fontify-functions", |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
3801 &Vbuffer_access_fontify_functions, |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
3802 "List of functions called by `buffer-substring' to fontify if necessary.\n\ |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
3803 Each function is called with two arguments which specify the range\n\ |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
3804 of the buffer being accessed."); |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
3805 Vbuffer_access_fontify_functions = Qnil; |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
3806 |
14440
e99b3302c154
(syms_of_editfns): Make buffer-access-fontify-functions
Richard M. Stallman <rms@gnu.org>
parents:
14391
diff
changeset
|
3807 { |
e99b3302c154
(syms_of_editfns): Make buffer-access-fontify-functions
Richard M. Stallman <rms@gnu.org>
parents:
14391
diff
changeset
|
3808 Lisp_Object obuf; |
e99b3302c154
(syms_of_editfns): Make buffer-access-fontify-functions
Richard M. Stallman <rms@gnu.org>
parents:
14391
diff
changeset
|
3809 extern Lisp_Object Vprin1_to_string_buffer; |
e99b3302c154
(syms_of_editfns): Make buffer-access-fontify-functions
Richard M. Stallman <rms@gnu.org>
parents:
14391
diff
changeset
|
3810 obuf = Fcurrent_buffer (); |
e99b3302c154
(syms_of_editfns): Make buffer-access-fontify-functions
Richard M. Stallman <rms@gnu.org>
parents:
14391
diff
changeset
|
3811 /* Do this here, because init_buffer_once is too early--it won't work. */ |
e99b3302c154
(syms_of_editfns): Make buffer-access-fontify-functions
Richard M. Stallman <rms@gnu.org>
parents:
14391
diff
changeset
|
3812 Fset_buffer (Vprin1_to_string_buffer); |
e99b3302c154
(syms_of_editfns): Make buffer-access-fontify-functions
Richard M. Stallman <rms@gnu.org>
parents:
14391
diff
changeset
|
3813 /* Make sure buffer-access-fontify-functions is nil in this buffer. */ |
e99b3302c154
(syms_of_editfns): Make buffer-access-fontify-functions
Richard M. Stallman <rms@gnu.org>
parents:
14391
diff
changeset
|
3814 Fset (Fmake_local_variable (intern ("buffer-access-fontify-functions")), |
e99b3302c154
(syms_of_editfns): Make buffer-access-fontify-functions
Richard M. Stallman <rms@gnu.org>
parents:
14391
diff
changeset
|
3815 Qnil); |
e99b3302c154
(syms_of_editfns): Make buffer-access-fontify-functions
Richard M. Stallman <rms@gnu.org>
parents:
14391
diff
changeset
|
3816 Fset_buffer (obuf); |
e99b3302c154
(syms_of_editfns): Make buffer-access-fontify-functions
Richard M. Stallman <rms@gnu.org>
parents:
14391
diff
changeset
|
3817 } |
e99b3302c154
(syms_of_editfns): Make buffer-access-fontify-functions
Richard M. Stallman <rms@gnu.org>
parents:
14391
diff
changeset
|
3818 |
14220 | 3819 DEFVAR_LISP ("buffer-access-fontified-property", |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
3820 &Vbuffer_access_fontified_property, |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
3821 "Property which (if non-nil) indicates text has been fontified.\n\ |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
3822 `buffer-substring' need not call the `buffer-access-fontify-functions'\n\ |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
3823 functions if all the text being accessed has this property."); |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
3824 Vbuffer_access_fontified_property = Qnil; |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
3825 |
8771
31b8e48045f3
(syms_of_editfns): Make Vsystem_name and Vuser...name lisp variables again.
Karl Heuer <kwzh@gnu.org>
parents:
8667
diff
changeset
|
3826 DEFVAR_LISP ("system-name", &Vsystem_name, |
31b8e48045f3
(syms_of_editfns): Make Vsystem_name and Vuser...name lisp variables again.
Karl Heuer <kwzh@gnu.org>
parents:
8667
diff
changeset
|
3827 "The name of the machine Emacs is running on."); |
30480 | 3828 |
8771
31b8e48045f3
(syms_of_editfns): Make Vsystem_name and Vuser...name lisp variables again.
Karl Heuer <kwzh@gnu.org>
parents:
8667
diff
changeset
|
3829 DEFVAR_LISP ("user-full-name", &Vuser_full_name, |
31b8e48045f3
(syms_of_editfns): Make Vsystem_name and Vuser...name lisp variables again.
Karl Heuer <kwzh@gnu.org>
parents:
8667
diff
changeset
|
3830 "The full name of the user logged in."); |
31b8e48045f3
(syms_of_editfns): Make Vsystem_name and Vuser...name lisp variables again.
Karl Heuer <kwzh@gnu.org>
parents:
8667
diff
changeset
|
3831 |
12026
505a894d943e
(syms_of_editfns): user-login-name renamed from user-name.
Karl Heuer <kwzh@gnu.org>
parents:
11912
diff
changeset
|
3832 DEFVAR_LISP ("user-login-name", &Vuser_login_name, |
8771
31b8e48045f3
(syms_of_editfns): Make Vsystem_name and Vuser...name lisp variables again.
Karl Heuer <kwzh@gnu.org>
parents:
8667
diff
changeset
|
3833 "The user's name, taken from environment variables if possible."); |
31b8e48045f3
(syms_of_editfns): Make Vsystem_name and Vuser...name lisp variables again.
Karl Heuer <kwzh@gnu.org>
parents:
8667
diff
changeset
|
3834 |
12026
505a894d943e
(syms_of_editfns): user-login-name renamed from user-name.
Karl Heuer <kwzh@gnu.org>
parents:
11912
diff
changeset
|
3835 DEFVAR_LISP ("user-real-login-name", &Vuser_real_login_name, |
8771
31b8e48045f3
(syms_of_editfns): Make Vsystem_name and Vuser...name lisp variables again.
Karl Heuer <kwzh@gnu.org>
parents:
8667
diff
changeset
|
3836 "The user's name, based upon the real uid only."); |
305 | 3837 |
25833
65cab65c4a28
(Fpropertize): Renamed from Fproperties.
Gerd Moellmann <gerd@gnu.org>
parents:
25815
diff
changeset
|
3838 defsubr (&Spropertize); |
305 | 3839 defsubr (&Schar_equal); |
3840 defsubr (&Sgoto_char); | |
3841 defsubr (&Sstring_to_char); | |
3842 defsubr (&Schar_to_string); | |
3843 defsubr (&Sbuffer_substring); | |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
3844 defsubr (&Sbuffer_substring_no_properties); |
305 | 3845 defsubr (&Sbuffer_string); |
3846 | |
3847 defsubr (&Spoint_marker); | |
3848 defsubr (&Smark_marker); | |
3849 defsubr (&Spoint); | |
3850 defsubr (&Sregion_beginning); | |
3851 defsubr (&Sregion_end); | |
20861
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
3852 |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
3853 staticpro (&Qfield); |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
3854 Qfield = intern ("field"); |
30439
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
3855 staticpro (&Qboundary); |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
3856 Qboundary = intern ("boundary"); |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
3857 defsubr (&Sfield_beginning); |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
3858 defsubr (&Sfield_end); |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
3859 defsubr (&Sfield_string); |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
3860 defsubr (&Sfield_string_no_properties); |
26347
7fd9f4ecdd29
(Fdelete_field): Renamed from Ferase_field.
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
3861 defsubr (&Sdelete_field); |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
3862 defsubr (&Sconstrain_to_field); |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
3863 |
20861
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
3864 defsubr (&Sline_beginning_position); |
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
3865 defsubr (&Sline_end_position); |
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
3866 |
305 | 3867 /* defsubr (&Smark); */ |
3868 /* defsubr (&Sset_mark); */ | |
3869 defsubr (&Ssave_excursion); | |
16298
17304eb73f97
(Fsave_current_buffer): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16269
diff
changeset
|
3870 defsubr (&Ssave_current_buffer); |
305 | 3871 |
3872 defsubr (&Sbufsize); | |
3873 defsubr (&Spoint_max); | |
3874 defsubr (&Spoint_min); | |
3875 defsubr (&Spoint_min_marker); | |
3876 defsubr (&Spoint_max_marker); | |
21821
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
3877 defsubr (&Sgap_position); |
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
3878 defsubr (&Sgap_size); |
20861
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
3879 defsubr (&Sposition_bytes); |
22645
e5b201634497
(Fbyte_to_position): New function.
Richard M. Stallman <rms@gnu.org>
parents:
22199
diff
changeset
|
3880 defsubr (&Sbyte_to_position); |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
3881 |
305 | 3882 defsubr (&Sbobp); |
3883 defsubr (&Seobp); | |
3884 defsubr (&Sbolp); | |
3885 defsubr (&Seolp); | |
512 | 3886 defsubr (&Sfollowing_char); |
3887 defsubr (&Sprevious_char); | |
305 | 3888 defsubr (&Schar_after); |
17031 | 3889 defsubr (&Schar_before); |
305 | 3890 defsubr (&Sinsert); |
3891 defsubr (&Sinsert_before_markers); | |
4714
350231e38e68
(Finsert_and_inherit): New function.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3892 defsubr (&Sinsert_and_inherit); |
350231e38e68
(Finsert_and_inherit): New function.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3893 defsubr (&Sinsert_and_inherit_before_markers); |
305 | 3894 defsubr (&Sinsert_char); |
3895 | |
3896 defsubr (&Suser_login_name); | |
3897 defsubr (&Suser_real_login_name); | |
3898 defsubr (&Suser_uid); | |
3899 defsubr (&Suser_real_uid); | |
3900 defsubr (&Suser_full_name); | |
5373
a70b89d2d6bb
(Femacs_pid): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5242
diff
changeset
|
3901 defsubr (&Semacs_pid); |
448 | 3902 defsubr (&Scurrent_time); |
9154
b4739bcefc44
(Fformat_time_string): Mostly rewritten, to handle
Richard M. Stallman <rms@gnu.org>
parents:
8981
diff
changeset
|
3903 defsubr (&Sformat_time_string); |
30480 | 3904 defsubr (&Sfloat_time); |
9801
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
3905 defsubr (&Sdecode_time); |
11402
66d935214d8e
(Fencode_time): Use XINT to examine `zone'.
Richard M. Stallman <rms@gnu.org>
parents:
11263
diff
changeset
|
3906 defsubr (&Sencode_time); |
305 | 3907 defsubr (&Scurrent_time_string); |
962
3533821d6edc
* editfns.c (Fcurrent_time_zone): Doc fix.
Jim Blandy <jimb@redhat.com>
parents:
690
diff
changeset
|
3908 defsubr (&Scurrent_time_zone); |
13019
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
3909 defsubr (&Sset_time_zone_rule); |
305 | 3910 defsubr (&Ssystem_name); |
3911 defsubr (&Smessage); | |
8975
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3912 defsubr (&Smessage_box); |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3913 defsubr (&Smessage_or_box); |
18937
ddb91108a9d2
(Fcurrent_message): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18756
diff
changeset
|
3914 defsubr (&Scurrent_message); |
305 | 3915 defsubr (&Sformat); |
3916 | |
3917 defsubr (&Sinsert_buffer_substring); | |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
3918 defsubr (&Scompare_buffer_substrings); |
305 | 3919 defsubr (&Ssubst_char_in_region); |
3920 defsubr (&Stranslate_region); | |
3921 defsubr (&Sdelete_region); | |
26742
936b39bd05b4
* editfns.c (Fdelete_and_extract_region): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
26699
diff
changeset
|
3922 defsubr (&Sdelete_and_extract_region); |
305 | 3923 defsubr (&Swiden); |
3924 defsubr (&Snarrow_to_region); | |
3925 defsubr (&Ssave_restriction); | |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3926 defsubr (&Stranspose_regions); |
305 | 3927 } |