Mercurial > emacs
annotate src/editfns.c @ 90225:a3716f7538f2
Revision: miles@gnu.org--gnu-2005/emacs--unicode--0--patch-79
Merge from emacs--cvs-trunk--0
Patches applied:
* emacs--cvs-trunk--0 (patch 519-530)
- Update from CVS
- Merge from gnus--rel--5.10
* gnus--rel--5.10 (patch 106-111)
- Merge from emacs--cvs-trunk--0
- Update from CVS
author | Miles Bader <miles@gnu.org> |
---|---|
date | Tue, 06 Sep 2005 00:25:20 +0000 |
parents | 2d92f5c9d6ae 3c228c69b2e5 |
children | fa0da9b57058 |
rev | line source |
---|---|
305 | 1 /* Lisp functions pertaining to editing. |
64770
a0d1312ede66
Update years in copyright notice; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
64084
diff
changeset
|
2 Copyright (C) 1985, 1986, 1987, 1989, 1993, 1994, 1995, 1996, |
a0d1312ede66
Update years in copyright notice; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
64084
diff
changeset
|
3 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, |
a0d1312ede66
Update years in copyright notice; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
64084
diff
changeset
|
4 2005 Free Software Foundation, Inc. |
305 | 5 |
6 This file is part of GNU Emacs. | |
7 | |
8 GNU Emacs is free software; you can redistribute it and/or modify | |
9 it under the terms of the GNU General Public License as published by | |
12244 | 10 the Free Software Foundation; either version 2, or (at your option) |
305 | 11 any later version. |
12 | |
13 GNU Emacs is distributed in the hope that it will be useful, | |
14 but WITHOUT ANY WARRANTY; without even the implied warranty of | |
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
16 GNU General Public License for more details. | |
17 | |
18 You should have received a copy of the GNU General Public License | |
19 along with GNU Emacs; see the file COPYING. If not, write to | |
64084 | 20 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
21 Boston, MA 02110-1301, USA. */ | |
305 | 22 |
23 | |
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
parents:
26058
diff
changeset
|
24 #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
|
25 #include <sys/types.h> |
58029
46a652255057
Move #include "systime.h" before <sys/resource.h>.
Eli Zaretskii <eliz@gnu.org>
parents:
58011
diff
changeset
|
26 #include <stdio.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
|
27 |
61700
8a54ce1fae6a
Remove reference to defunct vms-pwd.h.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
61017
diff
changeset
|
28 #ifdef HAVE_PWD_H |
305 | 29 #include <pwd.h> |
372 | 30 #endif |
31 | |
21514 | 32 #ifdef HAVE_UNISTD_H |
33 #include <unistd.h> | |
34 #endif | |
35 | |
59644
d8d85276ffed
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
58029
diff
changeset
|
36 #ifdef HAVE_SYS_UTSNAME_H |
d8d85276ffed
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
58029
diff
changeset
|
37 #include <sys/utsname.h> |
d8d85276ffed
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
58029
diff
changeset
|
38 #endif |
d8d85276ffed
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
58029
diff
changeset
|
39 |
58029
46a652255057
Move #include "systime.h" before <sys/resource.h>.
Eli Zaretskii <eliz@gnu.org>
parents:
58011
diff
changeset
|
40 /* systime.h includes <sys/time.h> which, on some systems, is required |
46a652255057
Move #include "systime.h" before <sys/resource.h>.
Eli Zaretskii <eliz@gnu.org>
parents:
58011
diff
changeset
|
41 for <sys/resource.h>; thus systime.h must be included before |
46a652255057
Move #include "systime.h" before <sys/resource.h>.
Eli Zaretskii <eliz@gnu.org>
parents:
58011
diff
changeset
|
42 <sys/resource.h> */ |
46a652255057
Move #include "systime.h" before <sys/resource.h>.
Eli Zaretskii <eliz@gnu.org>
parents:
58011
diff
changeset
|
43 #include "systime.h" |
58011
79614f2016d5
editfns.c: Adding in better patch
Steven Tamm <steventamm@mac.com>
parents:
58010
diff
changeset
|
44 |
79614f2016d5
editfns.c: Adding in better patch
Steven Tamm <steventamm@mac.com>
parents:
58010
diff
changeset
|
45 #if defined HAVE_SYS_RESOURCE_H |
57987
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
46 #include <sys/resource.h> |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
47 #endif |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
48 |
40699
d51d2fa675d0
Move the include of ctype.h after unistd.h.
Richard M. Stallman <rms@gnu.org>
parents:
40656
diff
changeset
|
49 #include <ctype.h> |
d51d2fa675d0
Move the include of ctype.h after unistd.h.
Richard M. Stallman <rms@gnu.org>
parents:
40656
diff
changeset
|
50 |
305 | 51 #include "lisp.h" |
1285
d50533e23dff
* editfns.c (make_buffer_string): Call copy_intervals_to_string().
Joseph Arceneaux <jla@gnu.org>
parents:
1254
diff
changeset
|
52 #include "intervals.h" |
305 | 53 #include "buffer.h" |
88372
7d0adc8c7f07
Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents:
43042
diff
changeset
|
54 #include "character.h" |
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
parents:
26058
diff
changeset
|
55 #include "coding.h" |
38059
0b34b024286d
(Fmessage_box): If the frame is not under a window
Eli Zaretskii <eliz@gnu.org>
parents:
37916
diff
changeset
|
56 #include "frame.h" |
305 | 57 #include "window.h" |
58 | |
38519
200c049178cc
(toplevel) [STDC_HEADERS]: Include float.h.
Gerd Moellmann <gerd@gnu.org>
parents:
38059
diff
changeset
|
59 #ifdef STDC_HEADERS |
200c049178cc
(toplevel) [STDC_HEADERS]: Include float.h.
Gerd Moellmann <gerd@gnu.org>
parents:
38059
diff
changeset
|
60 #include <float.h> |
200c049178cc
(toplevel) [STDC_HEADERS]: Include float.h.
Gerd Moellmann <gerd@gnu.org>
parents:
38059
diff
changeset
|
61 #define MAX_10_EXP DBL_MAX_10_EXP |
200c049178cc
(toplevel) [STDC_HEADERS]: Include float.h.
Gerd Moellmann <gerd@gnu.org>
parents:
38059
diff
changeset
|
62 #else |
200c049178cc
(toplevel) [STDC_HEADERS]: Include float.h.
Gerd Moellmann <gerd@gnu.org>
parents:
38059
diff
changeset
|
63 #define MAX_10_EXP 310 |
200c049178cc
(toplevel) [STDC_HEADERS]: Include float.h.
Gerd Moellmann <gerd@gnu.org>
parents:
38059
diff
changeset
|
64 #endif |
200c049178cc
(toplevel) [STDC_HEADERS]: Include float.h.
Gerd Moellmann <gerd@gnu.org>
parents:
38059
diff
changeset
|
65 |
19441
2e2b54ae9b9d
(NULL): Define, if not defined.
Richard M. Stallman <rms@gnu.org>
parents:
19416
diff
changeset
|
66 #ifndef NULL |
2e2b54ae9b9d
(NULL): Define, if not defined.
Richard M. Stallman <rms@gnu.org>
parents:
19416
diff
changeset
|
67 #define NULL 0 |
2e2b54ae9b9d
(NULL): Define, if not defined.
Richard M. Stallman <rms@gnu.org>
parents:
19416
diff
changeset
|
68 #endif |
2e2b54ae9b9d
(NULL): Define, if not defined.
Richard M. Stallman <rms@gnu.org>
parents:
19416
diff
changeset
|
69 |
31095
e19d38e14720
[USE_CRT_DLL]: Remove unnecessary extern, which screws
Andrew Innes <andrewi@gnu.org>
parents:
31016
diff
changeset
|
70 #ifndef USE_CRT_DLL |
13025
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
71 extern char **environ; |
31095
e19d38e14720
[USE_CRT_DLL]: Remove unnecessary extern, which screws
Andrew Innes <andrewi@gnu.org>
parents:
31016
diff
changeset
|
72 #endif |
e19d38e14720
[USE_CRT_DLL]: Remove unnecessary extern, which screws
Andrew Innes <andrewi@gnu.org>
parents:
31016
diff
changeset
|
73 |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
74 extern Lisp_Object make_time P_ ((time_t)); |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
75 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
|
76 const struct tm *, int)); |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
77 static int tm_diff P_ ((struct tm *, struct tm *)); |
41065
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
78 static void find_field P_ ((Lisp_Object, Lisp_Object, Lisp_Object, int *, Lisp_Object, int *)); |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
79 static void update_buffer_properties P_ ((int, int)); |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
80 static Lisp_Object region_limit P_ ((int)); |
55193
1b09eb24ab02
(lisp_time_argument): Provide externally.
Eli Zaretskii <eliz@gnu.org>
parents:
54846
diff
changeset
|
81 int lisp_time_argument P_ ((Lisp_Object, time_t *, int *)); |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
82 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
|
83 size_t, const struct tm *, int)); |
46464
e05dd5b81fc7
(general_insert_function): Insertion function now
Ken Raeburn <raeburn@raeburn.org>
parents:
46447
diff
changeset
|
84 static void general_insert_function P_ ((void (*) (const unsigned char *, int), |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
85 void (*) (Lisp_Object, int, int, int, |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
86 int, int), |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
87 int, int, Lisp_Object *)); |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
88 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
|
89 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
|
90 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
|
91 |
31336 | 92 #ifdef HAVE_INDEX |
93 extern char *index P_ ((const char *, int)); | |
94 #endif | |
95 | |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
96 Lisp_Object Vbuffer_access_fontify_functions; |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
97 Lisp_Object Qbuffer_access_fontify_functions; |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
98 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
|
99 |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
100 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
|
101 |
27077
19a664c654ab
(Vinhibit_field_text_motion): New variable.
Gerd Moellmann <gerd@gnu.org>
parents:
26853
diff
changeset
|
102 /* 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
|
103 |
19a664c654ab
(Vinhibit_field_text_motion): New variable.
Gerd Moellmann <gerd@gnu.org>
parents:
26853
diff
changeset
|
104 Lisp_Object Vinhibit_field_text_motion; |
19a664c654ab
(Vinhibit_field_text_motion): New variable.
Gerd Moellmann <gerd@gnu.org>
parents:
26853
diff
changeset
|
105 |
305 | 106 /* Some static data, and a function to initialize it for each run */ |
107 | |
108 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
|
109 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
|
110 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
|
111 Lisp_Object Vuser_login_name; /* user name from LOGNAME or USER */ |
59644
d8d85276ffed
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
58029
diff
changeset
|
112 Lisp_Object Voperating_system_release; /* Operating System Release */ |
305 | 113 |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
114 /* Symbol for the text property used to mark fields. */ |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
115 |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
116 Lisp_Object Qfield; |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
117 |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
118 /* A special value for Qfield properties. */ |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
119 |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
120 Lisp_Object Qboundary; |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
121 |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
122 |
305 | 123 void |
124 init_editfns () | |
125 { | |
330 | 126 char *user_name; |
25782
8f59abd3a02b
(init_editfns): Remove unused variables.
Gerd Moellmann <gerd@gnu.org>
parents:
25662
diff
changeset
|
127 register unsigned char *p; |
305 | 128 struct passwd *pw; /* password entry for the current user */ |
129 Lisp_Object tem; | |
130 | |
131 /* 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
|
132 init_system_name (); |
305 | 133 |
134 #ifndef CANNOT_DUMP | |
135 /* Don't bother with this on initial start when just dumping out */ | |
136 if (!initialized) | |
137 return; | |
138 #endif /* not CANNOT_DUMP */ | |
139 | |
140 pw = (struct passwd *) getpwuid (getuid ()); | |
9572 | 141 #ifdef MSDOS |
142 /* We let the real user name default to "root" because that's quite | |
143 accurate on MSDOG and because it lets Emacs find the init file. | |
144 (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
|
145 Vuser_real_login_name = build_string (pw ? pw->pw_name : "root"); |
9572 | 146 #else |
12026
505a894d943e
(syms_of_editfns): user-login-name renamed from user-name.
Karl Heuer <kwzh@gnu.org>
parents:
11912
diff
changeset
|
147 Vuser_real_login_name = build_string (pw ? pw->pw_name : "unknown"); |
9572 | 148 #endif |
305 | 149 |
330 | 150 /* Get the effective user name, by consulting environment variables, |
151 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
|
152 user_name = (char *) getenv ("LOGNAME"); |
330 | 153 if (!user_name) |
9801
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
154 #ifdef WINDOWSNT |
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
155 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
|
156 #else /* WINDOWSNT */ |
5907
5fdb226fe9a4
(init_editfns): Look at LOGNAME before USER.
Karl Heuer <kwzh@gnu.org>
parents:
5884
diff
changeset
|
157 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
|
158 #endif /* WINDOWSNT */ |
305 | 159 if (!user_name) |
330 | 160 { |
161 pw = (struct passwd *) getpwuid (geteuid ()); | |
162 user_name = (char *) (pw ? pw->pw_name : "unknown"); | |
163 } | |
12026
505a894d943e
(syms_of_editfns): user-login-name renamed from user-name.
Karl Heuer <kwzh@gnu.org>
parents:
11912
diff
changeset
|
164 Vuser_login_name = build_string (user_name); |
305 | 165 |
330 | 166 /* If the user name claimed in the environment vars differs from |
167 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
|
168 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
|
169 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
|
170 : Vuser_login_name); |
30480 | 171 |
11447
d51e912495be
(init_editfns): Add casts.
Richard M. Stallman <rms@gnu.org>
parents:
11433
diff
changeset
|
172 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
|
173 if (p) |
9ab21ef32537
(init_editfns): Use NAME envvar to init user-full-name.
Richard M. Stallman <rms@gnu.org>
parents:
10480
diff
changeset
|
174 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
|
175 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
|
176 Vuser_full_name = build_string ("unknown"); |
59644
d8d85276ffed
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
58029
diff
changeset
|
177 |
d8d85276ffed
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
58029
diff
changeset
|
178 #ifdef HAVE_SYS_UTSNAME_H |
d8d85276ffed
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
58029
diff
changeset
|
179 { |
d8d85276ffed
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
58029
diff
changeset
|
180 struct utsname uts; |
d8d85276ffed
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
58029
diff
changeset
|
181 uname (&uts); |
d8d85276ffed
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
58029
diff
changeset
|
182 Voperating_system_release = build_string (uts.release); |
d8d85276ffed
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
58029
diff
changeset
|
183 } |
d8d85276ffed
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
58029
diff
changeset
|
184 #else |
d8d85276ffed
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
58029
diff
changeset
|
185 Voperating_system_release = Qnil; |
d8d85276ffed
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
58029
diff
changeset
|
186 #endif |
305 | 187 } |
188 | |
189 DEFUN ("char-to-string", Fchar_to_string, Schar_to_string, 1, 1, 0, | |
40203
9d2aeb5c05b4
(char-to-string): Fix argument names (use CHAR instead of C) and usage.
Pavel Janík <Pavel@Janik.cz>
parents:
40140
diff
changeset
|
190 doc: /* Convert arg CHAR to a string containing that character. |
9d2aeb5c05b4
(char-to-string): Fix argument names (use CHAR instead of C) and usage.
Pavel Janík <Pavel@Janik.cz>
parents:
40140
diff
changeset
|
191 usage: (char-to-string CHAR) */) |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
192 (character) |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
193 Lisp_Object character; |
305 | 194 { |
17031 | 195 int len; |
26853
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
196 unsigned char str[MAX_MULTIBYTE_LENGTH]; |
17031 | 197 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
198 CHECK_NUMBER (character); |
305 | 199 |
88372
7d0adc8c7f07
Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents:
43042
diff
changeset
|
200 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
|
201 return make_string_from_bytes (str, 1, len); |
305 | 202 } |
203 | |
204 DEFUN ("string-to-char", Fstring_to_char, Sstring_to_char, 1, 1, 0, | |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
205 doc: /* Convert arg STRING to a character, the first character of that string. |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
206 A multibyte character is handled correctly. */) |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
207 (string) |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
208 register Lisp_Object string; |
305 | 209 { |
210 register Lisp_Object val; | |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
211 CHECK_STRING (string); |
46443
b612fecce4cc
(Fstring_to_char): Use string macros instead of Lisp_String fields.
Ken Raeburn <raeburn@raeburn.org>
parents:
46370
diff
changeset
|
212 if (SCHARS (string)) |
23650
3cc42e65f25b
(Fstring_to_char): Don't return a multibyte character
Kenichi Handa <handa@m17n.org>
parents:
23596
diff
changeset
|
213 { |
3cc42e65f25b
(Fstring_to_char): Don't return a multibyte character
Kenichi Handa <handa@m17n.org>
parents:
23596
diff
changeset
|
214 if (STRING_MULTIBYTE (string)) |
46443
b612fecce4cc
(Fstring_to_char): Use string macros instead of Lisp_String fields.
Ken Raeburn <raeburn@raeburn.org>
parents:
46370
diff
changeset
|
215 XSETFASTINT (val, STRING_CHAR (SDATA (string), SBYTES (string))); |
23650
3cc42e65f25b
(Fstring_to_char): Don't return a multibyte character
Kenichi Handa <handa@m17n.org>
parents:
23596
diff
changeset
|
216 else |
46443
b612fecce4cc
(Fstring_to_char): Use string macros instead of Lisp_String fields.
Ken Raeburn <raeburn@raeburn.org>
parents:
46370
diff
changeset
|
217 XSETFASTINT (val, SREF (string, 0)); |
23650
3cc42e65f25b
(Fstring_to_char): Don't return a multibyte character
Kenichi Handa <handa@m17n.org>
parents:
23596
diff
changeset
|
218 } |
305 | 219 else |
9305
ac077e2a75f1
(Fstring_to_char, Fpoint, Fbufsize, Fpoint_min, Fpoint_max, Ffollowing_char,
Karl Heuer <kwzh@gnu.org>
parents:
9265
diff
changeset
|
220 XSETFASTINT (val, 0); |
305 | 221 return val; |
222 } | |
223 | |
224 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
|
225 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
|
226 int charpos, bytepos; |
305 | 227 { |
228 register Lisp_Object mark; | |
229 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
|
230 set_marker_both (mark, Qnil, charpos, bytepos); |
305 | 231 return mark; |
232 } | |
233 | |
234 DEFUN ("point", Fpoint, Spoint, 0, 0, 0, | |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
235 doc: /* Return value of point, as an integer. |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
236 Beginning of buffer is position (point-min). */) |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
237 () |
305 | 238 { |
239 Lisp_Object temp; | |
16039
855c8d8ba0f0
Change all references from point to PT.
Karl Heuer <kwzh@gnu.org>
parents:
15910
diff
changeset
|
240 XSETFASTINT (temp, PT); |
305 | 241 return temp; |
242 } | |
243 | |
244 DEFUN ("point-marker", Fpoint_marker, Spoint_marker, 0, 0, 0, | |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
245 doc: /* Return value of point, as a marker object. */) |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
246 () |
305 | 247 { |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
248 return buildmark (PT, PT_BYTE); |
305 | 249 } |
250 | |
251 int | |
252 clip_to_bounds (lower, num, upper) | |
253 int lower, num, upper; | |
254 { | |
255 if (num < lower) | |
256 return lower; | |
257 else if (num > upper) | |
258 return upper; | |
259 else | |
260 return num; | |
261 } | |
262 | |
263 DEFUN ("goto-char", Fgoto_char, Sgoto_char, 1, 1, "NGoto char: ", | |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
264 doc: /* Set point to POSITION, a number or marker. |
61017
595361160197
(Fgoto_char): Fix docstring. Probably left-over from Emacs-20.1.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
59662
diff
changeset
|
265 Beginning of buffer is position (point-min), end is (point-max). */) |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
266 (position) |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
267 register Lisp_Object position; |
305 | 268 { |
17031 | 269 int pos; |
270 | |
21226
c8d0df2cbd3d
(Fgoto_char): If POSITION is a marker pointing a
Richard M. Stallman <rms@gnu.org>
parents:
21225
diff
changeset
|
271 if (MARKERP (position) |
c8d0df2cbd3d
(Fgoto_char): If POSITION is a marker pointing a
Richard M. Stallman <rms@gnu.org>
parents:
21225
diff
changeset
|
272 && 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
|
273 { |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
274 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
|
275 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
|
276 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
|
277 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
|
278 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
|
279 else |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
280 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
|
281 |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
282 return position; |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
283 } |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
284 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
285 CHECK_NUMBER_COERCE_MARKER (position); |
305 | 286 |
17031 | 287 pos = clip_to_bounds (BEGV, XINT (position), ZV); |
288 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
|
289 return position; |
305 | 290 } |
291 | |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
292 |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
293 /* Return the start or end position of the region. |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
294 BEGINNINGP non-zero means return the start. |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
295 If there is no region active, signal an error. */ |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
296 |
305 | 297 static Lisp_Object |
298 region_limit (beginningp) | |
299 int beginningp; | |
300 { | |
4047
e950abdc9ed2
(region_limit): Declare Vmark_even_if_inactive.
Roland McGrath <roland@gnu.org>
parents:
4038
diff
changeset
|
301 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
|
302 Lisp_Object m; |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49472
diff
changeset
|
303 |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
304 if (!NILP (Vtransient_mark_mode) |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
305 && 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
|
306 && 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
|
307 Fsignal (Qmark_inactive, Qnil); |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49472
diff
changeset
|
308 |
305 | 309 m = Fmarker_position (current_buffer->mark); |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
310 if (NILP (m)) |
43042
63639e690611
(region_limit): Nicer error message.
Richard M. Stallman <rms@gnu.org>
parents:
42484
diff
changeset
|
311 error ("The mark is not set now, so there is no region"); |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49472
diff
changeset
|
312 |
52451
c7860e5cc982
(region_limit): Support any non-zero value of BEGINNINGP.
Eli Zaretskii <eliz@gnu.org>
parents:
52401
diff
changeset
|
313 if ((PT < XFASTINT (m)) == (beginningp != 0)) |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
314 m = make_number (PT); |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
315 return m; |
305 | 316 } |
317 | |
318 DEFUN ("region-beginning", Fregion_beginning, Sregion_beginning, 0, 0, 0, | |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
319 doc: /* Return position of beginning of region, as an integer. */) |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
320 () |
305 | 321 { |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
322 return region_limit (1); |
305 | 323 } |
324 | |
325 DEFUN ("region-end", Fregion_end, Sregion_end, 0, 0, 0, | |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
326 doc: /* Return position of end of region, as an integer. */) |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
327 () |
305 | 328 { |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
329 return region_limit (0); |
305 | 330 } |
331 | |
332 DEFUN ("mark-marker", Fmark_marker, Smark_marker, 0, 0, 0, | |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
333 doc: /* Return this buffer's mark, as a marker object. |
39966
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
334 Watch out! Moving this marker changes the mark position. |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
335 If you set the marker not to point anywhere, the buffer will have no mark. */) |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
336 () |
305 | 337 { |
338 return current_buffer->mark; | |
339 } | |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
340 |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
341 |
48094
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
342 /* Find all the overlays in the current buffer that touch position POS. |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
343 Return the number found, and store them in a vector in VEC |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
344 of length LEN. */ |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
345 |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
346 static int |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
347 overlays_around (pos, vec, len) |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
348 int pos; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
349 Lisp_Object *vec; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
350 int len; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
351 { |
51841
59ba1f5d0a16
(overlays_around): Use new type for overlays_(before|after).
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
51670
diff
changeset
|
352 Lisp_Object overlay, start, end; |
59ba1f5d0a16
(overlays_around): Use new type for overlays_(before|after).
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
51670
diff
changeset
|
353 struct Lisp_Overlay *tail; |
48094
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
354 int startpos, endpos; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
355 int idx = 0; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
356 |
51841
59ba1f5d0a16
(overlays_around): Use new type for overlays_(before|after).
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
51670
diff
changeset
|
357 for (tail = current_buffer->overlays_before; tail; tail = tail->next) |
48094
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
358 { |
51841
59ba1f5d0a16
(overlays_around): Use new type for overlays_(before|after).
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
51670
diff
changeset
|
359 XSETMISC (overlay, tail); |
48094
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
360 |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
361 end = OVERLAY_END (overlay); |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
362 endpos = OVERLAY_POSITION (end); |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
363 if (endpos < pos) |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
364 break; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
365 start = OVERLAY_START (overlay); |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
366 startpos = OVERLAY_POSITION (start); |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
367 if (startpos <= pos) |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
368 { |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
369 if (idx < len) |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
370 vec[idx] = overlay; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
371 /* Keep counting overlays even if we can't return them all. */ |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
372 idx++; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
373 } |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
374 } |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
375 |
51841
59ba1f5d0a16
(overlays_around): Use new type for overlays_(before|after).
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
51670
diff
changeset
|
376 for (tail = current_buffer->overlays_after; tail; tail = tail->next) |
48094
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
377 { |
51841
59ba1f5d0a16
(overlays_around): Use new type for overlays_(before|after).
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
51670
diff
changeset
|
378 XSETMISC (overlay, tail); |
48094
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
379 |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
380 start = OVERLAY_START (overlay); |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
381 startpos = OVERLAY_POSITION (start); |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
382 if (pos < startpos) |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
383 break; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
384 end = OVERLAY_END (overlay); |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
385 endpos = OVERLAY_POSITION (end); |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
386 if (pos <= endpos) |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
387 { |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
388 if (idx < len) |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
389 vec[idx] = overlay; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
390 idx++; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
391 } |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
392 } |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
393 |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
394 return idx; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
395 } |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
396 |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
397 /* Return the value of property PROP, in OBJECT at POSITION. |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
398 It's the value of PROP that a char inserted at POSITION would get. |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
399 OBJECT is optional and defaults to the current buffer. |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
400 If OBJECT is a buffer, then overlay properties are considered as well as |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
401 text properties. |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
402 If OBJECT is a window, then that window's buffer is used, but |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
403 window-specific overlays are considered only if they are associated |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
404 with OBJECT. */ |
48134
ef2b87569c38
(get_pos_property): Don't hardcode Qfield.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48115
diff
changeset
|
405 Lisp_Object |
48094
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
406 get_pos_property (position, prop, object) |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
407 Lisp_Object position, object; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
408 register Lisp_Object prop; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
409 { |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
410 CHECK_NUMBER_COERCE_MARKER (position); |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
411 |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
412 if (NILP (object)) |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
413 XSETBUFFER (object, current_buffer); |
51042
edeae7524de9
(get_pos_property): Don't assume that `object' = nil.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50746
diff
changeset
|
414 else if (WINDOWP (object)) |
edeae7524de9
(get_pos_property): Don't assume that `object' = nil.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50746
diff
changeset
|
415 object = XWINDOW (object)->buffer; |
edeae7524de9
(get_pos_property): Don't assume that `object' = nil.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50746
diff
changeset
|
416 |
edeae7524de9
(get_pos_property): Don't assume that `object' = nil.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50746
diff
changeset
|
417 if (!BUFFERP (object)) |
edeae7524de9
(get_pos_property): Don't assume that `object' = nil.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50746
diff
changeset
|
418 /* pos-property only makes sense in buffers right now, since strings |
edeae7524de9
(get_pos_property): Don't assume that `object' = nil.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50746
diff
changeset
|
419 have no overlays and no notion of insertion for which stickiness |
edeae7524de9
(get_pos_property): Don't assume that `object' = nil.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50746
diff
changeset
|
420 could be obeyed. */ |
edeae7524de9
(get_pos_property): Don't assume that `object' = nil.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50746
diff
changeset
|
421 return Fget_text_property (position, prop, object); |
edeae7524de9
(get_pos_property): Don't assume that `object' = nil.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50746
diff
changeset
|
422 else |
48094
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
423 { |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
424 int posn = XINT (position); |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
425 int noverlays; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
426 Lisp_Object *overlay_vec, tem; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
427 struct buffer *obuf = current_buffer; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
428 |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
429 set_buffer_temp (XBUFFER (object)); |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
430 |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
431 /* First try with room for 40 overlays. */ |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
432 noverlays = 40; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
433 overlay_vec = (Lisp_Object *) alloca (noverlays * sizeof (Lisp_Object)); |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
434 noverlays = overlays_around (posn, overlay_vec, noverlays); |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
435 |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
436 /* If there are more than 40, |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
437 make enough space for all, and try again. */ |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
438 if (noverlays > 40) |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
439 { |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
440 overlay_vec = (Lisp_Object *) alloca (noverlays * sizeof (Lisp_Object)); |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
441 noverlays = overlays_around (posn, overlay_vec, noverlays); |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
442 } |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
443 noverlays = sort_overlays (overlay_vec, noverlays, NULL); |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
444 |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
445 set_buffer_temp (obuf); |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
446 |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
447 /* Now check the overlays in order of decreasing priority. */ |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
448 while (--noverlays >= 0) |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
449 { |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
450 Lisp_Object ol = overlay_vec[noverlays]; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
451 tem = Foverlay_get (ol, prop); |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
452 if (!NILP (tem)) |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
453 { |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
454 /* Check the overlay is indeed active at point. */ |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
455 Lisp_Object start = OVERLAY_START (ol), finish = OVERLAY_END (ol); |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
456 if ((OVERLAY_POSITION (start) == posn |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
457 && XMARKER (start)->insertion_type == 1) |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
458 || (OVERLAY_POSITION (finish) == posn |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
459 && XMARKER (finish)->insertion_type == 0)) |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
460 ; /* The overlay will not cover a char inserted at point. */ |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
461 else |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
462 { |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
463 return tem; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
464 } |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
465 } |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
466 } |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49472
diff
changeset
|
467 |
51042
edeae7524de9
(get_pos_property): Don't assume that `object' = nil.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50746
diff
changeset
|
468 { /* Now check the text-properties. */ |
edeae7524de9
(get_pos_property): Don't assume that `object' = nil.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50746
diff
changeset
|
469 int stickiness = text_property_stickiness (prop, position, object); |
edeae7524de9
(get_pos_property): Don't assume that `object' = nil.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50746
diff
changeset
|
470 if (stickiness > 0) |
edeae7524de9
(get_pos_property): Don't assume that `object' = nil.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50746
diff
changeset
|
471 return Fget_text_property (position, prop, object); |
edeae7524de9
(get_pos_property): Don't assume that `object' = nil.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50746
diff
changeset
|
472 else if (stickiness < 0 |
edeae7524de9
(get_pos_property): Don't assume that `object' = nil.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50746
diff
changeset
|
473 && XINT (position) > BUF_BEGV (XBUFFER (object))) |
edeae7524de9
(get_pos_property): Don't assume that `object' = nil.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50746
diff
changeset
|
474 return Fget_text_property (make_number (XINT (position) - 1), |
edeae7524de9
(get_pos_property): Don't assume that `object' = nil.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50746
diff
changeset
|
475 prop, object); |
edeae7524de9
(get_pos_property): Don't assume that `object' = nil.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50746
diff
changeset
|
476 else |
edeae7524de9
(get_pos_property): Don't assume that `object' = nil.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50746
diff
changeset
|
477 return Qnil; |
edeae7524de9
(get_pos_property): Don't assume that `object' = nil.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50746
diff
changeset
|
478 } |
48094
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
479 } |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
480 } |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
481 |
26389
e2acf63b5403
(Fline_beginning_position): If N is not 1,
Richard M. Stallman <rms@gnu.org>
parents:
26372
diff
changeset
|
482 /* 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
|
483 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
|
484 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
|
485 |
41065
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
486 BEG_LIMIT and END_LIMIT serve to limit the ranged of the returned |
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
487 results; they do not effect boundary behavior. |
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
488 |
26389
e2acf63b5403
(Fline_beginning_position): If N is not 1,
Richard M. Stallman <rms@gnu.org>
parents:
26372
diff
changeset
|
489 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
|
490 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
|
491 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
|
492 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
|
493 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
|
494 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
|
495 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
|
496 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
|
497 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
|
498 |
e2acf63b5403
(Fline_beginning_position): If N is not 1,
Richard M. Stallman <rms@gnu.org>
parents:
26372
diff
changeset
|
499 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
|
500 is not stored. */ |
e2acf63b5403
(Fline_beginning_position): If N is not 1,
Richard M. Stallman <rms@gnu.org>
parents:
26372
diff
changeset
|
501 |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
502 static void |
41065
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
503 find_field (pos, merge_at_boundary, beg_limit, beg, end_limit, end) |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
504 Lisp_Object pos; |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
505 Lisp_Object merge_at_boundary; |
41065
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
506 Lisp_Object beg_limit, end_limit; |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
507 int *beg, *end; |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
508 { |
30439
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
509 /* Fields right before and after the point. */ |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
510 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
|
511 /* 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
|
512 int at_field_start = 0; |
e2acf63b5403
(Fline_beginning_position): If N is not 1,
Richard M. Stallman <rms@gnu.org>
parents:
26372
diff
changeset
|
513 /* 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
|
514 int at_field_end = 0; |
30439
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
515 |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
516 if (NILP (pos)) |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
517 XSETFASTINT (pos, PT); |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
518 else |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
519 CHECK_NUMBER_COERCE_MARKER (pos); |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
520 |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
521 after_field |
48094
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
522 = get_char_property_and_overlay (pos, Qfield, Qnil, NULL); |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
523 before_field |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
524 = (XFASTINT (pos) > BEGV |
32850 | 525 ? get_char_property_and_overlay (make_number (XINT (pos) - 1), |
48094
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
526 Qfield, Qnil, NULL) |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
527 : Qnil); |
30439
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
528 |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
529 /* 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
|
530 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
|
531 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
|
532 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
|
533 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
|
534 specially. */ |
48094
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
535 if (NILP (merge_at_boundary)) |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
536 { |
48094
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
537 Lisp_Object field = get_pos_property (pos, Qfield, Qnil); |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
538 if (!EQ (field, after_field)) |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
539 at_field_end = 1; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
540 if (!EQ (field, before_field)) |
30439
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
541 at_field_start = 1; |
48111
7103ad01172d
(find_field): Make an exception for nil fields.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48094
diff
changeset
|
542 if (NILP (field) && at_field_start && at_field_end) |
7103ad01172d
(find_field): Make an exception for nil fields.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48094
diff
changeset
|
543 /* If an inserted char would have a nil field while the surrounding |
7103ad01172d
(find_field): Make an exception for nil fields.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48094
diff
changeset
|
544 text is non-nil, we're probably not looking at a |
7103ad01172d
(find_field): Make an exception for nil fields.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48094
diff
changeset
|
545 zero-length field, but instead at a non-nil field that's |
7103ad01172d
(find_field): Make an exception for nil fields.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48094
diff
changeset
|
546 not intended for editing (such as comint's prompts). */ |
7103ad01172d
(find_field): Make an exception for nil fields.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48094
diff
changeset
|
547 at_field_end = at_field_start = 0; |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
548 } |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
549 |
30439
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
550 /* Note about special `boundary' fields: |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
551 |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
552 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
|
553 |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
554 xxxx.yyyy |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
555 |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
556 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
|
557 `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
|
558 of the field is the end of `y'. |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
559 |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
560 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
|
561 (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
|
562 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
|
563 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
|
564 |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
565 xxx.BBBByyyy |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
566 |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
567 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
|
568 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
|
569 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
|
570 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
|
571 |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
572 if (beg) |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
573 { |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
574 if (at_field_start) |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
575 /* 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
|
576 the beginning of the following field. */ |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
577 *beg = XFASTINT (pos); |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
578 else |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
579 /* Find the previous field boundary. */ |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
580 { |
48094
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
581 Lisp_Object p = pos; |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
582 if (!NILP (merge_at_boundary) && EQ (before_field, Qboundary)) |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
583 /* Skip a `boundary' field. */ |
48094
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
584 p = Fprevious_single_char_property_change (p, Qfield, Qnil, |
41065
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
585 beg_limit); |
48094
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
586 |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
587 p = Fprevious_single_char_property_change (p, Qfield, Qnil, |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
588 beg_limit); |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
589 *beg = NILP (p) ? BEGV : XFASTINT (p); |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
590 } |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
591 } |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
592 |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
593 if (end) |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
594 { |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
595 if (at_field_end) |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
596 /* 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
|
597 the end of the previous field. */ |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
598 *end = XFASTINT (pos); |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
599 else |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
600 /* Find the next field boundary. */ |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
601 { |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
602 if (!NILP (merge_at_boundary) && EQ (after_field, Qboundary)) |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
603 /* Skip a `boundary' field. */ |
41065
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
604 pos = Fnext_single_char_property_change (pos, Qfield, Qnil, |
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
605 end_limit); |
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
606 |
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
607 pos = Fnext_single_char_property_change (pos, Qfield, Qnil, |
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
608 end_limit); |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
609 *end = NILP (pos) ? ZV : XFASTINT (pos); |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
610 } |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
611 } |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
612 } |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
613 |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
614 |
26629
05dcbc266797
(Fdelete_field): Make it noninteractive. Return nil.
Richard M. Stallman <rms@gnu.org>
parents:
26526
diff
changeset
|
615 DEFUN ("delete-field", Fdelete_field, Sdelete_field, 0, 1, 0, |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
616 doc: /* Delete the field surrounding POS. |
39966
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
617 A field is a region of text with the same `field' property. |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
618 If POS is nil, the value of point is used for POS. */) |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
619 (pos) |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
620 Lisp_Object pos; |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
621 { |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
622 int beg, end; |
41065
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
623 find_field (pos, Qnil, Qnil, &beg, Qnil, &end); |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
624 if (beg != end) |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
625 del_range (beg, end); |
26629
05dcbc266797
(Fdelete_field): Make it noninteractive. Return nil.
Richard M. Stallman <rms@gnu.org>
parents:
26526
diff
changeset
|
626 return Qnil; |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
627 } |
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 DEFUN ("field-string", Ffield_string, Sfield_string, 0, 1, 0, |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
630 doc: /* Return the contents of the field surrounding POS as a string. |
39966
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
631 A field is a region of text with the same `field' property. |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
632 If POS is nil, the value of point is used for POS. */) |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
633 (pos) |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
634 Lisp_Object pos; |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
635 { |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
636 int beg, end; |
41065
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
637 find_field (pos, Qnil, Qnil, &beg, Qnil, &end); |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
638 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
|
639 } |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
640 |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
641 DEFUN ("field-string-no-properties", Ffield_string_no_properties, Sfield_string_no_properties, 0, 1, 0, |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
642 doc: /* Return the contents of the field around POS, without text-properties. |
39966
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
643 A field is a region of text with the same `field' property. |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
644 If POS is nil, the value of point is used for POS. */) |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
645 (pos) |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
646 Lisp_Object pos; |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
647 { |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
648 int beg, end; |
41065
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
649 find_field (pos, Qnil, Qnil, &beg, Qnil, &end); |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
650 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
|
651 } |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
652 |
41065
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
653 DEFUN ("field-beginning", Ffield_beginning, Sfield_beginning, 0, 3, 0, |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
654 doc: /* Return the beginning of the field surrounding POS. |
39966
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
655 A field is a region of text with the same `field' property. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
656 If POS is nil, the value of point is used for POS. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
657 If ESCAPE-FROM-EDGE is non-nil and POS is at the beginning of its |
41065
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
658 field, then the beginning of the *previous* field is returned. |
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
659 If LIMIT is non-nil, it is a buffer position; if the beginning of the field |
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
660 is before LIMIT, then LIMIT will be returned instead. */) |
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
661 (pos, escape_from_edge, limit) |
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
662 Lisp_Object pos, escape_from_edge, limit; |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
663 { |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
664 int beg; |
41065
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
665 find_field (pos, escape_from_edge, limit, &beg, Qnil, 0); |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
666 return make_number (beg); |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
667 } |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
668 |
41065
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
669 DEFUN ("field-end", Ffield_end, Sfield_end, 0, 3, 0, |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
670 doc: /* Return the end of the field surrounding POS. |
39966
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
671 A field is a region of text with the same `field' property. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
672 If POS is nil, the value of point is used for POS. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
673 If ESCAPE-FROM-EDGE is non-nil and POS is at the end of its field, |
41065
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
674 then the end of the *following* field is returned. |
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
675 If LIMIT is non-nil, it is a buffer position; if the end of the field |
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
676 is after LIMIT, then LIMIT will be returned instead. */) |
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
677 (pos, escape_from_edge, limit) |
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
678 Lisp_Object pos, escape_from_edge, limit; |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
679 { |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
680 int end; |
41065
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
681 find_field (pos, escape_from_edge, Qnil, 0, limit, &end); |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
682 return make_number (end); |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
683 } |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
684 |
30439
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
685 DEFUN ("constrain-to-field", Fconstrain_to_field, Sconstrain_to_field, 2, 5, 0, |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
686 doc: /* Return the position closest to NEW-POS that is in the same field as OLD-POS. |
39966
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
687 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
688 A field is a region of text with the same `field' property. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
689 If NEW-POS is nil, then the current point is used instead, and set to the |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
690 constrained position if that is different. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
691 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
692 If OLD-POS is at the boundary of two fields, then the allowable |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
693 positions for NEW-POS depends on the value of the optional argument |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
694 ESCAPE-FROM-EDGE: If ESCAPE-FROM-EDGE is nil, then NEW-POS is |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
695 constrained to the field that has the same `field' char-property |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
696 as any new characters inserted at OLD-POS, whereas if ESCAPE-FROM-EDGE |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
697 is non-nil, NEW-POS is constrained to the union of the two adjacent |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
698 fields. Additionally, if two fields are separated by another field with |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
699 the special value `boundary', then any point within this special field is |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
700 also considered to be `on the boundary'. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
701 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
702 If the optional argument ONLY-IN-LINE is non-nil and constraining |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
703 NEW-POS would move it to a different line, NEW-POS is returned |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
704 unconstrained. This useful for commands that move by line, like |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
705 \\[next-line] or \\[beginning-of-line], which should generally respect field boundaries |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
706 only in the case where they can still move to the right line. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
707 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
708 If the optional argument INHIBIT-CAPTURE-PROPERTY is non-nil, and OLD-POS has |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
709 a non-nil property of that name, then any field boundaries are ignored. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
710 |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
711 Field boundaries are not noticed if `inhibit-field-text-motion' is non-nil. */) |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
712 (new_pos, old_pos, escape_from_edge, only_in_line, inhibit_capture_property) |
30439
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
713 Lisp_Object new_pos, old_pos; |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
714 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
|
715 { |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
716 /* 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
|
717 int orig_point = 0; |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
718 |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
719 if (NILP (new_pos)) |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
720 /* 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
|
721 { |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
722 orig_point = PT; |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
723 XSETFASTINT (new_pos, PT); |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
724 } |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
725 |
27081
f068649f1c28
(Fconstrain_to_field): Don't constrain if
Gerd Moellmann <gerd@gnu.org>
parents:
27077
diff
changeset
|
726 if (NILP (Vinhibit_field_text_motion) |
f068649f1c28
(Fconstrain_to_field): Don't constrain if
Gerd Moellmann <gerd@gnu.org>
parents:
27077
diff
changeset
|
727 && !EQ (new_pos, old_pos) |
32517
78c3fdea490c
(Fconstrain_to_field): Check carefully for field boundaries if either
Miles Bader <miles@gnu.org>
parents:
32420
diff
changeset
|
728 && (!NILP (Fget_char_property (new_pos, Qfield, Qnil)) |
78c3fdea490c
(Fconstrain_to_field): Check carefully for field boundaries if either
Miles Bader <miles@gnu.org>
parents:
32420
diff
changeset
|
729 || !NILP (Fget_char_property (old_pos, Qfield, Qnil))) |
30439
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
730 && (NILP (inhibit_capture_property) |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
731 || 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
|
732 /* 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
|
733 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
|
734 { |
30439
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
735 int fwd, shortage; |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
736 Lisp_Object field_bound; |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
737 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
738 CHECK_NUMBER_COERCE_MARKER (new_pos); |
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
739 CHECK_NUMBER_COERCE_MARKER (old_pos); |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
740 |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
741 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
|
742 |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
743 if (fwd) |
41065
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
744 field_bound = Ffield_end (old_pos, escape_from_edge, new_pos); |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
745 else |
41065
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
746 field_bound = Ffield_beginning (old_pos, escape_from_edge, new_pos); |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
747 |
30550
73040724e653
(Fconstrain_to_field): Fix the conditions for deciding when to constrain
Miles Bader <miles@gnu.org>
parents:
30503
diff
changeset
|
748 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
|
749 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
|
750 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
|
751 to FIELD_BOUND. */ |
73040724e653
(Fconstrain_to_field): Fix the conditions for deciding when to constrain
Miles Bader <miles@gnu.org>
parents:
30503
diff
changeset
|
752 ((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
|
753 /* 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
|
754 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
|
755 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
|
756 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
|
757 && (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
|
758 /* 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
|
759 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
|
760 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
|
761 || (scan_buffer ('\n', |
73040724e653
(Fconstrain_to_field): Fix the conditions for deciding when to constrain
Miles Bader <miles@gnu.org>
parents:
30503
diff
changeset
|
762 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
|
763 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
|
764 shortage != 0))) |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
765 /* 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
|
766 new_pos = field_bound; |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
767 |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
768 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
|
769 /* 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
|
770 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
|
771 } |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
772 |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
773 return new_pos; |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
774 } |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
775 |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
776 |
40042
c9ad5da1f79d
(Fline_beginning_position, Fline_end_position): Clarify documentation.
Miles Bader <miles@gnu.org>
parents:
39988
diff
changeset
|
777 DEFUN ("line-beginning-position", |
c9ad5da1f79d
(Fline_beginning_position, Fline_end_position): Clarify documentation.
Miles Bader <miles@gnu.org>
parents:
39988
diff
changeset
|
778 Fline_beginning_position, Sline_beginning_position, 0, 1, 0, |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
779 doc: /* Return the character position of the first character on the current line. |
39966
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
780 With argument N not nil or 1, move forward N - 1 lines first. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
781 If scan reaches end of buffer, return that position. |
40042
c9ad5da1f79d
(Fline_beginning_position, Fline_end_position): Clarify documentation.
Miles Bader <miles@gnu.org>
parents:
39988
diff
changeset
|
782 |
c9ad5da1f79d
(Fline_beginning_position, Fline_end_position): Clarify documentation.
Miles Bader <miles@gnu.org>
parents:
39988
diff
changeset
|
783 The scan does not cross a field boundary unless doing so would move |
c9ad5da1f79d
(Fline_beginning_position, Fline_end_position): Clarify documentation.
Miles Bader <miles@gnu.org>
parents:
39988
diff
changeset
|
784 beyond there to a different line; if N is nil or 1, and scan starts at a |
c9ad5da1f79d
(Fline_beginning_position, Fline_end_position): Clarify documentation.
Miles Bader <miles@gnu.org>
parents:
39988
diff
changeset
|
785 field boundary, the scan stops as soon as it starts. To ignore field |
c9ad5da1f79d
(Fline_beginning_position, Fline_end_position): Clarify documentation.
Miles Bader <miles@gnu.org>
parents:
39988
diff
changeset
|
786 boundaries bind `inhibit-field-text-motion' to t. |
39966
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
787 |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
788 This function does not move point. */) |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
789 (n) |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
790 Lisp_Object n; |
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
791 { |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
792 int orig, orig_byte, end; |
305 | 793 |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
794 if (NILP (n)) |
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
795 XSETFASTINT (n, 1); |
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
796 else |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
797 CHECK_NUMBER (n); |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
798 |
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
799 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
|
800 orig_byte = PT_BYTE; |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
801 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
|
802 end = PT; |
25647
947cb0e32a1d
(Fline_beginning_position): Handle minibuffer prompt here.
Richard M. Stallman <rms@gnu.org>
parents:
25609
diff
changeset
|
803 |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
804 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
|
805 |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
806 /* 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
|
807 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
|
808 XINT (n) != 1 ? Qt : Qnil, |
30439
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
809 Qt, Qnil); |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
810 } |
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
811 |
40042
c9ad5da1f79d
(Fline_beginning_position, Fline_end_position): Clarify documentation.
Miles Bader <miles@gnu.org>
parents:
39988
diff
changeset
|
812 DEFUN ("line-end-position", Fline_end_position, Sline_end_position, 0, 1, 0, |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
813 doc: /* Return the character position of the last character on the current line. |
39966
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
814 With argument N not nil or 1, move forward N - 1 lines first. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
815 If scan reaches end of buffer, return that position. |
40042
c9ad5da1f79d
(Fline_beginning_position, Fline_end_position): Clarify documentation.
Miles Bader <miles@gnu.org>
parents:
39988
diff
changeset
|
816 |
c9ad5da1f79d
(Fline_beginning_position, Fline_end_position): Clarify documentation.
Miles Bader <miles@gnu.org>
parents:
39988
diff
changeset
|
817 The scan does not cross a field boundary unless doing so would move |
c9ad5da1f79d
(Fline_beginning_position, Fline_end_position): Clarify documentation.
Miles Bader <miles@gnu.org>
parents:
39988
diff
changeset
|
818 beyond there to a different line; if N is nil or 1, and scan starts at a |
c9ad5da1f79d
(Fline_beginning_position, Fline_end_position): Clarify documentation.
Miles Bader <miles@gnu.org>
parents:
39988
diff
changeset
|
819 field boundary, the scan stops as soon as it starts. To ignore field |
c9ad5da1f79d
(Fline_beginning_position, Fline_end_position): Clarify documentation.
Miles Bader <miles@gnu.org>
parents:
39988
diff
changeset
|
820 boundaries bind `inhibit-field-text-motion' to t. |
c9ad5da1f79d
(Fline_beginning_position, Fline_end_position): Clarify documentation.
Miles Bader <miles@gnu.org>
parents:
39988
diff
changeset
|
821 |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
822 This function does not move point. */) |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
823 (n) |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
824 Lisp_Object n; |
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
825 { |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
826 int end_pos; |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
827 int orig = PT; |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
828 |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
829 if (NILP (n)) |
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
830 XSETFASTINT (n, 1); |
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
831 else |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
832 CHECK_NUMBER (n); |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
833 |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
834 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
|
835 |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
836 /* 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
|
837 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
|
838 Qnil, Qt, Qnil); |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
839 } |
40042
c9ad5da1f79d
(Fline_beginning_position, Fline_end_position): Clarify documentation.
Miles Bader <miles@gnu.org>
parents:
39988
diff
changeset
|
840 |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
841 |
305 | 842 Lisp_Object |
843 save_excursion_save () | |
844 { | |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
845 int visible = (XBUFFER (XWINDOW (selected_window)->buffer) |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
846 == current_buffer); |
305 | 847 |
848 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
|
849 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
|
850 Fcons (visible ? Qt : Qnil, |
32420
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
851 Fcons (current_buffer->mark_active, |
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
852 selected_window)))); |
305 | 853 } |
854 | |
855 Lisp_Object | |
856 save_excursion_restore (info) | |
15075
e8613675066c
(save_excursion_restore): Add gcpros.
Richard M. Stallman <rms@gnu.org>
parents:
15015
diff
changeset
|
857 Lisp_Object info; |
305 | 858 { |
15075
e8613675066c
(save_excursion_restore): Add gcpros.
Richard M. Stallman <rms@gnu.org>
parents:
15015
diff
changeset
|
859 Lisp_Object tem, tem1, omark, nmark; |
e8613675066c
(save_excursion_restore): Add gcpros.
Richard M. Stallman <rms@gnu.org>
parents:
15015
diff
changeset
|
860 struct gcpro gcpro1, gcpro2, gcpro3; |
32420
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
861 int visible_p; |
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
862 |
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
863 tem = Fmarker_buffer (XCAR (info)); |
305 | 864 /* If buffer being returned to is now deleted, avoid error */ |
865 /* Otherwise could get error here while unwinding to top level | |
866 and crash */ | |
867 /* In that case, Fmarker_buffer returns nil now. */ | |
488 | 868 if (NILP (tem)) |
305 | 869 return Qnil; |
15075
e8613675066c
(save_excursion_restore): Add gcpros.
Richard M. Stallman <rms@gnu.org>
parents:
15015
diff
changeset
|
870 |
e8613675066c
(save_excursion_restore): Add gcpros.
Richard M. Stallman <rms@gnu.org>
parents:
15015
diff
changeset
|
871 omark = nmark = Qnil; |
e8613675066c
(save_excursion_restore): Add gcpros.
Richard M. Stallman <rms@gnu.org>
parents:
15015
diff
changeset
|
872 GCPRO3 (info, omark, nmark); |
e8613675066c
(save_excursion_restore): Add gcpros.
Richard M. Stallman <rms@gnu.org>
parents:
15015
diff
changeset
|
873 |
305 | 874 Fset_buffer (tem); |
32420
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
875 |
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
876 /* Point marker. */ |
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
877 tem = XCAR (info); |
305 | 878 Fgoto_char (tem); |
51670
beceb827c1ce
(save_excursion_restore, transpose_markers): Update for new types.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
51042
diff
changeset
|
879 unchain_marker (XMARKER (tem)); |
32420
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
880 |
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
881 /* Mark marker. */ |
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
882 info = XCDR (info); |
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
883 tem = XCAR (info); |
7485
a1b7f72e0ea2
(save_excursion_restore): Don't run activate-mark-hook
Richard M. Stallman <rms@gnu.org>
parents:
7307
diff
changeset
|
884 omark = Fmarker_position (current_buffer->mark); |
305 | 885 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
|
886 nmark = Fmarker_position (tem); |
51670
beceb827c1ce
(save_excursion_restore, transpose_markers): Update for new types.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
51042
diff
changeset
|
887 unchain_marker (XMARKER (tem)); |
32420
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
888 |
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
889 /* visible */ |
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
890 info = XCDR (info); |
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
891 visible_p = !NILP (XCAR (info)); |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49472
diff
changeset
|
892 |
4420
8113d9ba472e
(save_excursion_restore): Never make the buffer visible.
Richard M. Stallman <rms@gnu.org>
parents:
4358
diff
changeset
|
893 #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
|
894 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
|
895 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
|
896 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
|
897 tem1 = Fcar (tem); |
a358c97a23e4
(save_excursion_save): Save mark_active of buffer.
Richard M. Stallman <rms@gnu.org>
parents:
1916
diff
changeset
|
898 if (!NILP (tem1) |
1254
c7e7e3438711
* editfns.c (save_excursion_save, save_excursion_restore):
Jim Blandy <jimb@redhat.com>
parents:
1117
diff
changeset
|
899 && current_buffer != XBUFFER (XWINDOW (selected_window)->buffer)) |
305 | 900 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
|
901 #endif /* 0 */ |
2049
a358c97a23e4
(save_excursion_save): Save mark_active of buffer.
Richard M. Stallman <rms@gnu.org>
parents:
1916
diff
changeset
|
902 |
32420
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
903 /* Mark active */ |
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
904 info = XCDR (info); |
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
905 tem = XCAR (info); |
2049
a358c97a23e4
(save_excursion_save): Save mark_active of buffer.
Richard M. Stallman <rms@gnu.org>
parents:
1916
diff
changeset
|
906 tem1 = current_buffer->mark_active; |
32420
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
907 current_buffer->mark_active = tem; |
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
908 |
6206
67c608b0e2f7
(save_excursion_restore): Don't call Vrun_hooks if nil.
Richard M. Stallman <rms@gnu.org>
parents:
5915
diff
changeset
|
909 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
|
910 { |
7485
a1b7f72e0ea2
(save_excursion_restore): Don't run activate-mark-hook
Richard M. Stallman <rms@gnu.org>
parents:
7307
diff
changeset
|
911 /* 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
|
912 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
|
913 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
|
914 { |
a1b7f72e0ea2
(save_excursion_restore): Don't run activate-mark-hook
Richard M. Stallman <rms@gnu.org>
parents:
7307
diff
changeset
|
915 if (! EQ (omark, nmark)) |
a1b7f72e0ea2
(save_excursion_restore): Don't run activate-mark-hook
Richard M. Stallman <rms@gnu.org>
parents:
7307
diff
changeset
|
916 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
|
917 } |
a1b7f72e0ea2
(save_excursion_restore): Don't run activate-mark-hook
Richard M. Stallman <rms@gnu.org>
parents:
7307
diff
changeset
|
918 /* 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
|
919 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
|
920 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
|
921 } |
32420
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
922 |
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
923 /* If buffer was visible in a window, and a different window was |
34165
3b3a64fbcb05
(save_excursion_restore): Don't move point
Gerd Moellmann <gerd@gnu.org>
parents:
32857
diff
changeset
|
924 selected, and the old selected window is still showing this |
3b3a64fbcb05
(save_excursion_restore): Don't move point
Gerd Moellmann <gerd@gnu.org>
parents:
32857
diff
changeset
|
925 buffer, restore point in that window. */ |
32420
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
926 tem = XCDR (info); |
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
927 if (visible_p |
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
928 && !EQ (tem, selected_window) |
37492
b9cea35cf91f
(save_excursion_restore): Don't use XBUFFER on
Gerd Moellmann <gerd@gnu.org>
parents:
37217
diff
changeset
|
929 && (tem1 = XWINDOW (tem)->buffer, |
b9cea35cf91f
(save_excursion_restore): Don't use XBUFFER on
Gerd Moellmann <gerd@gnu.org>
parents:
37217
diff
changeset
|
930 (/* Window is live... */ |
b9cea35cf91f
(save_excursion_restore): Don't use XBUFFER on
Gerd Moellmann <gerd@gnu.org>
parents:
37217
diff
changeset
|
931 BUFFERP (tem1) |
b9cea35cf91f
(save_excursion_restore): Don't use XBUFFER on
Gerd Moellmann <gerd@gnu.org>
parents:
37217
diff
changeset
|
932 /* ...and it shows the current buffer. */ |
b9cea35cf91f
(save_excursion_restore): Don't use XBUFFER on
Gerd Moellmann <gerd@gnu.org>
parents:
37217
diff
changeset
|
933 && XBUFFER (tem1) == current_buffer))) |
32420
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
934 Fset_window_point (tem, make_number (PT)); |
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
935 |
15075
e8613675066c
(save_excursion_restore): Add gcpros.
Richard M. Stallman <rms@gnu.org>
parents:
15015
diff
changeset
|
936 UNGCPRO; |
305 | 937 return Qnil; |
938 } | |
939 | |
940 DEFUN ("save-excursion", Fsave_excursion, Ssave_excursion, 0, UNEVALLED, 0, | |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
941 doc: /* Save point, mark, and current buffer; execute BODY; restore those things. |
39966
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
942 Executes BODY just like `progn'. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
943 The values of point, mark and the current buffer are restored |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
944 even in case of abnormal exit (throw or error). |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
945 The state of activation of the mark is also restored. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
946 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
947 This construct does not save `deactivate-mark', and therefore |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
948 functions that change the buffer will still cause deactivation |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
949 of the mark at the end of the command. To prevent that, bind |
40140
9bf80d5fff41
(Fsave_excursion, Fsave_current_buffer)
Miles Bader <miles@gnu.org>
parents:
40131
diff
changeset
|
950 `deactivate-mark' with `let'. |
9bf80d5fff41
(Fsave_excursion, Fsave_current_buffer)
Miles Bader <miles@gnu.org>
parents:
40131
diff
changeset
|
951 |
9bf80d5fff41
(Fsave_excursion, Fsave_current_buffer)
Miles Bader <miles@gnu.org>
parents:
40131
diff
changeset
|
952 usage: (save-excursion &rest BODY) */) |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
953 (args) |
305 | 954 Lisp_Object args; |
955 { | |
956 register Lisp_Object val; | |
46293
1fb8f75062c6
Use macro SPECPDL_INDEX.
Juanma Barranquero <lekktu@gmail.com>
parents:
45398
diff
changeset
|
957 int count = SPECPDL_INDEX (); |
305 | 958 |
959 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
|
960 |
17304eb73f97
(Fsave_current_buffer): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16269
diff
changeset
|
961 val = Fprogn (args); |
17304eb73f97
(Fsave_current_buffer): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16269
diff
changeset
|
962 return unbind_to (count, val); |
17304eb73f97
(Fsave_current_buffer): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16269
diff
changeset
|
963 } |
17304eb73f97
(Fsave_current_buffer): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16269
diff
changeset
|
964 |
17304eb73f97
(Fsave_current_buffer): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16269
diff
changeset
|
965 DEFUN ("save-current-buffer", Fsave_current_buffer, Ssave_current_buffer, 0, UNEVALLED, 0, |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
966 doc: /* Save the current buffer; execute BODY; restore the current buffer. |
40140
9bf80d5fff41
(Fsave_excursion, Fsave_current_buffer)
Miles Bader <miles@gnu.org>
parents:
40131
diff
changeset
|
967 Executes BODY just like `progn'. |
9bf80d5fff41
(Fsave_excursion, Fsave_current_buffer)
Miles Bader <miles@gnu.org>
parents:
40131
diff
changeset
|
968 usage: (save-current-buffer &rest BODY) */) |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
969 (args) |
16298
17304eb73f97
(Fsave_current_buffer): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16269
diff
changeset
|
970 Lisp_Object args; |
17304eb73f97
(Fsave_current_buffer): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16269
diff
changeset
|
971 { |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
972 Lisp_Object val; |
46293
1fb8f75062c6
Use macro SPECPDL_INDEX.
Juanma Barranquero <lekktu@gmail.com>
parents:
45398
diff
changeset
|
973 int count = SPECPDL_INDEX (); |
16298
17304eb73f97
(Fsave_current_buffer): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16269
diff
changeset
|
974 |
20696
cdbe4824e7f1
(Fsave_current_buffer): Use set_buffer_if_live.
Richard M. Stallman <rms@gnu.org>
parents:
20688
diff
changeset
|
975 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
|
976 |
305 | 977 val = Fprogn (args); |
978 return unbind_to (count, val); | |
979 } | |
980 | |
25608
1cdab17df2b3
(Fbufsize): Accept an extra BUFFER parameter.
Richard M. Stallman <rms@gnu.org>
parents:
25507
diff
changeset
|
981 DEFUN ("buffer-size", Fbufsize, Sbufsize, 0, 1, 0, |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
982 doc: /* Return the number of characters in the current buffer. |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
983 If BUFFER, return the number of characters in that buffer instead. */) |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
984 (buffer) |
25608
1cdab17df2b3
(Fbufsize): Accept an extra BUFFER parameter.
Richard M. Stallman <rms@gnu.org>
parents:
25507
diff
changeset
|
985 Lisp_Object buffer; |
305 | 986 { |
25608
1cdab17df2b3
(Fbufsize): Accept an extra BUFFER parameter.
Richard M. Stallman <rms@gnu.org>
parents:
25507
diff
changeset
|
987 if (NILP (buffer)) |
1cdab17df2b3
(Fbufsize): Accept an extra BUFFER parameter.
Richard M. Stallman <rms@gnu.org>
parents:
25507
diff
changeset
|
988 return make_number (Z - BEG); |
25609
157f0e91232e
Clear up previous change.
Richard M. Stallman <rms@gnu.org>
parents:
25608
diff
changeset
|
989 else |
157f0e91232e
Clear up previous change.
Richard M. Stallman <rms@gnu.org>
parents:
25608
diff
changeset
|
990 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
991 CHECK_BUFFER (buffer); |
25609
157f0e91232e
Clear up previous change.
Richard M. Stallman <rms@gnu.org>
parents:
25608
diff
changeset
|
992 return make_number (BUF_Z (XBUFFER (buffer)) |
157f0e91232e
Clear up previous change.
Richard M. Stallman <rms@gnu.org>
parents:
25608
diff
changeset
|
993 - BUF_BEG (XBUFFER (buffer))); |
157f0e91232e
Clear up previous change.
Richard M. Stallman <rms@gnu.org>
parents:
25608
diff
changeset
|
994 } |
305 | 995 } |
996 | |
997 DEFUN ("point-min", Fpoint_min, Spoint_min, 0, 0, 0, | |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
998 doc: /* Return the minimum permissible value of point in the current buffer. |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
999 This is 1, unless narrowing (a buffer restriction) is in effect. */) |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1000 () |
305 | 1001 { |
1002 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
|
1003 XSETFASTINT (temp, BEGV); |
305 | 1004 return temp; |
1005 } | |
1006 | |
1007 DEFUN ("point-min-marker", Fpoint_min_marker, Spoint_min_marker, 0, 0, 0, | |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1008 doc: /* Return a marker to the minimum permissible value of point in this buffer. |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1009 This is the beginning, unless narrowing (a buffer restriction) is in effect. */) |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1010 () |
305 | 1011 { |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
1012 return buildmark (BEGV, BEGV_BYTE); |
305 | 1013 } |
1014 | |
1015 DEFUN ("point-max", Fpoint_max, Spoint_max, 0, 0, 0, | |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1016 doc: /* Return the maximum permissible value of point in the current buffer. |
39966
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1017 This is (1+ (buffer-size)), unless narrowing (a buffer restriction) |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1018 is in effect, in which case it is less. */) |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1019 () |
305 | 1020 { |
1021 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
|
1022 XSETFASTINT (temp, ZV); |
305 | 1023 return temp; |
1024 } | |
1025 | |
1026 DEFUN ("point-max-marker", Fpoint_max_marker, Spoint_max_marker, 0, 0, 0, | |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1027 doc: /* Return a marker to the maximum permissible value of point in this buffer. |
39966
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1028 This is (1+ (buffer-size)), unless narrowing (a buffer restriction) |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1029 is in effect, in which case it is less. */) |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1030 () |
305 | 1031 { |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
1032 return buildmark (ZV, ZV_BYTE); |
305 | 1033 } |
1034 | |
21821
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
1035 DEFUN ("gap-position", Fgap_position, Sgap_position, 0, 0, 0, |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1036 doc: /* Return the position of the gap, in the current buffer. |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1037 See also `gap-size'. */) |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1038 () |
21821
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
1039 { |
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
1040 Lisp_Object temp; |
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
1041 XSETFASTINT (temp, GPT); |
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
1042 return temp; |
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
1043 } |
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
1044 |
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
1045 DEFUN ("gap-size", Fgap_size, Sgap_size, 0, 0, 0, |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1046 doc: /* Return the size of the current buffer's gap. |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1047 See also `gap-position'. */) |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1048 () |
21821
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
1049 { |
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
1050 Lisp_Object temp; |
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
1051 XSETFASTINT (temp, GAP_SIZE); |
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
1052 return temp; |
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
1053 } |
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
1054 |
20861
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
1055 DEFUN ("position-bytes", Fposition_bytes, Sposition_bytes, 1, 1, 0, |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1056 doc: /* Return the byte position for character position POSITION. |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1057 If POSITION is out of range, the value is nil. */) |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1058 (position) |
20879
64d2baa47498
(Fposition_bytes): Declare arg POSITION as Lips_Object.
Kenichi Handa <handa@m17n.org>
parents:
20878
diff
changeset
|
1059 Lisp_Object position; |
20861
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
1060 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
1061 CHECK_NUMBER_COERCE_MARKER (position); |
23132
1c8e0e09aea1
(Fposition_bytes): If the arg POSITION is out of
Kenichi Handa <handa@m17n.org>
parents:
23063
diff
changeset
|
1062 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
|
1063 return Qnil; |
20878
34e0c8eb49eb
(Fposition_bytes): Allow marker as arg POSITION. Use
Kenichi Handa <handa@m17n.org>
parents:
20861
diff
changeset
|
1064 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
|
1065 } |
22645
e5b201634497
(Fbyte_to_position): New function.
Richard M. Stallman <rms@gnu.org>
parents:
22199
diff
changeset
|
1066 |
e5b201634497
(Fbyte_to_position): New function.
Richard M. Stallman <rms@gnu.org>
parents:
22199
diff
changeset
|
1067 DEFUN ("byte-to-position", Fbyte_to_position, Sbyte_to_position, 1, 1, 0, |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1068 doc: /* Return the character position for byte position BYTEPOS. |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1069 If BYTEPOS is out of range, the value is nil. */) |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1070 (bytepos) |
22645
e5b201634497
(Fbyte_to_position): New function.
Richard M. Stallman <rms@gnu.org>
parents:
22199
diff
changeset
|
1071 Lisp_Object bytepos; |
e5b201634497
(Fbyte_to_position): New function.
Richard M. Stallman <rms@gnu.org>
parents:
22199
diff
changeset
|
1072 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
1073 CHECK_NUMBER (bytepos); |
23132
1c8e0e09aea1
(Fposition_bytes): If the arg POSITION is out of
Kenichi Handa <handa@m17n.org>
parents:
23063
diff
changeset
|
1074 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
|
1075 return Qnil; |
22645
e5b201634497
(Fbyte_to_position): New function.
Richard M. Stallman <rms@gnu.org>
parents:
22199
diff
changeset
|
1076 return make_number (BYTE_TO_CHAR (XINT (bytepos))); |
e5b201634497
(Fbyte_to_position): New function.
Richard M. Stallman <rms@gnu.org>
parents:
22199
diff
changeset
|
1077 } |
20861
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
1078 |
512 | 1079 DEFUN ("following-char", Ffollowing_char, Sfollowing_char, 0, 0, 0, |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1080 doc: /* Return the character following point, as a number. |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1081 At the end of the buffer or accessible region, return 0. */) |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1082 () |
305 | 1083 { |
1084 Lisp_Object temp; | |
16039
855c8d8ba0f0
Change all references from point to PT.
Karl Heuer <kwzh@gnu.org>
parents:
15910
diff
changeset
|
1085 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
|
1086 XSETFASTINT (temp, 0); |
512 | 1087 else |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
1088 XSETFASTINT (temp, FETCH_CHAR (PT_BYTE)); |
305 | 1089 return temp; |
1090 } | |
1091 | |
512 | 1092 DEFUN ("preceding-char", Fprevious_char, Sprevious_char, 0, 0, 0, |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1093 doc: /* Return the character preceding point, as a number. |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1094 At the beginning of the buffer or accessible region, return 0. */) |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1095 () |
305 | 1096 { |
1097 Lisp_Object temp; | |
16039
855c8d8ba0f0
Change all references from point to PT.
Karl Heuer <kwzh@gnu.org>
parents:
15910
diff
changeset
|
1098 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
|
1099 XSETFASTINT (temp, 0); |
17031 | 1100 else if (!NILP (current_buffer->enable_multibyte_characters)) |
1101 { | |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
1102 int pos = PT_BYTE; |
17031 | 1103 DEC_POS (pos); |
1104 XSETFASTINT (temp, FETCH_CHAR (pos)); | |
1105 } | |
305 | 1106 else |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
1107 XSETFASTINT (temp, FETCH_BYTE (PT_BYTE - 1)); |
305 | 1108 return temp; |
1109 } | |
1110 | |
1111 DEFUN ("bobp", Fbobp, Sbobp, 0, 0, 0, | |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1112 doc: /* Return t if point is at the beginning of the buffer. |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1113 If the buffer is narrowed, this means the beginning of the narrowed part. */) |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1114 () |
305 | 1115 { |
16039
855c8d8ba0f0
Change all references from point to PT.
Karl Heuer <kwzh@gnu.org>
parents:
15910
diff
changeset
|
1116 if (PT == BEGV) |
305 | 1117 return Qt; |
1118 return Qnil; | |
1119 } | |
1120 | |
1121 DEFUN ("eobp", Feobp, Seobp, 0, 0, 0, | |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1122 doc: /* Return t if point is at the end of the buffer. |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1123 If the buffer is narrowed, this means the end of the narrowed part. */) |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1124 () |
305 | 1125 { |
16039
855c8d8ba0f0
Change all references from point to PT.
Karl Heuer <kwzh@gnu.org>
parents:
15910
diff
changeset
|
1126 if (PT == ZV) |
305 | 1127 return Qt; |
1128 return Qnil; | |
1129 } | |
1130 | |
1131 DEFUN ("bolp", Fbolp, Sbolp, 0, 0, 0, | |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1132 doc: /* Return t if point is at the beginning of a line. */) |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1133 () |
305 | 1134 { |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
1135 if (PT == BEGV || FETCH_BYTE (PT_BYTE - 1) == '\n') |
305 | 1136 return Qt; |
1137 return Qnil; | |
1138 } | |
1139 | |
1140 DEFUN ("eolp", Feolp, Seolp, 0, 0, 0, | |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1141 doc: /* Return t if point is at the end of a line. |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1142 `End of a line' includes point being at the end of the buffer. */) |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1143 () |
305 | 1144 { |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
1145 if (PT == ZV || FETCH_BYTE (PT_BYTE) == '\n') |
305 | 1146 return Qt; |
1147 return Qnil; | |
1148 } | |
1149 | |
18252
9c4fb902b6eb
(Fchar_after, Fchar_before): Make arg optional.
Richard M. Stallman <rms@gnu.org>
parents:
18240
diff
changeset
|
1150 DEFUN ("char-after", Fchar_after, Schar_after, 0, 1, 0, |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1151 doc: /* Return character in current buffer at position POS. |
53819
a3fe35a8b56b
(Fchar_after, Fchar_before): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents:
53687
diff
changeset
|
1152 POS is an integer or a marker and defaults to point. |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1153 If POS is out of range, the value is nil. */) |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1154 (pos) |
305 | 1155 Lisp_Object pos; |
1156 { | |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
1157 register int pos_byte; |
305 | 1158 |
18252
9c4fb902b6eb
(Fchar_after, Fchar_before): Make arg optional.
Richard M. Stallman <rms@gnu.org>
parents:
18240
diff
changeset
|
1159 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
|
1160 { |
edca9002c740
(Fchar_after): Make nil fully equivalent to (point) as arg.
Richard M. Stallman <rms@gnu.org>
parents:
21914
diff
changeset
|
1161 pos_byte = PT_BYTE; |
23577
36cccf1ba0a9
(Fchar_after): Fix type clashes.
Andreas Schwab <schwab@suse.de>
parents:
23565
diff
changeset
|
1162 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
|
1163 } |
edca9002c740
(Fchar_after): Make nil fully equivalent to (point) as arg.
Richard M. Stallman <rms@gnu.org>
parents:
21914
diff
changeset
|
1164 |
edca9002c740
(Fchar_after): Make nil fully equivalent to (point) as arg.
Richard M. Stallman <rms@gnu.org>
parents:
21914
diff
changeset
|
1165 if (MARKERP (pos)) |
21200
ea520c42a342
(Fchar_after, Fchar_before): Properly check arg type
Richard M. Stallman <rms@gnu.org>
parents:
21064
diff
changeset
|
1166 { |
ea520c42a342
(Fchar_after, Fchar_before): Properly check arg type
Richard M. Stallman <rms@gnu.org>
parents:
21064
diff
changeset
|
1167 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
|
1168 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
|
1169 return Qnil; |
ea520c42a342
(Fchar_after, Fchar_before): Properly check arg type
Richard M. Stallman <rms@gnu.org>
parents:
21064
diff
changeset
|
1170 } |
18252
9c4fb902b6eb
(Fchar_after, Fchar_before): Make arg optional.
Richard M. Stallman <rms@gnu.org>
parents:
18240
diff
changeset
|
1171 else |
9c4fb902b6eb
(Fchar_after, Fchar_before): Make arg optional.
Richard M. Stallman <rms@gnu.org>
parents:
18240
diff
changeset
|
1172 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
1173 CHECK_NUMBER_COERCE_MARKER (pos); |
21521
354a7085f1d7
(Fchar_after, Fchar_before): Fix mixing of Lisp_Object
Andreas Schwab <schwab@suse.de>
parents:
21514
diff
changeset
|
1174 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
|
1175 return Qnil; |
30480 | 1176 |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
1177 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
|
1178 } |
305 | 1179 |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
1180 return make_number (FETCH_CHAR (pos_byte)); |
305 | 1181 } |
17031 | 1182 |
18252
9c4fb902b6eb
(Fchar_after, Fchar_before): Make arg optional.
Richard M. Stallman <rms@gnu.org>
parents:
18240
diff
changeset
|
1183 DEFUN ("char-before", Fchar_before, Schar_before, 0, 1, 0, |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1184 doc: /* Return character in current buffer preceding position POS. |
53819
a3fe35a8b56b
(Fchar_after, Fchar_before): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents:
53687
diff
changeset
|
1185 POS is an integer or a marker and defaults to point. |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1186 If POS is out of range, the value is nil. */) |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1187 (pos) |
17031 | 1188 Lisp_Object pos; |
1189 { | |
1190 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
|
1191 register int pos_byte; |
17031 | 1192 |
18252
9c4fb902b6eb
(Fchar_after, Fchar_before): Make arg optional.
Richard M. Stallman <rms@gnu.org>
parents:
18240
diff
changeset
|
1193 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
|
1194 { |
edca9002c740
(Fchar_after): Make nil fully equivalent to (point) as arg.
Richard M. Stallman <rms@gnu.org>
parents:
21914
diff
changeset
|
1195 pos_byte = PT_BYTE; |
23577
36cccf1ba0a9
(Fchar_after): Fix type clashes.
Andreas Schwab <schwab@suse.de>
parents:
23565
diff
changeset
|
1196 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
|
1197 } |
edca9002c740
(Fchar_after): Make nil fully equivalent to (point) as arg.
Richard M. Stallman <rms@gnu.org>
parents:
21914
diff
changeset
|
1198 |
edca9002c740
(Fchar_after): Make nil fully equivalent to (point) as arg.
Richard M. Stallman <rms@gnu.org>
parents:
21914
diff
changeset
|
1199 if (MARKERP (pos)) |
21200
ea520c42a342
(Fchar_after, Fchar_before): Properly check arg type
Richard M. Stallman <rms@gnu.org>
parents:
21064
diff
changeset
|
1200 { |
ea520c42a342
(Fchar_after, Fchar_before): Properly check arg type
Richard M. Stallman <rms@gnu.org>
parents:
21064
diff
changeset
|
1201 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
|
1202 |
ea520c42a342
(Fchar_after, Fchar_before): Properly check arg type
Richard M. Stallman <rms@gnu.org>
parents:
21064
diff
changeset
|
1203 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
|
1204 return Qnil; |
ea520c42a342
(Fchar_after, Fchar_before): Properly check arg type
Richard M. Stallman <rms@gnu.org>
parents:
21064
diff
changeset
|
1205 } |
18252
9c4fb902b6eb
(Fchar_after, Fchar_before): Make arg optional.
Richard M. Stallman <rms@gnu.org>
parents:
18240
diff
changeset
|
1206 else |
9c4fb902b6eb
(Fchar_after, Fchar_before): Make arg optional.
Richard M. Stallman <rms@gnu.org>
parents:
18240
diff
changeset
|
1207 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
1208 CHECK_NUMBER_COERCE_MARKER (pos); |
17031 | 1209 |
21521
354a7085f1d7
(Fchar_after, Fchar_before): Fix mixing of Lisp_Object
Andreas Schwab <schwab@suse.de>
parents:
21514
diff
changeset
|
1210 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
|
1211 return Qnil; |
ea520c42a342
(Fchar_after, Fchar_before): Properly check arg type
Richard M. Stallman <rms@gnu.org>
parents:
21064
diff
changeset
|
1212 |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
1213 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
|
1214 } |
17031 | 1215 |
1216 if (!NILP (current_buffer->enable_multibyte_characters)) | |
1217 { | |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
1218 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
|
1219 XSETFASTINT (val, FETCH_CHAR (pos_byte)); |
17031 | 1220 } |
1221 else | |
1222 { | |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
1223 pos_byte--; |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
1224 XSETFASTINT (val, FETCH_BYTE (pos_byte)); |
17031 | 1225 } |
1226 return val; | |
1227 } | |
305 | 1228 |
9572 | 1229 DEFUN ("user-login-name", Fuser_login_name, Suser_login_name, 0, 1, 0, |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1230 doc: /* Return the name under which the user logged in, as a string. |
39966
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1231 This is based on the effective uid, not the real uid. |
55972
db2480202623
(Fuser_login_name, Ffloat_time, Fencode_time, Fcurrent_time_string)
Juanma Barranquero <lekktu@gmail.com>
parents:
55424
diff
changeset
|
1232 Also, if the environment variables LOGNAME or USER are set, |
39966
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1233 that determines the value of this function. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1234 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1235 If optional argument UID is an integer, return the login name of the user |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1236 with that uid, or nil if there is no such user. */) |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1237 (uid) |
9572 | 1238 Lisp_Object uid; |
305 | 1239 { |
9572 | 1240 struct passwd *pw; |
1241 | |
9520
5187a4159d16
(Fuser_login_name, Fuser_real_login_name):
Richard M. Stallman <rms@gnu.org>
parents:
9305
diff
changeset
|
1242 /* 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
|
1243 (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
|
1244 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
|
1245 if (INTEGERP (Vuser_login_name)) |
9520
5187a4159d16
(Fuser_login_name, Fuser_real_login_name):
Richard M. Stallman <rms@gnu.org>
parents:
9305
diff
changeset
|
1246 init_editfns (); |
9572 | 1247 |
1248 if (NILP (uid)) | |
12026
505a894d943e
(syms_of_editfns): user-login-name renamed from user-name.
Karl Heuer <kwzh@gnu.org>
parents:
11912
diff
changeset
|
1249 return Vuser_login_name; |
9572 | 1250 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
1251 CHECK_NUMBER (uid); |
9572 | 1252 pw = (struct passwd *) getpwuid (XINT (uid)); |
1253 return (pw ? build_string (pw->pw_name) : Qnil); | |
305 | 1254 } |
1255 | |
1256 DEFUN ("user-real-login-name", Fuser_real_login_name, Suser_real_login_name, | |
40981
fee88c193206
(Fuser_real_login_name): Reindent.
Pavel Janík <Pavel@Janik.cz>
parents:
40699
diff
changeset
|
1257 0, 0, 0, |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1258 doc: /* Return the name of the user's real uid, as a string. |
39966
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1259 This ignores the environment variables LOGNAME and USER, so it differs from |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1260 `user-login-name' when running under `su'. */) |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1261 () |
305 | 1262 { |
9520
5187a4159d16
(Fuser_login_name, Fuser_real_login_name):
Richard M. Stallman <rms@gnu.org>
parents:
9305
diff
changeset
|
1263 /* 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
|
1264 (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
|
1265 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
|
1266 if (INTEGERP (Vuser_login_name)) |
9520
5187a4159d16
(Fuser_login_name, Fuser_real_login_name):
Richard M. Stallman <rms@gnu.org>
parents:
9305
diff
changeset
|
1267 init_editfns (); |
12026
505a894d943e
(syms_of_editfns): user-login-name renamed from user-name.
Karl Heuer <kwzh@gnu.org>
parents:
11912
diff
changeset
|
1268 return Vuser_real_login_name; |
305 | 1269 } |
1270 | |
1271 DEFUN ("user-uid", Fuser_uid, Suser_uid, 0, 0, 0, | |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1272 doc: /* Return the effective uid of Emacs. |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1273 Value is an integer or float, depending on the value. */) |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1274 () |
305 | 1275 { |
39774
b34a792f4234
(Fuser_uid, Fuser_real_uid): Use make_fixnum_or_float.
Gerd Moellmann <gerd@gnu.org>
parents:
39720
diff
changeset
|
1276 return make_fixnum_or_float (geteuid ()); |
305 | 1277 } |
1278 | |
1279 DEFUN ("user-real-uid", Fuser_real_uid, Suser_real_uid, 0, 0, 0, | |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1280 doc: /* Return the real uid of Emacs. |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1281 Value is an integer or float, depending on the value. */) |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1282 () |
305 | 1283 { |
39774
b34a792f4234
(Fuser_uid, Fuser_real_uid): Use make_fixnum_or_float.
Gerd Moellmann <gerd@gnu.org>
parents:
39720
diff
changeset
|
1284 return make_fixnum_or_float (getuid ()); |
305 | 1285 } |
1286 | |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
1287 DEFUN ("user-full-name", Fuser_full_name, Suser_full_name, 0, 1, 0, |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1288 doc: /* Return the full name of the user logged in, as a string. |
39966
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1289 If the full name corresponding to Emacs's userid is not known, |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1290 return "unknown". |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1291 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1292 If optional argument UID is an integer or float, return the full name |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1293 of the user with that uid, or nil if there is no such user. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1294 If UID is a string, return the full name of the user with that login |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1295 name, or nil if there is no such user. */) |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1296 (uid) |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
1297 Lisp_Object uid; |
305 | 1298 { |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
1299 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
|
1300 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
|
1301 Lisp_Object full; |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
1302 |
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
1303 if (NILP (uid)) |
30480 | 1304 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
|
1305 else if (NUMBERP (uid)) |
39774
b34a792f4234
(Fuser_uid, Fuser_real_uid): Use make_fixnum_or_float.
Gerd Moellmann <gerd@gnu.org>
parents:
39720
diff
changeset
|
1306 pw = (struct passwd *) getpwuid ((uid_t) XFLOATINT (uid)); |
30480 | 1307 else if (STRINGP (uid)) |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1308 pw = (struct passwd *) getpwnam (SDATA (uid)); |
16641
2103a88cc61f
(Fuser_full_name): Accept a string (the login name) as
Richard M. Stallman <rms@gnu.org>
parents:
16639
diff
changeset
|
1309 else |
2103a88cc61f
(Fuser_full_name): Accept a string (the login name) as
Richard M. Stallman <rms@gnu.org>
parents:
16639
diff
changeset
|
1310 error ("Invalid UID specification"); |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
1311 |
16641
2103a88cc61f
(Fuser_full_name): Accept a string (the login name) as
Richard M. Stallman <rms@gnu.org>
parents:
16639
diff
changeset
|
1312 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
|
1313 return Qnil; |
30480 | 1314 |
16641
2103a88cc61f
(Fuser_full_name): Accept a string (the login name) as
Richard M. Stallman <rms@gnu.org>
parents:
16639
diff
changeset
|
1315 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
|
1316 /* 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
|
1317 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
|
1318 full = make_string (p, q ? q - p : strlen (p)); |
30480 | 1319 |
16641
2103a88cc61f
(Fuser_full_name): Accept a string (the login name) as
Richard M. Stallman <rms@gnu.org>
parents:
16639
diff
changeset
|
1320 #ifdef AMPERSAND_FULL_NAME |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1321 p = SDATA (full); |
16641
2103a88cc61f
(Fuser_full_name): Accept a string (the login name) as
Richard M. Stallman <rms@gnu.org>
parents:
16639
diff
changeset
|
1322 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
|
1323 /* 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
|
1324 if (q) |
2103a88cc61f
(Fuser_full_name): Accept a string (the login name) as
Richard M. Stallman <rms@gnu.org>
parents:
16639
diff
changeset
|
1325 { |
18661
537522d5e6d8
(Fuser_full_name): Declare p, q and r as unsigned char *.
Richard M. Stallman <rms@gnu.org>
parents:
18613
diff
changeset
|
1326 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
|
1327 Lisp_Object login; |
2103a88cc61f
(Fuser_full_name): Accept a string (the login name) as
Richard M. Stallman <rms@gnu.org>
parents:
16639
diff
changeset
|
1328 |
2103a88cc61f
(Fuser_full_name): Accept a string (the login name) as
Richard M. Stallman <rms@gnu.org>
parents:
16639
diff
changeset
|
1329 login = Fuser_login_name (make_number (pw->pw_uid)); |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1330 r = (unsigned char *) alloca (strlen (p) + SCHARS (login) + 1); |
16641
2103a88cc61f
(Fuser_full_name): Accept a string (the login name) as
Richard M. Stallman <rms@gnu.org>
parents:
16639
diff
changeset
|
1331 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
|
1332 r[q - p] = 0; |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1333 strcat (r, SDATA (login)); |
16641
2103a88cc61f
(Fuser_full_name): Accept a string (the login name) as
Richard M. Stallman <rms@gnu.org>
parents:
16639
diff
changeset
|
1334 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
|
1335 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
|
1336 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
|
1337 } |
2103a88cc61f
(Fuser_full_name): Accept a string (the login name) as
Richard M. Stallman <rms@gnu.org>
parents:
16639
diff
changeset
|
1338 #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
|
1339 |
2103a88cc61f
(Fuser_full_name): Accept a string (the login name) as
Richard M. Stallman <rms@gnu.org>
parents:
16639
diff
changeset
|
1340 return full; |
305 | 1341 } |
1342 | |
1343 DEFUN ("system-name", Fsystem_name, Ssystem_name, 0, 0, 0, | |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1344 doc: /* Return the name of the machine you are running on, as a string. */) |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1345 () |
305 | 1346 { |
1347 return Vsystem_name; | |
1348 } | |
1349 | |
7907
148ad20d6774
(init_editfns): Call init_system_name instead of get_system_name.
Karl Heuer <kwzh@gnu.org>
parents:
7862
diff
changeset
|
1350 /* 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
|
1351 |
7907
148ad20d6774
(init_editfns): Call init_system_name instead of get_system_name.
Karl Heuer <kwzh@gnu.org>
parents:
7862
diff
changeset
|
1352 char * |
148ad20d6774
(init_editfns): Call init_system_name instead of get_system_name.
Karl Heuer <kwzh@gnu.org>
parents:
7862
diff
changeset
|
1353 get_system_name () |
148ad20d6774
(init_editfns): Call init_system_name instead of get_system_name.
Karl Heuer <kwzh@gnu.org>
parents:
7862
diff
changeset
|
1354 { |
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
|
1355 if (STRINGP (Vsystem_name)) |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1356 return (char *) SDATA (Vsystem_name); |
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
|
1357 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
|
1358 return ""; |
7907
148ad20d6774
(init_editfns): Call init_system_name instead of get_system_name.
Karl Heuer <kwzh@gnu.org>
parents:
7862
diff
changeset
|
1359 } |
148ad20d6774
(init_editfns): Call init_system_name instead of get_system_name.
Karl Heuer <kwzh@gnu.org>
parents:
7862
diff
changeset
|
1360 |
59658
45074d913d23
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
59644
diff
changeset
|
1361 char * |
45074d913d23
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
59644
diff
changeset
|
1362 get_operating_system_release() |
45074d913d23
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
59644
diff
changeset
|
1363 { |
45074d913d23
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
59644
diff
changeset
|
1364 if (STRINGP (Voperating_system_release)) |
45074d913d23
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
59644
diff
changeset
|
1365 return (char *) SDATA (Voperating_system_release); |
45074d913d23
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
59644
diff
changeset
|
1366 else |
45074d913d23
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
59644
diff
changeset
|
1367 return ""; |
45074d913d23
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
59644
diff
changeset
|
1368 } |
45074d913d23
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
59644
diff
changeset
|
1369 |
5373
a70b89d2d6bb
(Femacs_pid): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5242
diff
changeset
|
1370 DEFUN ("emacs-pid", Femacs_pid, Semacs_pid, 0, 0, 0, |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1371 doc: /* Return the process ID of Emacs, as an integer. */) |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1372 () |
5373
a70b89d2d6bb
(Femacs_pid): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5242
diff
changeset
|
1373 { |
a70b89d2d6bb
(Femacs_pid): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5242
diff
changeset
|
1374 return make_number (getpid ()); |
a70b89d2d6bb
(Femacs_pid): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5242
diff
changeset
|
1375 } |
a70b89d2d6bb
(Femacs_pid): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5242
diff
changeset
|
1376 |
448 | 1377 DEFUN ("current-time", Fcurrent_time, Scurrent_time, 0, 0, 0, |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1378 doc: /* Return the current time, as the number of seconds since 1970-01-01 00:00:00. |
39966
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1379 The time is returned as a list of three integers. The first has the |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1380 most significant 16 bits of the seconds, while the second has the |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1381 least significant 16 bits. The third integer gives the microsecond |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1382 count. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1383 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1384 The microsecond count is zero on systems that do not provide |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1385 resolution finer than a second. */) |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1386 () |
448 | 1387 { |
577 | 1388 EMACS_TIME t; |
1389 Lisp_Object result[3]; | |
1390 | |
1391 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
|
1392 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
|
1393 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
|
1394 XSETINT (result[2], EMACS_USECS (t)); |
577 | 1395 |
1396 return Flist (3, result); | |
448 | 1397 } |
57987
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1398 |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1399 DEFUN ("get-internal-run-time", Fget_internal_run_time, Sget_internal_run_time, |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1400 0, 0, 0, |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1401 doc: /* Return the current run time used by Emacs. |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1402 The time is returned as a list of three integers. The first has the |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1403 most significant 16 bits of the seconds, while the second has the |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1404 least significant 16 bits. The third integer gives the microsecond |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1405 count. |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1406 |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1407 On systems that can't determine the run time, get-internal-run-time |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1408 does the same thing as current-time. The microsecond count is zero on |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1409 systems that do not provide resolution finer than a second. */) |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1410 () |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1411 { |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1412 #ifdef HAVE_GETRUSAGE |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1413 struct rusage usage; |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1414 Lisp_Object result[3]; |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1415 int secs, usecs; |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1416 |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1417 if (getrusage (RUSAGE_SELF, &usage) < 0) |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1418 /* This shouldn't happen. What action is appropriate? */ |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1419 Fsignal (Qerror, Qnil); |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1420 |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1421 /* Sum up user time and system time. */ |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1422 secs = usage.ru_utime.tv_sec + usage.ru_stime.tv_sec; |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1423 usecs = usage.ru_utime.tv_usec + usage.ru_stime.tv_usec; |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1424 if (usecs >= 1000000) |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1425 { |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1426 usecs -= 1000000; |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1427 secs++; |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1428 } |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1429 |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1430 XSETINT (result[0], (secs >> 16) & 0xffff); |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1431 XSETINT (result[1], (secs >> 0) & 0xffff); |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1432 XSETINT (result[2], usecs); |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1433 |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1434 return Flist (3, result); |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1435 #else |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1436 return Fcurrent_time (); |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1437 #endif |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1438 } |
448 | 1439 |
1440 | |
55193
1b09eb24ab02
(lisp_time_argument): Provide externally.
Eli Zaretskii <eliz@gnu.org>
parents:
54846
diff
changeset
|
1441 int |
30480 | 1442 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
|
1443 Lisp_Object specified_time; |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1444 time_t *result; |
30480 | 1445 int *usec; |
2921
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1446 { |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1447 if (NILP (specified_time)) |
30480 | 1448 { |
1449 if (usec) | |
1450 { | |
1451 EMACS_TIME t; | |
1452 | |
30503
fef49230e1aa
(lisp_time_argument): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents:
30480
diff
changeset
|
1453 EMACS_GET_TIME (t); |
30480 | 1454 *usec = EMACS_USECS (t); |
1455 *result = EMACS_SECS (t); | |
1456 return 1; | |
1457 } | |
1458 else | |
1459 return time (result) != -1; | |
1460 } | |
2921
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1461 else |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1462 { |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1463 Lisp_Object high, low; |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1464 high = Fcar (specified_time); |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
1465 CHECK_NUMBER (high); |
2921
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1466 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
|
1467 if (CONSP (low)) |
30480 | 1468 { |
1469 if (usec) | |
1470 { | |
1471 Lisp_Object usec_l = Fcdr (low); | |
1472 if (CONSP (usec_l)) | |
1473 usec_l = Fcar (usec_l); | |
1474 if (NILP (usec_l)) | |
1475 *usec = 0; | |
1476 else | |
1477 { | |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
1478 CHECK_NUMBER (usec_l); |
30480 | 1479 *usec = XINT (usec_l); |
1480 } | |
1481 } | |
1482 low = Fcar (low); | |
1483 } | |
1484 else if (usec) | |
1485 *usec = 0; | |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
1486 CHECK_NUMBER (low); |
2921
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1487 *result = (XINT (high) << 16) + (XINT (low) & 0xffff); |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1488 return *result >> 16 == XINT (high); |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1489 } |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1490 } |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1491 |
30480 | 1492 DEFUN ("float-time", Ffloat_time, Sfloat_time, 0, 1, 0, |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1493 doc: /* Return the current time, as a float number of seconds since the epoch. |
55972
db2480202623
(Fuser_login_name, Ffloat_time, Fencode_time, Fcurrent_time_string)
Juanma Barranquero <lekktu@gmail.com>
parents:
55424
diff
changeset
|
1494 If SPECIFIED-TIME is given, it is the time to convert to float |
56386
4f00fbfe3c1e
(Ffloat_time, Fformat_time_string, Fdecode_time)
Luc Teirlinck <teirllm@auburn.edu>
parents:
56194
diff
changeset
|
1495 instead of the current time. The argument should have the form |
4f00fbfe3c1e
(Ffloat_time, Fformat_time_string, Fdecode_time)
Luc Teirlinck <teirllm@auburn.edu>
parents:
56194
diff
changeset
|
1496 (HIGH LOW . IGNORED). Thus, you can use times obtained from |
4f00fbfe3c1e
(Ffloat_time, Fformat_time_string, Fdecode_time)
Luc Teirlinck <teirllm@auburn.edu>
parents:
56194
diff
changeset
|
1497 `current-time' and from `file-attributes'. SPECIFIED-TIME can also |
4f00fbfe3c1e
(Ffloat_time, Fformat_time_string, Fdecode_time)
Luc Teirlinck <teirllm@auburn.edu>
parents:
56194
diff
changeset
|
1498 have the form (HIGH . LOW), but this is considered obsolete. |
39966
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1499 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1500 WARNING: Since the result is floating point, it may not be exact. |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1501 Do not use this function if precise time stamps are required. */) |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1502 (specified_time) |
30480 | 1503 Lisp_Object specified_time; |
1504 { | |
1505 time_t sec; | |
1506 int usec; | |
1507 | |
1508 if (! lisp_time_argument (specified_time, &sec, &usec)) | |
1509 error ("Invalid time specification"); | |
1510 | |
37046
a9b2639dd045
(Ffloat_time): Fix off-by-factor-of-10 bug in the
Gerd Moellmann <gerd@gnu.org>
parents:
36479
diff
changeset
|
1511 return make_float ((sec * 1e6 + usec) / 1e6); |
30480 | 1512 } |
1513 | |
23213
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1514 /* 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
|
1515 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
|
1516 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
|
1517 Return the number of bytes written, not including the terminating |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1518 '\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
|
1519 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
|
1520 ((size_t) -1) for MAXSIZE. |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1521 |
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
parents:
26058
diff
changeset
|
1522 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
|
1523 bytes in FORMAT. */ |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1524 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
|
1525 emacs_memftimeu (s, maxsize, format, format_len, tp, ut) |
23213
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1526 char *s; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1527 size_t maxsize; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1528 const char *format; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1529 size_t format_len; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1530 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
|
1531 int ut; |
23213
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1532 { |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1533 size_t total = 0; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1534 |
23218
90e5d916ebd9
Add a comment to emacs_memftime, explaining why it needs to loop.
Paul Eggert <eggert@twinsun.com>
parents:
23213
diff
changeset
|
1535 /* 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
|
1536 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
|
1537 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
|
1538 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
|
1539 '\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
|
1540 for (;;) |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1541 { |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1542 size_t len; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1543 size_t result; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1544 |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1545 if (s) |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1546 s[0] = '\1'; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1547 |
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
parents:
26058
diff
changeset
|
1548 result = emacs_strftimeu (s, maxsize, format, tp, ut); |
23213
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1549 |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1550 if (s) |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1551 { |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1552 if (result == 0 && s[0] != '\0') |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1553 return 0; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1554 s += result + 1; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1555 } |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1556 |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1557 maxsize -= result + 1; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1558 total += result; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1559 len = strlen (format); |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1560 if (len == format_len) |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1561 return total; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1562 total++; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1563 format += len + 1; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1564 format_len -= len + 1; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1565 } |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1566 } |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1567 |
17907
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1568 DEFUN ("format-time-string", Fformat_time_string, Sformat_time_string, 1, 3, 0, |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1569 doc: /* Use FORMAT-STRING to format the time TIME, or now if omitted. |
56386
4f00fbfe3c1e
(Ffloat_time, Fformat_time_string, Fdecode_time)
Luc Teirlinck <teirllm@auburn.edu>
parents:
56194
diff
changeset
|
1570 TIME is specified as (HIGH LOW . IGNORED), as returned by |
4f00fbfe3c1e
(Ffloat_time, Fformat_time_string, Fdecode_time)
Luc Teirlinck <teirllm@auburn.edu>
parents:
56194
diff
changeset
|
1571 `current-time' or `file-attributes'. The obsolete form (HIGH . LOW) |
4f00fbfe3c1e
(Ffloat_time, Fformat_time_string, Fdecode_time)
Luc Teirlinck <teirllm@auburn.edu>
parents:
56194
diff
changeset
|
1572 is also still accepted. |
39966
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1573 The third, optional, argument UNIVERSAL, if non-nil, means describe TIME |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1574 as Universal Time; nil means describe TIME in the local time zone. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1575 The value is a copy of FORMAT-STRING, but with certain constructs replaced |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1576 by text that describes the specified date and time in TIME: |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1577 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1578 %Y is the year, %y within the century, %C the century. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1579 %G is the year corresponding to the ISO week, %g within the century. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1580 %m is the numeric month. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1581 %b and %h are the locale's abbreviated month name, %B the full name. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1582 %d is the day of the month, zero-padded, %e is blank-padded. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1583 %u is the numeric day of week from 1 (Monday) to 7, %w from 0 (Sunday) to 6. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1584 %a is the locale's abbreviated name of the day of week, %A the full name. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1585 %U is the week number starting on Sunday, %W starting on Monday, |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1586 %V according to ISO 8601. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1587 %j is the day of the year. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1588 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1589 %H is the hour on a 24-hour clock, %I is on a 12-hour clock, %k is like %H |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1590 only blank-padded, %l is like %I blank-padded. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1591 %p is the locale's equivalent of either AM or PM. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1592 %M is the minute. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1593 %S is the second. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1594 %Z is the time zone name, %z is the numeric form. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1595 %s is the number of seconds since 1970-01-01 00:00:00 +0000. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1596 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1597 %c is the locale's date and time format. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1598 %x is the locale's "preferred" date format. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1599 %D is like "%m/%d/%y". |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1600 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1601 %R is like "%H:%M", %T is like "%H:%M:%S", %r is like "%I:%M:%S %p". |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1602 %X is the locale's "preferred" time format. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1603 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1604 Finally, %n is a newline, %t is a tab, %% is a literal %. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1605 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1606 Certain flags and modifiers are available with some format controls. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1607 The flags are `_', `-', `^' and `#'. For certain characters X, |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1608 %_X is like %X, but padded with blanks; %-X is like %X, |
47763
da8405c812f2
(Fformat_time_string): Doc fix.
Markus Rost <rost@math.uni-bielefeld.de>
parents:
46921
diff
changeset
|
1609 but without padding. %^X is like %X, but with all textual |
da8405c812f2
(Fformat_time_string): Doc fix.
Markus Rost <rost@math.uni-bielefeld.de>
parents:
46921
diff
changeset
|
1610 characters up-cased; %#X is like %X, but with letter-case of |
39966
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1611 all textual characters reversed. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1612 %NX (where N stands for an integer) is like %X, |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1613 but takes up at least N (a number) positions. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1614 The modifiers are `E' and `O'. For certain characters X, |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1615 %EX is a locale's alternative version of %X; |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1616 %OX is like %X, but uses the locale's number symbols. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1617 |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1618 For example, to produce full ISO 8601 format, use "%Y-%m-%dT%T%z". */) |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1619 (format_string, time, universal) |
17907
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1620 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
|
1621 { |
b4739bcefc44
(Fformat_time_string): Mostly rewritten, to handle
Richard M. Stallman <rms@gnu.org>
parents:
8981
diff
changeset
|
1622 time_t value; |
b4739bcefc44
(Fformat_time_string): Mostly rewritten, to handle
Richard M. Stallman <rms@gnu.org>
parents:
8981
diff
changeset
|
1623 int size; |
23198
dddce768cf7a
(Fformat_time_string, Fdecode_time, Fcurrent_time_zone):
Paul Eggert <eggert@twinsun.com>
parents:
23197
diff
changeset
|
1624 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
|
1625 int ut = ! NILP (universal); |
9154
b4739bcefc44
(Fformat_time_string): Mostly rewritten, to handle
Richard M. Stallman <rms@gnu.org>
parents:
8981
diff
changeset
|
1626 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
1627 CHECK_STRING (format_string); |
9154
b4739bcefc44
(Fformat_time_string): Mostly rewritten, to handle
Richard M. Stallman <rms@gnu.org>
parents:
8981
diff
changeset
|
1628 |
30480 | 1629 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
|
1630 error ("Invalid time specification"); |
b4739bcefc44
(Fformat_time_string): Mostly rewritten, to handle
Richard M. Stallman <rms@gnu.org>
parents:
8981
diff
changeset
|
1631 |
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
parents:
26058
diff
changeset
|
1632 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
|
1633 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
|
1634 |
9154
b4739bcefc44
(Fformat_time_string): Mostly rewritten, to handle
Richard M. Stallman <rms@gnu.org>
parents:
8981
diff
changeset
|
1635 /* This is probably enough. */ |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1636 size = SBYTES (format_string) * 6 + 50; |
9154
b4739bcefc44
(Fformat_time_string): Mostly rewritten, to handle
Richard M. Stallman <rms@gnu.org>
parents:
8981
diff
changeset
|
1637 |
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
parents:
26058
diff
changeset
|
1638 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
|
1639 if (! tm) |
dddce768cf7a
(Fformat_time_string, Fdecode_time, Fcurrent_time_zone):
Paul Eggert <eggert@twinsun.com>
parents:
23197
diff
changeset
|
1640 error ("Specified time is not representable"); |
dddce768cf7a
(Fformat_time_string, Fdecode_time, Fcurrent_time_zone):
Paul Eggert <eggert@twinsun.com>
parents:
23197
diff
changeset
|
1641 |
26526
b7438760079b
* callproc.c (strerror): Remove decl.
Paul Eggert <eggert@twinsun.com>
parents:
26415
diff
changeset
|
1642 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
|
1643 |
9154
b4739bcefc44
(Fformat_time_string): Mostly rewritten, to handle
Richard M. Stallman <rms@gnu.org>
parents:
8981
diff
changeset
|
1644 while (1) |
b4739bcefc44
(Fformat_time_string): Mostly rewritten, to handle
Richard M. Stallman <rms@gnu.org>
parents:
8981
diff
changeset
|
1645 { |
17907
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1646 char *buf = (char *) alloca (size + 1); |
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1647 int result; |
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1648 |
19032
84ae0a03a643
(Fformat_time_string): Don't hang if strftime produces
Richard M. Stallman <rms@gnu.org>
parents:
18937
diff
changeset
|
1649 buf[0] = '\1'; |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1650 result = emacs_memftimeu (buf, size, SDATA (format_string), |
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1651 SBYTES (format_string), |
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
parents:
26058
diff
changeset
|
1652 tm, ut); |
19032
84ae0a03a643
(Fformat_time_string): Don't hang if strftime produces
Richard M. Stallman <rms@gnu.org>
parents:
18937
diff
changeset
|
1653 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
|
1654 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
|
1655 Vlocale_coding_system, 0); |
17907
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1656 |
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1657 /* 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
|
1658 result = emacs_memftimeu (NULL, (size_t) -1, |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1659 SDATA (format_string), |
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1660 SBYTES (format_string), |
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
parents:
26058
diff
changeset
|
1661 tm, ut); |
17907
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1662 size = result + 1; |
9154
b4739bcefc44
(Fformat_time_string): Mostly rewritten, to handle
Richard M. Stallman <rms@gnu.org>
parents:
8981
diff
changeset
|
1663 } |
b4739bcefc44
(Fformat_time_string): Mostly rewritten, to handle
Richard M. Stallman <rms@gnu.org>
parents:
8981
diff
changeset
|
1664 } |
b4739bcefc44
(Fformat_time_string): Mostly rewritten, to handle
Richard M. Stallman <rms@gnu.org>
parents:
8981
diff
changeset
|
1665 |
9801
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
1666 DEFUN ("decode-time", Fdecode_time, Sdecode_time, 0, 1, 0, |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1667 doc: /* Decode a time value as (SEC MINUTE HOUR DAY MONTH YEAR DOW DST ZONE). |
56386
4f00fbfe3c1e
(Ffloat_time, Fformat_time_string, Fdecode_time)
Luc Teirlinck <teirllm@auburn.edu>
parents:
56194
diff
changeset
|
1668 The optional SPECIFIED-TIME should be a list of (HIGH LOW . IGNORED), |
4f00fbfe3c1e
(Ffloat_time, Fformat_time_string, Fdecode_time)
Luc Teirlinck <teirllm@auburn.edu>
parents:
56194
diff
changeset
|
1669 as from `current-time' and `file-attributes', or `nil' to use the |
4f00fbfe3c1e
(Ffloat_time, Fformat_time_string, Fdecode_time)
Luc Teirlinck <teirllm@auburn.edu>
parents:
56194
diff
changeset
|
1670 current time. The obsolete form (HIGH . LOW) is also still accepted. |
4f00fbfe3c1e
(Ffloat_time, Fformat_time_string, Fdecode_time)
Luc Teirlinck <teirllm@auburn.edu>
parents:
56194
diff
changeset
|
1671 The list has the following nine members: SEC is an integer between 0 |
4f00fbfe3c1e
(Ffloat_time, Fformat_time_string, Fdecode_time)
Luc Teirlinck <teirllm@auburn.edu>
parents:
56194
diff
changeset
|
1672 and 60; SEC is 60 for a leap second, which only some operating systems |
4f00fbfe3c1e
(Ffloat_time, Fformat_time_string, Fdecode_time)
Luc Teirlinck <teirllm@auburn.edu>
parents:
56194
diff
changeset
|
1673 support. MINUTE is an integer between 0 and 59. HOUR is an integer |
4f00fbfe3c1e
(Ffloat_time, Fformat_time_string, Fdecode_time)
Luc Teirlinck <teirllm@auburn.edu>
parents:
56194
diff
changeset
|
1674 between 0 and 23. DAY is an integer between 1 and 31. MONTH is an |
4f00fbfe3c1e
(Ffloat_time, Fformat_time_string, Fdecode_time)
Luc Teirlinck <teirllm@auburn.edu>
parents:
56194
diff
changeset
|
1675 integer between 1 and 12. YEAR is an integer indicating the |
4f00fbfe3c1e
(Ffloat_time, Fformat_time_string, Fdecode_time)
Luc Teirlinck <teirllm@auburn.edu>
parents:
56194
diff
changeset
|
1676 four-digit year. DOW is the day of week, an integer between 0 and 6, |
4f00fbfe3c1e
(Ffloat_time, Fformat_time_string, Fdecode_time)
Luc Teirlinck <teirllm@auburn.edu>
parents:
56194
diff
changeset
|
1677 where 0 is Sunday. DST is t if daylight savings time is effect, |
4f00fbfe3c1e
(Ffloat_time, Fformat_time_string, Fdecode_time)
Luc Teirlinck <teirllm@auburn.edu>
parents:
56194
diff
changeset
|
1678 otherwise nil. ZONE is an integer indicating the number of seconds |
4f00fbfe3c1e
(Ffloat_time, Fformat_time_string, Fdecode_time)
Luc Teirlinck <teirllm@auburn.edu>
parents:
56194
diff
changeset
|
1679 east of Greenwich. (Note that Common Lisp has different meanings for |
4f00fbfe3c1e
(Ffloat_time, Fformat_time_string, Fdecode_time)
Luc Teirlinck <teirllm@auburn.edu>
parents:
56194
diff
changeset
|
1680 DOW and ZONE.) */) |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1681 (specified_time) |
9801
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
1682 Lisp_Object specified_time; |
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
1683 { |
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
1684 time_t time_spec; |
9812
bc352c8f079c
(Fdecode_time): Fix Lisp_Object vs. integer problems.
Karl Heuer <kwzh@gnu.org>
parents:
9809
diff
changeset
|
1685 struct tm save_tm; |
9801
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
1686 struct tm *decoded_time; |
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
1687 Lisp_Object list_args[9]; |
30480 | 1688 |
1689 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
|
1690 error ("Invalid time specification"); |
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
1691 |
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
1692 decoded_time = localtime (&time_spec); |
23198
dddce768cf7a
(Fformat_time_string, Fdecode_time, Fcurrent_time_zone):
Paul Eggert <eggert@twinsun.com>
parents:
23197
diff
changeset
|
1693 if (! decoded_time) |
dddce768cf7a
(Fformat_time_string, Fdecode_time, Fcurrent_time_zone):
Paul Eggert <eggert@twinsun.com>
parents:
23197
diff
changeset
|
1694 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
|
1695 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
|
1696 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
|
1697 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
|
1698 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
|
1699 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
|
1700 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
|
1701 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
|
1702 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
|
1703 |
bc352c8f079c
(Fdecode_time): Fix Lisp_Object vs. integer problems.
Karl Heuer <kwzh@gnu.org>
parents:
9809
diff
changeset
|
1704 /* 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
|
1705 save_tm = *decoded_time; |
bc352c8f079c
(Fdecode_time): Fix Lisp_Object vs. integer problems.
Karl Heuer <kwzh@gnu.org>
parents:
9809
diff
changeset
|
1706 decoded_time = gmtime (&time_spec); |
bc352c8f079c
(Fdecode_time): Fix Lisp_Object vs. integer problems.
Karl Heuer <kwzh@gnu.org>
parents:
9809
diff
changeset
|
1707 if (decoded_time == 0) |
bc352c8f079c
(Fdecode_time): Fix Lisp_Object vs. integer problems.
Karl Heuer <kwzh@gnu.org>
parents:
9809
diff
changeset
|
1708 list_args[8] = Qnil; |
bc352c8f079c
(Fdecode_time): Fix Lisp_Object vs. integer problems.
Karl Heuer <kwzh@gnu.org>
parents:
9809
diff
changeset
|
1709 else |
16269
79e6c47054c5
(tm_diff): Renamed from difftm. Yield int, not long.
Paul Eggert <eggert@twinsun.com>
parents:
16134
diff
changeset
|
1710 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
|
1711 return Flist (9, list_args); |
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
1712 } |
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
1713 |
15180
9a22c72359c1
(Fencode_time): Accept MANY args, so as to cope
Richard M. Stallman <rms@gnu.org>
parents:
15075
diff
changeset
|
1714 DEFUN ("encode-time", Fencode_time, Sencode_time, 6, MANY, 0, |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1715 doc: /* Convert SECOND, MINUTE, HOUR, DAY, MONTH, YEAR and ZONE to internal time. |
39966
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1716 This is the reverse operation of `decode-time', which see. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1717 ZONE defaults to the current time zone rule. This can |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1718 be a string or t (as from `set-time-zone-rule'), or it can be a list |
40044
7a0668d72687
(text_property_stickiness): Non-rear-non-stickiness doesn't take
Miles Bader <miles@gnu.org>
parents:
40042
diff
changeset
|
1719 \(as from `current-time-zone') or an integer (as from `decode-time') |
39966
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1720 applied without consideration for daylight savings time. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1721 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1722 You can pass more than 7 arguments; then the first six arguments |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1723 are used as SECOND through YEAR, and the *last* argument is used as ZONE. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1724 The intervening arguments are ignored. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1725 This feature lets (apply 'encode-time (decode-time ...)) work. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1726 |
55972
db2480202623
(Fuser_login_name, Ffloat_time, Fencode_time, Fcurrent_time_string)
Juanma Barranquero <lekktu@gmail.com>
parents:
55424
diff
changeset
|
1727 Out-of-range values for SECOND, MINUTE, HOUR, DAY, or MONTH are allowed; |
39966
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1728 for example, a DAY of 0 means the day preceding the given month. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1729 Year numbers less than 100 are treated just like other year numbers. |
40131
de086e415fa2
(Finsert, Finsert_and_inherit, Finsert_before_markers, Fmessage)
Miles Bader <miles@gnu.org>
parents:
40046
diff
changeset
|
1730 If you want them to stand for years in this century, you must do that yourself. |
de086e415fa2
(Finsert, Finsert_and_inherit, Finsert_before_markers, Fmessage)
Miles Bader <miles@gnu.org>
parents:
40046
diff
changeset
|
1731 |
52211
a057bd074729
(Fencode_time): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
51841
diff
changeset
|
1732 Years before 1970 are not guaranteed to work. On some systems, |
a057bd074729
(Fencode_time): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
51841
diff
changeset
|
1733 year values as low as 1901 do work. |
a057bd074729
(Fencode_time): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
51841
diff
changeset
|
1734 |
40131
de086e415fa2
(Finsert, Finsert_and_inherit, Finsert_before_markers, Fmessage)
Miles Bader <miles@gnu.org>
parents:
40046
diff
changeset
|
1735 usage: (encode-time SECOND MINUTE HOUR DAY MONTH YEAR &optional ZONE) */) |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1736 (nargs, args) |
15180
9a22c72359c1
(Fencode_time): Accept MANY args, so as to cope
Richard M. Stallman <rms@gnu.org>
parents:
15075
diff
changeset
|
1737 int nargs; |
9a22c72359c1
(Fencode_time): Accept MANY args, so as to cope
Richard M. Stallman <rms@gnu.org>
parents:
15075
diff
changeset
|
1738 register Lisp_Object *args; |
11402
66d935214d8e
(Fencode_time): Use XINT to examine `zone'.
Richard M. Stallman <rms@gnu.org>
parents:
11263
diff
changeset
|
1739 { |
11468
772f49d1969d
(Fencode_time): Rewrite by Naggum.
Richard M. Stallman <rms@gnu.org>
parents:
11451
diff
changeset
|
1740 time_t time; |
13025
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1741 struct tm tm; |
16874 | 1742 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
|
1743 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
1744 CHECK_NUMBER (args[0]); /* second */ |
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
1745 CHECK_NUMBER (args[1]); /* minute */ |
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
1746 CHECK_NUMBER (args[2]); /* hour */ |
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
1747 CHECK_NUMBER (args[3]); /* day */ |
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
1748 CHECK_NUMBER (args[4]); /* month */ |
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
1749 CHECK_NUMBER (args[5]); /* year */ |
11468
772f49d1969d
(Fencode_time): Rewrite by Naggum.
Richard M. Stallman <rms@gnu.org>
parents:
11451
diff
changeset
|
1750 |
15180
9a22c72359c1
(Fencode_time): Accept MANY args, so as to cope
Richard M. Stallman <rms@gnu.org>
parents:
15075
diff
changeset
|
1751 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
|
1752 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
|
1753 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
|
1754 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
|
1755 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
|
1756 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
|
1757 tm.tm_isdst = -1; |
11468
772f49d1969d
(Fencode_time): Rewrite by Naggum.
Richard M. Stallman <rms@gnu.org>
parents:
11451
diff
changeset
|
1758 |
13025
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1759 if (CONSP (zone)) |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1760 zone = Fcar (zone); |
11468
772f49d1969d
(Fencode_time): Rewrite by Naggum.
Richard M. Stallman <rms@gnu.org>
parents:
11451
diff
changeset
|
1761 if (NILP (zone)) |
13025
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1762 time = mktime (&tm); |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1763 else |
11468
772f49d1969d
(Fencode_time): Rewrite by Naggum.
Richard M. Stallman <rms@gnu.org>
parents:
11451
diff
changeset
|
1764 { |
13025
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1765 char tzbuf[100]; |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1766 char *tzstring; |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1767 char **oldenv = environ, **newenv; |
30480 | 1768 |
18613
614b916ff5bf
Fix bugs with inappropriate mixing of Lisp_Object with int.
Richard M. Stallman <rms@gnu.org>
parents:
18605
diff
changeset
|
1769 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
|
1770 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
|
1771 else if (STRINGP (zone)) |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1772 tzstring = (char *) SDATA (zone); |
13025
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1773 else if (INTEGERP (zone)) |
11468
772f49d1969d
(Fencode_time): Rewrite by Naggum.
Richard M. Stallman <rms@gnu.org>
parents:
11451
diff
changeset
|
1774 { |
13025
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1775 int abszone = abs (XINT (zone)); |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1776 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
|
1777 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
|
1778 tzstring = tzbuf; |
11468
772f49d1969d
(Fencode_time): Rewrite by Naggum.
Richard M. Stallman <rms@gnu.org>
parents:
11451
diff
changeset
|
1779 } |
13025
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1780 else |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1781 error ("Invalid time zone specification"); |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1782 |
30480 | 1783 /* 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
|
1784 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
|
1785 set_time_zone_rule (tzstring); |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1786 |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1787 time = mktime (&tm); |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1788 |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1789 /* Restore TZ to previous value. */ |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1790 newenv = environ; |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1791 environ = oldenv; |
16521
fe9cc0d392dd
(Fencode_time): Use xfree, not free.
Richard M. Stallman <rms@gnu.org>
parents:
16485
diff
changeset
|
1792 xfree (newenv); |
13025
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1793 #ifdef LOCALTIME_CACHE |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1794 tzset (); |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1795 #endif |
11468
772f49d1969d
(Fencode_time): Rewrite by Naggum.
Richard M. Stallman <rms@gnu.org>
parents:
11451
diff
changeset
|
1796 } |
11402
66d935214d8e
(Fencode_time): Use XINT to examine `zone'.
Richard M. Stallman <rms@gnu.org>
parents:
11263
diff
changeset
|
1797 |
13025
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1798 if (time == (time_t) -1) |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1799 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
|
1800 |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1801 return make_time (time); |
11402
66d935214d8e
(Fencode_time): Use XINT to examine `zone'.
Richard M. Stallman <rms@gnu.org>
parents:
11263
diff
changeset
|
1802 } |
66d935214d8e
(Fencode_time): Use XINT to examine `zone'.
Richard M. Stallman <rms@gnu.org>
parents:
11263
diff
changeset
|
1803 |
2154
69c58e548ca5
(Fcurrent_time_string): Optional arg specifies time.
Richard M. Stallman <rms@gnu.org>
parents:
2049
diff
changeset
|
1804 DEFUN ("current-time-string", Fcurrent_time_string, Scurrent_time_string, 0, 1, 0, |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1805 doc: /* Return the current time, as a human-readable string. |
39966
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1806 Programs can use this function to decode a time, |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1807 since the number of columns in each field is fixed. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1808 The format is `Sun Sep 16 01:03:52 1973'. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1809 However, see also the functions `decode-time' and `format-time-string' |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1810 which provide a much more powerful and general facility. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1811 |
56386
4f00fbfe3c1e
(Ffloat_time, Fformat_time_string, Fdecode_time)
Luc Teirlinck <teirllm@auburn.edu>
parents:
56194
diff
changeset
|
1812 If SPECIFIED-TIME is given, it is a time to format instead of the |
4f00fbfe3c1e
(Ffloat_time, Fformat_time_string, Fdecode_time)
Luc Teirlinck <teirllm@auburn.edu>
parents:
56194
diff
changeset
|
1813 current time. The argument should have the form (HIGH LOW . IGNORED). |
4f00fbfe3c1e
(Ffloat_time, Fformat_time_string, Fdecode_time)
Luc Teirlinck <teirllm@auburn.edu>
parents:
56194
diff
changeset
|
1814 Thus, you can use times obtained from `current-time' and from |
4f00fbfe3c1e
(Ffloat_time, Fformat_time_string, Fdecode_time)
Luc Teirlinck <teirllm@auburn.edu>
parents:
56194
diff
changeset
|
1815 `file-attributes'. SPECIFIED-TIME can also have the form (HIGH . LOW), |
4f00fbfe3c1e
(Ffloat_time, Fformat_time_string, Fdecode_time)
Luc Teirlinck <teirllm@auburn.edu>
parents:
56194
diff
changeset
|
1816 but this is considered obsolete. */) |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1817 (specified_time) |
2154
69c58e548ca5
(Fcurrent_time_string): Optional arg specifies time.
Richard M. Stallman <rms@gnu.org>
parents:
2049
diff
changeset
|
1818 Lisp_Object specified_time; |
305 | 1819 { |
2921
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1820 time_t value; |
305 | 1821 char buf[30]; |
2154
69c58e548ca5
(Fcurrent_time_string): Optional arg specifies time.
Richard M. Stallman <rms@gnu.org>
parents:
2049
diff
changeset
|
1822 register char *tem; |
69c58e548ca5
(Fcurrent_time_string): Optional arg specifies time.
Richard M. Stallman <rms@gnu.org>
parents:
2049
diff
changeset
|
1823 |
30480 | 1824 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
|
1825 value = -1; |
2154
69c58e548ca5
(Fcurrent_time_string): Optional arg specifies time.
Richard M. Stallman <rms@gnu.org>
parents:
2049
diff
changeset
|
1826 tem = (char *) ctime (&value); |
305 | 1827 |
1828 strncpy (buf, tem, 24); | |
1829 buf[24] = 0; | |
1830 | |
1831 return build_string (buf); | |
1832 } | |
962
3533821d6edc
* editfns.c (Fcurrent_time_zone): Doc fix.
Jim Blandy <jimb@redhat.com>
parents:
690
diff
changeset
|
1833 |
16269
79e6c47054c5
(tm_diff): Renamed from difftm. Yield int, not long.
Paul Eggert <eggert@twinsun.com>
parents:
16134
diff
changeset
|
1834 #define TM_YEAR_BASE 1900 |
2921
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1835 |
16269
79e6c47054c5
(tm_diff): Renamed from difftm. Yield int, not long.
Paul Eggert <eggert@twinsun.com>
parents:
16134
diff
changeset
|
1836 /* 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
|
1837 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
|
1838 static int |
79e6c47054c5
(tm_diff): Renamed from difftm. Yield int, not long.
Paul Eggert <eggert@twinsun.com>
parents:
16134
diff
changeset
|
1839 tm_diff (a, b) |
2921
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1840 struct tm *a, *b; |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1841 { |
16269
79e6c47054c5
(tm_diff): Renamed from difftm. Yield int, not long.
Paul Eggert <eggert@twinsun.com>
parents:
16134
diff
changeset
|
1842 /* 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
|
1843 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
|
1844 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
|
1845 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
|
1846 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
|
1847 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
|
1848 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
|
1849 int a400 = a100 >> 2; |
79e6c47054c5
(tm_diff): Renamed from difftm. Yield int, not long.
Paul Eggert <eggert@twinsun.com>
parents:
16134
diff
changeset
|
1850 int b400 = b100 >> 2; |
79e6c47054c5
(tm_diff): Renamed from difftm. Yield int, not long.
Paul Eggert <eggert@twinsun.com>
parents:
16134
diff
changeset
|
1851 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
|
1852 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
|
1853 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
|
1854 + (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
|
1855 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
|
1856 + (a->tm_min - b->tm_min)) |
5882 | 1857 + (a->tm_sec - b->tm_sec)); |
2921
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1858 } |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1859 |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1860 DEFUN ("current-time-zone", Fcurrent_time_zone, Scurrent_time_zone, 0, 1, 0, |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1861 doc: /* Return the offset and name for the local time zone. |
39966
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1862 This returns a list of the form (OFFSET NAME). |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1863 OFFSET is an integer number of seconds ahead of UTC (east of Greenwich). |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1864 A negative value means west of Greenwich. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1865 NAME is a string giving the name of the time zone. |
55972
db2480202623
(Fuser_login_name, Ffloat_time, Fencode_time, Fcurrent_time_string)
Juanma Barranquero <lekktu@gmail.com>
parents:
55424
diff
changeset
|
1866 If SPECIFIED-TIME is given, the time zone offset is determined from it |
56386
4f00fbfe3c1e
(Ffloat_time, Fformat_time_string, Fdecode_time)
Luc Teirlinck <teirllm@auburn.edu>
parents:
56194
diff
changeset
|
1867 instead of using the current time. The argument should have the form |
4f00fbfe3c1e
(Ffloat_time, Fformat_time_string, Fdecode_time)
Luc Teirlinck <teirllm@auburn.edu>
parents:
56194
diff
changeset
|
1868 (HIGH LOW . IGNORED). Thus, you can use times obtained from |
4f00fbfe3c1e
(Ffloat_time, Fformat_time_string, Fdecode_time)
Luc Teirlinck <teirllm@auburn.edu>
parents:
56194
diff
changeset
|
1869 `current-time' and from `file-attributes'. SPECIFIED-TIME can also |
4f00fbfe3c1e
(Ffloat_time, Fformat_time_string, Fdecode_time)
Luc Teirlinck <teirllm@auburn.edu>
parents:
56194
diff
changeset
|
1870 have the form (HIGH . LOW), but this is considered obsolete. |
39966
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1871 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1872 Some operating systems cannot provide all this information to Emacs; |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1873 in this case, `current-time-zone' returns a list containing nil for |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1874 the data it can't find. */) |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1875 (specified_time) |
2921
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1876 Lisp_Object specified_time; |
962
3533821d6edc
* editfns.c (Fcurrent_time_zone): Doc fix.
Jim Blandy <jimb@redhat.com>
parents:
690
diff
changeset
|
1877 { |
2921
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1878 time_t value; |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1879 struct tm *t; |
23198
dddce768cf7a
(Fformat_time_string, Fdecode_time, Fcurrent_time_zone):
Paul Eggert <eggert@twinsun.com>
parents:
23197
diff
changeset
|
1880 struct tm gmt; |
962
3533821d6edc
* editfns.c (Fcurrent_time_zone): Doc fix.
Jim Blandy <jimb@redhat.com>
parents:
690
diff
changeset
|
1881 |
30480 | 1882 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
|
1883 && (t = gmtime (&value)) != 0 |
dddce768cf7a
(Fformat_time_string, Fdecode_time, Fcurrent_time_zone):
Paul Eggert <eggert@twinsun.com>
parents:
23197
diff
changeset
|
1884 && (gmt = *t, t = localtime (&value)) != 0) |
2921
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1885 { |
23198
dddce768cf7a
(Fformat_time_string, Fdecode_time, Fcurrent_time_zone):
Paul Eggert <eggert@twinsun.com>
parents:
23197
diff
changeset
|
1886 int offset = tm_diff (t, &gmt); |
dddce768cf7a
(Fformat_time_string, Fdecode_time, Fcurrent_time_zone):
Paul Eggert <eggert@twinsun.com>
parents:
23197
diff
changeset
|
1887 char *s = 0; |
dddce768cf7a
(Fformat_time_string, Fdecode_time, Fcurrent_time_zone):
Paul Eggert <eggert@twinsun.com>
parents:
23197
diff
changeset
|
1888 char buf[6]; |
2921
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1889 #ifdef HAVE_TM_ZONE |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1890 if (t->tm_zone) |
7506
9fa47d36798a
(Fcurrent_time_zone): Add cast.
Richard M. Stallman <rms@gnu.org>
parents:
7485
diff
changeset
|
1891 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
|
1892 #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
|
1893 #ifdef HAVE_TZNAME |
dc9f7a107e28
(Fcurrent_time_zone): Add alternative for !HAVE_TM_ZONE.
Richard M. Stallman <rms@gnu.org>
parents:
2994
diff
changeset
|
1894 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
|
1895 s = tzname[t->tm_isdst]; |
962
3533821d6edc
* editfns.c (Fcurrent_time_zone): Doc fix.
Jim Blandy <jimb@redhat.com>
parents:
690
diff
changeset
|
1896 #endif |
3522
dc9f7a107e28
(Fcurrent_time_zone): Add alternative for !HAVE_TM_ZONE.
Richard M. Stallman <rms@gnu.org>
parents:
2994
diff
changeset
|
1897 #endif /* not HAVE_TM_ZONE */ |
36479
ac3ee681e8f9
(Fcurrent_time_zone) [HAVE_TM_ZONE || HAVE_TZNAME]:
Gerd Moellmann <gerd@gnu.org>
parents:
35998
diff
changeset
|
1898 |
ac3ee681e8f9
(Fcurrent_time_zone) [HAVE_TM_ZONE || HAVE_TZNAME]:
Gerd Moellmann <gerd@gnu.org>
parents:
35998
diff
changeset
|
1899 #if defined HAVE_TM_ZONE || defined HAVE_TZNAME |
ac3ee681e8f9
(Fcurrent_time_zone) [HAVE_TM_ZONE || HAVE_TZNAME]:
Gerd Moellmann <gerd@gnu.org>
parents:
35998
diff
changeset
|
1900 if (s) |
ac3ee681e8f9
(Fcurrent_time_zone) [HAVE_TM_ZONE || HAVE_TZNAME]:
Gerd Moellmann <gerd@gnu.org>
parents:
35998
diff
changeset
|
1901 { |
ac3ee681e8f9
(Fcurrent_time_zone) [HAVE_TM_ZONE || HAVE_TZNAME]:
Gerd Moellmann <gerd@gnu.org>
parents:
35998
diff
changeset
|
1902 /* On Japanese w32, we can get a Japanese string as time |
ac3ee681e8f9
(Fcurrent_time_zone) [HAVE_TM_ZONE || HAVE_TZNAME]:
Gerd Moellmann <gerd@gnu.org>
parents:
35998
diff
changeset
|
1903 zone name. Don't accept that. */ |
ac3ee681e8f9
(Fcurrent_time_zone) [HAVE_TM_ZONE || HAVE_TZNAME]:
Gerd Moellmann <gerd@gnu.org>
parents:
35998
diff
changeset
|
1904 char *p; |
39720
e7c5b465528a
(Fcurrent_time_zone): Cast isalnum() argument to
Gerd Moellmann <gerd@gnu.org>
parents:
39682
diff
changeset
|
1905 for (p = s; *p && (isalnum ((unsigned char)*p) || *p == ' '); ++p) |
36479
ac3ee681e8f9
(Fcurrent_time_zone) [HAVE_TM_ZONE || HAVE_TZNAME]:
Gerd Moellmann <gerd@gnu.org>
parents:
35998
diff
changeset
|
1906 ; |
ac3ee681e8f9
(Fcurrent_time_zone) [HAVE_TM_ZONE || HAVE_TZNAME]:
Gerd Moellmann <gerd@gnu.org>
parents:
35998
diff
changeset
|
1907 if (p == s || *p) |
ac3ee681e8f9
(Fcurrent_time_zone) [HAVE_TM_ZONE || HAVE_TZNAME]:
Gerd Moellmann <gerd@gnu.org>
parents:
35998
diff
changeset
|
1908 s = NULL; |
ac3ee681e8f9
(Fcurrent_time_zone) [HAVE_TM_ZONE || HAVE_TZNAME]:
Gerd Moellmann <gerd@gnu.org>
parents:
35998
diff
changeset
|
1909 } |
ac3ee681e8f9
(Fcurrent_time_zone) [HAVE_TM_ZONE || HAVE_TZNAME]:
Gerd Moellmann <gerd@gnu.org>
parents:
35998
diff
changeset
|
1910 #endif |
ac3ee681e8f9
(Fcurrent_time_zone) [HAVE_TM_ZONE || HAVE_TZNAME]:
Gerd Moellmann <gerd@gnu.org>
parents:
35998
diff
changeset
|
1911 |
2921
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1912 if (!s) |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1913 { |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1914 /* 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
|
1915 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
|
1916 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
|
1917 s = buf; |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1918 } |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1919 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
|
1920 } |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1921 else |
18745
192b3ebd108e
(Fcurrent_time_zone): Convert Fmake_list argument to Lisp_Integer.
Richard M. Stallman <rms@gnu.org>
parents:
18661
diff
changeset
|
1922 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
|
1923 } |
3533821d6edc
* editfns.c (Fcurrent_time_zone): Doc fix.
Jim Blandy <jimb@redhat.com>
parents:
690
diff
changeset
|
1924 |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
1925 /* 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
|
1926 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
|
1927 has never been called. */ |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
1928 static char **environbuf; |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
1929 |
13019
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1930 DEFUN ("set-time-zone-rule", Fset_time_zone_rule, Sset_time_zone_rule, 1, 1, 0, |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1931 doc: /* Set the local time zone using TZ, a string specifying a time zone rule. |
39966
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1932 If TZ is nil, use implementation-defined default time zone information. |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1933 If TZ is t, use Universal Time. */) |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1934 (tz) |
13019
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1935 Lisp_Object tz; |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1936 { |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1937 char *tzstring; |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1938 |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1939 if (NILP (tz)) |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1940 tzstring = 0; |
18613
614b916ff5bf
Fix bugs with inappropriate mixing of Lisp_Object with int.
Richard M. Stallman <rms@gnu.org>
parents:
18605
diff
changeset
|
1941 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
|
1942 tzstring = "UTC0"; |
13019
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1943 else |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1944 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
1945 CHECK_STRING (tz); |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1946 tzstring = (char *) SDATA (tz); |
13019
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1947 } |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1948 |
13025
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1949 set_time_zone_rule (tzstring); |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1950 if (environbuf) |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1951 free (environbuf); |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1952 environbuf = environ; |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1953 |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1954 return Qnil; |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1955 } |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1956 |
16918
ab49512bcdff
(set_time_zone_rule_tz1, set_time_zone_rule_tz2):
Paul Eggert <eggert@twinsun.com>
parents:
16874
diff
changeset
|
1957 #ifdef LOCALTIME_CACHE |
ab49512bcdff
(set_time_zone_rule_tz1, set_time_zone_rule_tz2):
Paul Eggert <eggert@twinsun.com>
parents:
16874
diff
changeset
|
1958 |
ab49512bcdff
(set_time_zone_rule_tz1, set_time_zone_rule_tz2):
Paul Eggert <eggert@twinsun.com>
parents:
16874
diff
changeset
|
1959 /* 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
|
1960 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
|
1961 Their values shouldn't matter in non-buggy implementations. |
30480 | 1962 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
|
1963 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
|
1964 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
|
1965 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
|
1966 improperly modify environment''. */ |
80a852988718
(set_time_zone_rule): Don't put a string literal
Richard M. Stallman <rms@gnu.org>
parents:
15779
diff
changeset
|
1967 |
16918
ab49512bcdff
(set_time_zone_rule_tz1, set_time_zone_rule_tz2):
Paul Eggert <eggert@twinsun.com>
parents:
16874
diff
changeset
|
1968 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
|
1969 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
|
1970 |
ab49512bcdff
(set_time_zone_rule_tz1, set_time_zone_rule_tz2):
Paul Eggert <eggert@twinsun.com>
parents:
16874
diff
changeset
|
1971 #endif |
15841
80a852988718
(set_time_zone_rule): Don't put a string literal
Richard M. Stallman <rms@gnu.org>
parents:
15779
diff
changeset
|
1972 |
13025
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1973 /* 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
|
1974 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
|
1975 responsibility to free. */ |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
1976 |
14201
ff372902386d
(set_time_zone_rule): No longer static.
Richard M. Stallman <rms@gnu.org>
parents:
14126
diff
changeset
|
1977 void |
13025
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1978 set_time_zone_rule (tzstring) |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1979 char *tzstring; |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1980 { |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1981 int envptrs; |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1982 char **from, **to, **newenv; |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1983 |
15334 | 1984 /* 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
|
1985 for (from = environ; *from; from++) |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1986 continue; |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1987 envptrs = from - environ + 2; |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1988 newenv = to = (char **) xmalloc (envptrs * sizeof (char *) |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1989 + (tzstring ? strlen (tzstring) + 4 : 0)); |
15334 | 1990 |
1991 /* 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
|
1992 if (tzstring) |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1993 { |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1994 char *t = (char *) (to + envptrs); |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1995 strcpy (t, "TZ="); |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1996 strcat (t, tzstring); |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1997 *to++ = t; |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1998 } |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1999 |
15334 | 2000 /* Copy the old environ vector elements into NEWENV, |
2001 but don't copy the TZ variable. | |
2002 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
|
2003 for (from = environ; *from; from++) |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
2004 if (strncmp (*from, "TZ=", 3) != 0) |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
2005 *to++ = *from; |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
2006 *to = 0; |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
2007 |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
2008 environ = newenv; |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
2009 |
15334 | 2010 /* If we do have a TZSTRING, NEWENV points to the vector slot where |
2011 the TZ variable is stored. If we do not have a TZSTRING, | |
2012 TO points to the vector slot which has the terminating null. */ | |
2013 | |
13019
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
2014 #ifdef LOCALTIME_CACHE |
15334 | 2015 { |
2016 /* In SunOS 4.1.3_U1 and 4.1.4, if TZ has a value like | |
2017 "US/Pacific" that loads a tz file, then changes to a value like | |
2018 "XXX0" that does not load a tz file, and then changes back to | |
2019 its original value, the last change is (incorrectly) ignored. | |
2020 Also, if TZ changes twice in succession to values that do | |
2021 not load a tz file, tzset can dump core (see Sun bug#1225179). | |
2022 The following code works around these bugs. */ | |
2023 | |
2024 if (tzstring) | |
2025 { | |
2026 /* Temporarily set TZ to a value that loads a tz file | |
2027 and that differs from tzstring. */ | |
2028 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
|
2029 *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
|
2030 ? set_time_zone_rule_tz2 : set_time_zone_rule_tz1); |
15334 | 2031 tzset (); |
2032 *newenv = tz; | |
2033 } | |
2034 else | |
2035 { | |
2036 /* The implied tzstring is unknown, so temporarily set TZ to | |
2037 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
|
2038 *to = set_time_zone_rule_tz1; |
15334 | 2039 to[1] = 0; |
2040 tzset (); | |
15841
80a852988718
(set_time_zone_rule): Don't put a string literal
Richard M. Stallman <rms@gnu.org>
parents:
15779
diff
changeset
|
2041 *to = set_time_zone_rule_tz2; |
15334 | 2042 tzset (); |
2043 *to = 0; | |
2044 } | |
2045 | |
2046 /* Now TZ has the desired value, and tzset can be invoked safely. */ | |
2047 } | |
2048 | |
13019
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
2049 tzset (); |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
2050 #endif |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
2051 } |
305 | 2052 |
17031 | 2053 /* Insert NARGS Lisp objects in the array ARGS by calling INSERT_FUNC |
2054 (if a type of object is Lisp_Int) or INSERT_FROM_STRING_FUNC (if a | |
2055 type of object is Lisp_String). INHERIT is passed to | |
2056 INSERT_FROM_STRING_FUNC as the last argument. */ | |
2057 | |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
2058 static void |
17031 | 2059 general_insert_function (insert_func, insert_from_string_func, |
2060 inherit, nargs, args) | |
46464
e05dd5b81fc7
(general_insert_function): Insertion function now
Ken Raeburn <raeburn@raeburn.org>
parents:
46447
diff
changeset
|
2061 void (*insert_func) P_ ((const 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
|
2062 void (*insert_from_string_func) P_ ((Lisp_Object, int, int, int, int, int)); |
17031 | 2063 int inherit, nargs; |
2064 register Lisp_Object *args; | |
2065 { | |
2066 register int argnum; | |
2067 register Lisp_Object val; | |
2068 | |
2069 for (argnum = 0; argnum < nargs; argnum++) | |
2070 { | |
2071 val = args[argnum]; | |
2072 retry: | |
2073 if (INTEGERP (val)) | |
2074 { | |
26853
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2075 unsigned char str[MAX_MULTIBYTE_LENGTH]; |
17031 | 2076 int len; |
2077 | |
2078 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
|
2079 len = CHAR_STRING (XFASTINT (val), str); |
17031 | 2080 else |
22929
6dda0a4b882f
(general_insert_function): If enable-multibyte-characters is
Kenichi Handa <handa@m17n.org>
parents:
22895
diff
changeset
|
2081 { |
89209
3903a3ae19cb
(general_insert_function): Check VAL by ASCII_CHAR_P,
Kenichi Handa <handa@m17n.org>
parents:
89034
diff
changeset
|
2082 str[0] = (ASCII_CHAR_P (XINT (val)) |
26853
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2083 ? XINT (val) |
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2084 : 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
|
2085 len = 1; |
6dda0a4b882f
(general_insert_function): If enable-multibyte-characters is
Kenichi Handa <handa@m17n.org>
parents:
22895
diff
changeset
|
2086 } |
17031 | 2087 (*insert_func) (str, len); |
2088 } | |
2089 else if (STRINGP (val)) | |
2090 { | |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
2091 (*insert_from_string_func) (val, 0, 0, |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
2092 SCHARS (val), |
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
2093 SBYTES (val), |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
2094 inherit); |
17031 | 2095 } |
2096 else | |
2097 { | |
2098 val = wrong_type_argument (Qchar_or_string_p, val); | |
2099 goto retry; | |
2100 } | |
2101 } | |
2102 } | |
2103 | |
305 | 2104 void |
2105 insert1 (arg) | |
2106 Lisp_Object arg; | |
2107 { | |
2108 Finsert (1, &arg); | |
2109 } | |
2110 | |
330 | 2111 |
2112 /* Callers passing one argument to Finsert need not gcpro the | |
2113 argument "array", since the only element of the array will | |
2114 not be used after calling insert or insert_from_string, so | |
2115 we don't care if it gets trashed. */ | |
2116 | |
305 | 2117 DEFUN ("insert", Finsert, Sinsert, 0, MANY, 0, |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
2118 doc: /* Insert the arguments, either strings or characters, at point. |
39966
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2119 Point and before-insertion markers move forward to end up |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2120 after the inserted text. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2121 Any other markers at the point of insertion remain before the text. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2122 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2123 If the current buffer is multibyte, unibyte strings are converted |
49293
41213ea7b9d6
(Finsert): Mention `string-make-multibyte' and
Kim F. Storm <storm@cua.dk>
parents:
49285
diff
changeset
|
2124 to multibyte for insertion (see `string-make-multibyte'). |
39966
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2125 If the current buffer is unibyte, multibyte strings are converted |
49293
41213ea7b9d6
(Finsert): Mention `string-make-multibyte' and
Kim F. Storm <storm@cua.dk>
parents:
49285
diff
changeset
|
2126 to unibyte for insertion (see `string-make-unibyte'). |
41213ea7b9d6
(Finsert): Mention `string-make-multibyte' and
Kim F. Storm <storm@cua.dk>
parents:
49285
diff
changeset
|
2127 |
41213ea7b9d6
(Finsert): Mention `string-make-multibyte' and
Kim F. Storm <storm@cua.dk>
parents:
49285
diff
changeset
|
2128 When operating on binary data, it may be necessary to preserve the |
41213ea7b9d6
(Finsert): Mention `string-make-multibyte' and
Kim F. Storm <storm@cua.dk>
parents:
49285
diff
changeset
|
2129 original bytes of a unibyte string when inserting it into a multibyte |
41213ea7b9d6
(Finsert): Mention `string-make-multibyte' and
Kim F. Storm <storm@cua.dk>
parents:
49285
diff
changeset
|
2130 buffer; to accomplish this, apply `string-as-multibyte' to the string |
41213ea7b9d6
(Finsert): Mention `string-make-multibyte' and
Kim F. Storm <storm@cua.dk>
parents:
49285
diff
changeset
|
2131 and insert the result. |
40131
de086e415fa2
(Finsert, Finsert_and_inherit, Finsert_before_markers, Fmessage)
Miles Bader <miles@gnu.org>
parents:
40046
diff
changeset
|
2132 |
de086e415fa2
(Finsert, Finsert_and_inherit, Finsert_before_markers, Fmessage)
Miles Bader <miles@gnu.org>
parents:
40046
diff
changeset
|
2133 usage: (insert &rest ARGS) */) |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
2134 (nargs, args) |
305 | 2135 int nargs; |
2136 register Lisp_Object *args; | |
2137 { | |
17031 | 2138 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
|
2139 return Qnil; |
350231e38e68
(Finsert_and_inherit): New function.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2140 } |
350231e38e68
(Finsert_and_inherit): New function.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2141 |
350231e38e68
(Finsert_and_inherit): New function.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2142 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
|
2143 0, MANY, 0, |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
2144 doc: /* Insert the arguments at point, inheriting properties from adjoining text. |
39966
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2145 Point and before-insertion markers move forward to end up |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2146 after the inserted text. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2147 Any other markers at the point of insertion remain before the text. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2148 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2149 If the current buffer is multibyte, unibyte strings are converted |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2150 to multibyte for insertion (see `unibyte-char-to-multibyte'). |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2151 If the current buffer is unibyte, multibyte strings are converted |
40131
de086e415fa2
(Finsert, Finsert_and_inherit, Finsert_before_markers, Fmessage)
Miles Bader <miles@gnu.org>
parents:
40046
diff
changeset
|
2152 to unibyte for insertion. |
de086e415fa2
(Finsert, Finsert_and_inherit, Finsert_before_markers, Fmessage)
Miles Bader <miles@gnu.org>
parents:
40046
diff
changeset
|
2153 |
de086e415fa2
(Finsert, Finsert_and_inherit, Finsert_before_markers, Fmessage)
Miles Bader <miles@gnu.org>
parents:
40046
diff
changeset
|
2154 usage: (insert-and-inherit &rest ARGS) */) |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
2155 (nargs, args) |
4714
350231e38e68
(Finsert_and_inherit): New function.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2156 int nargs; |
350231e38e68
(Finsert_and_inherit): New function.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2157 register Lisp_Object *args; |
350231e38e68
(Finsert_and_inherit): New function.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2158 { |
17031 | 2159 general_insert_function (insert_and_inherit, insert_from_string, 1, |
2160 nargs, args); | |
305 | 2161 return Qnil; |
2162 } | |
2163 | |
2164 DEFUN ("insert-before-markers", Finsert_before_markers, Sinsert_before_markers, 0, MANY, 0, | |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
2165 doc: /* Insert strings or characters at point, relocating markers after the text. |
39966
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2166 Point and markers move forward to end up after the inserted text. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2167 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2168 If the current buffer is multibyte, unibyte strings are converted |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2169 to multibyte for insertion (see `unibyte-char-to-multibyte'). |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2170 If the current buffer is unibyte, multibyte strings are converted |
40131
de086e415fa2
(Finsert, Finsert_and_inherit, Finsert_before_markers, Fmessage)
Miles Bader <miles@gnu.org>
parents:
40046
diff
changeset
|
2171 to unibyte for insertion. |
de086e415fa2
(Finsert, Finsert_and_inherit, Finsert_before_markers, Fmessage)
Miles Bader <miles@gnu.org>
parents:
40046
diff
changeset
|
2172 |
de086e415fa2
(Finsert, Finsert_and_inherit, Finsert_before_markers, Fmessage)
Miles Bader <miles@gnu.org>
parents:
40046
diff
changeset
|
2173 usage: (insert-before-markers &rest ARGS) */) |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
2174 (nargs, args) |
305 | 2175 int nargs; |
2176 register Lisp_Object *args; | |
2177 { | |
17031 | 2178 general_insert_function (insert_before_markers, |
2179 insert_from_string_before_markers, 0, | |
2180 nargs, args); | |
4714
350231e38e68
(Finsert_and_inherit): New function.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2181 return Qnil; |
350231e38e68
(Finsert_and_inherit): New function.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2182 } |
350231e38e68
(Finsert_and_inherit): New function.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2183 |
16485
9b919c5464a4
Reorganize function definitions so etags finds them.
Erik Naggum <erik@naggum.no>
parents:
16298
diff
changeset
|
2184 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
|
2185 Sinsert_and_inherit_before_markers, 0, MANY, 0, |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
2186 doc: /* Insert text at point, relocating markers and inheriting properties. |
39966
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2187 Point and markers move forward to end up after the inserted text. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2188 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2189 If the current buffer is multibyte, unibyte strings are converted |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2190 to multibyte for insertion (see `unibyte-char-to-multibyte'). |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2191 If the current buffer is unibyte, multibyte strings are converted |
40131
de086e415fa2
(Finsert, Finsert_and_inherit, Finsert_before_markers, Fmessage)
Miles Bader <miles@gnu.org>
parents:
40046
diff
changeset
|
2192 to unibyte for insertion. |
de086e415fa2
(Finsert, Finsert_and_inherit, Finsert_before_markers, Fmessage)
Miles Bader <miles@gnu.org>
parents:
40046
diff
changeset
|
2193 |
de086e415fa2
(Finsert, Finsert_and_inherit, Finsert_before_markers, Fmessage)
Miles Bader <miles@gnu.org>
parents:
40046
diff
changeset
|
2194 usage: (insert-before-markers-and-inherit &rest ARGS) */) |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
2195 (nargs, args) |
4714
350231e38e68
(Finsert_and_inherit): New function.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2196 int nargs; |
350231e38e68
(Finsert_and_inherit): New function.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2197 register Lisp_Object *args; |
350231e38e68
(Finsert_and_inherit): New function.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2198 { |
17031 | 2199 general_insert_function (insert_before_markers_and_inherit, |
2200 insert_from_string_before_markers, 1, | |
2201 nargs, args); | |
305 | 2202 return Qnil; |
2203 } | |
2204 | |
8646
0f05e3e89f87
(Finsert_char): New arg INHERIT.
Richard M. Stallman <rms@gnu.org>
parents:
8333
diff
changeset
|
2205 DEFUN ("insert-char", Finsert_char, Sinsert_char, 2, 3, 0, |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
2206 doc: /* Insert COUNT (second arg) copies of CHARACTER (first arg). |
39966
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2207 Both arguments are required. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2208 Point, and before-insertion markers, are relocated as in the function `insert'. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2209 The optional third arg INHERIT, if non-nil, says to inherit text properties |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
2210 from adjoining text, if those properties are sticky. */) |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
2211 (character, count, inherit) |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2212 Lisp_Object character, count, inherit; |
305 | 2213 { |
2214 register unsigned char *string; | |
2215 register int strlen; | |
2216 register int i, n; | |
17031 | 2217 int len; |
26853
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2218 unsigned char str[MAX_MULTIBYTE_LENGTH]; |
305 | 2219 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
2220 CHECK_NUMBER (character); |
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
2221 CHECK_NUMBER (count); |
305 | 2222 |
17031 | 2223 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
|
2224 len = CHAR_STRING (XFASTINT (character), str); |
17031 | 2225 else |
26853
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2226 str[0] = XFASTINT (character), len = 1; |
17031 | 2227 n = XINT (count) * len; |
305 | 2228 if (n <= 0) |
2229 return Qnil; | |
17031 | 2230 strlen = min (n, 256 * len); |
305 | 2231 string = (unsigned char *) alloca (strlen); |
2232 for (i = 0; i < strlen; i++) | |
17031 | 2233 string[i] = str[i % len]; |
305 | 2234 while (n >= strlen) |
2235 { | |
18194
c291aa915b85
(Finsert_char): Check QUIT.
Richard M. Stallman <rms@gnu.org>
parents:
18106
diff
changeset
|
2236 QUIT; |
8646
0f05e3e89f87
(Finsert_char): New arg INHERIT.
Richard M. Stallman <rms@gnu.org>
parents:
8333
diff
changeset
|
2237 if (!NILP (inherit)) |
0f05e3e89f87
(Finsert_char): New arg INHERIT.
Richard M. Stallman <rms@gnu.org>
parents:
8333
diff
changeset
|
2238 insert_and_inherit (string, strlen); |
0f05e3e89f87
(Finsert_char): New arg INHERIT.
Richard M. Stallman <rms@gnu.org>
parents:
8333
diff
changeset
|
2239 else |
0f05e3e89f87
(Finsert_char): New arg INHERIT.
Richard M. Stallman <rms@gnu.org>
parents:
8333
diff
changeset
|
2240 insert (string, strlen); |
305 | 2241 n -= strlen; |
2242 } | |
2243 if (n > 0) | |
10382
9738aad59697
(Finsert_char): Check inherit flag for long strings too.
Karl Heuer <kwzh@gnu.org>
parents:
10308
diff
changeset
|
2244 { |
9738aad59697
(Finsert_char): Check inherit flag for long strings too.
Karl Heuer <kwzh@gnu.org>
parents:
10308
diff
changeset
|
2245 if (!NILP (inherit)) |
9738aad59697
(Finsert_char): Check inherit flag for long strings too.
Karl Heuer <kwzh@gnu.org>
parents:
10308
diff
changeset
|
2246 insert_and_inherit (string, n); |
9738aad59697
(Finsert_char): Check inherit flag for long strings too.
Karl Heuer <kwzh@gnu.org>
parents:
10308
diff
changeset
|
2247 else |
9738aad59697
(Finsert_char): Check inherit flag for long strings too.
Karl Heuer <kwzh@gnu.org>
parents:
10308
diff
changeset
|
2248 insert (string, n); |
9738aad59697
(Finsert_char): Check inherit flag for long strings too.
Karl Heuer <kwzh@gnu.org>
parents:
10308
diff
changeset
|
2249 } |
305 | 2250 return Qnil; |
2251 } | |
2252 | |
89034
63f566c131d7
(Finsert_byte): New function.
Kenichi Handa <handa@m17n.org>
parents:
89025
diff
changeset
|
2253 DEFUN ("insert-byte", Finsert_byte, Sinsert_byte, 2, 3, 0, |
63f566c131d7
(Finsert_byte): New function.
Kenichi Handa <handa@m17n.org>
parents:
89025
diff
changeset
|
2254 doc: /* Insert COUNT (second arg) copies of BYTE (first arg). |
63f566c131d7
(Finsert_byte): New function.
Kenichi Handa <handa@m17n.org>
parents:
89025
diff
changeset
|
2255 Both arguments are required. |
63f566c131d7
(Finsert_byte): New function.
Kenichi Handa <handa@m17n.org>
parents:
89025
diff
changeset
|
2256 BYTE is a number of the range 0..255. |
63f566c131d7
(Finsert_byte): New function.
Kenichi Handa <handa@m17n.org>
parents:
89025
diff
changeset
|
2257 |
63f566c131d7
(Finsert_byte): New function.
Kenichi Handa <handa@m17n.org>
parents:
89025
diff
changeset
|
2258 If BYTE is 128..255 and the current buffer is multibyte, the |
63f566c131d7
(Finsert_byte): New function.
Kenichi Handa <handa@m17n.org>
parents:
89025
diff
changeset
|
2259 corresponding eight-bit character is inserted. |
63f566c131d7
(Finsert_byte): New function.
Kenichi Handa <handa@m17n.org>
parents:
89025
diff
changeset
|
2260 |
63f566c131d7
(Finsert_byte): New function.
Kenichi Handa <handa@m17n.org>
parents:
89025
diff
changeset
|
2261 Point, and before-insertion markers, are relocated as in the function `insert'. |
63f566c131d7
(Finsert_byte): New function.
Kenichi Handa <handa@m17n.org>
parents:
89025
diff
changeset
|
2262 The optional third arg INHERIT, if non-nil, says to inherit text properties |
63f566c131d7
(Finsert_byte): New function.
Kenichi Handa <handa@m17n.org>
parents:
89025
diff
changeset
|
2263 from adjoining text, if those properties are sticky. */) |
63f566c131d7
(Finsert_byte): New function.
Kenichi Handa <handa@m17n.org>
parents:
89025
diff
changeset
|
2264 (byte, count, inherit) |
63f566c131d7
(Finsert_byte): New function.
Kenichi Handa <handa@m17n.org>
parents:
89025
diff
changeset
|
2265 Lisp_Object byte, count, inherit; |
63f566c131d7
(Finsert_byte): New function.
Kenichi Handa <handa@m17n.org>
parents:
89025
diff
changeset
|
2266 { |
63f566c131d7
(Finsert_byte): New function.
Kenichi Handa <handa@m17n.org>
parents:
89025
diff
changeset
|
2267 CHECK_NUMBER (byte); |
63f566c131d7
(Finsert_byte): New function.
Kenichi Handa <handa@m17n.org>
parents:
89025
diff
changeset
|
2268 if (XINT (byte) < 0 || XINT (byte) > 255) |
63f566c131d7
(Finsert_byte): New function.
Kenichi Handa <handa@m17n.org>
parents:
89025
diff
changeset
|
2269 args_out_of_range_3 (byte, make_number (0), make_number (255)); |
63f566c131d7
(Finsert_byte): New function.
Kenichi Handa <handa@m17n.org>
parents:
89025
diff
changeset
|
2270 if (XINT (byte) >= 128 |
63f566c131d7
(Finsert_byte): New function.
Kenichi Handa <handa@m17n.org>
parents:
89025
diff
changeset
|
2271 && ! NILP (current_buffer->enable_multibyte_characters)) |
63f566c131d7
(Finsert_byte): New function.
Kenichi Handa <handa@m17n.org>
parents:
89025
diff
changeset
|
2272 XSETFASTINT (byte, BYTE8_TO_CHAR (XINT (byte))); |
89217
d0650cc0038f
(Finsert_byte): Return a proper value.
Dave Love <fx@gnu.org>
parents:
89209
diff
changeset
|
2273 return Finsert_char (byte, count, inherit); |
89034
63f566c131d7
(Finsert_byte): New function.
Kenichi Handa <handa@m17n.org>
parents:
89025
diff
changeset
|
2274 } |
63f566c131d7
(Finsert_byte): New function.
Kenichi Handa <handa@m17n.org>
parents:
89025
diff
changeset
|
2275 |
305 | 2276 |
648 | 2277 /* Making strings from buffer contents. */ |
2278 | |
2279 /* 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
|
2280 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
|
2281 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
|
2282 have them, if PROPS is nonzero. |
648 | 2283 |
2284 We don't want to use plain old make_string here, because it calls | |
2285 make_uninit_string, which can cause the buffer arena to be | |
2286 compacted. make_string has no way of knowing that the data has | |
2287 been moved, and thus copies the wrong data into the string. This | |
2288 doesn't effect most of the other users of make_string, so it should | |
2289 be left as is. But we should use this function when conjuring | |
2290 buffer substrings. */ | |
1285
d50533e23dff
* editfns.c (make_buffer_string): Call copy_intervals_to_string().
Joseph Arceneaux <jla@gnu.org>
parents:
1254
diff
changeset
|
2291 |
648 | 2292 Lisp_Object |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2293 make_buffer_string (start, end, props) |
648 | 2294 int start, end; |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2295 int props; |
648 | 2296 { |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
2297 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
|
2298 int end_byte = CHAR_TO_BYTE (end); |
648 | 2299 |
21235
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2300 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
|
2301 } |
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2302 |
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2303 /* 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
|
2304 START / START_BYTE to END / END_BYTE. |
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2305 |
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2306 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
|
2307 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
|
2308 have them, if PROPS is nonzero. |
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2309 |
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2310 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
|
2311 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
|
2312 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
|
2313 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
|
2314 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
|
2315 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
|
2316 buffer substrings. */ |
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2317 |
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2318 Lisp_Object |
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2319 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
|
2320 int start, start_byte, end, end_byte; |
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2321 int props; |
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2322 { |
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2323 Lisp_Object result, tem, tem1; |
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2324 |
648 | 2325 if (start < GPT && GPT < end) |
2326 move_gap (start); | |
2327 | |
21257
205a5aa4aa2f
(Fchar_to_string): Use make_string_from_bytes.
Richard M. Stallman <rms@gnu.org>
parents:
21245
diff
changeset
|
2328 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
|
2329 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
|
2330 else |
205a5aa4aa2f
(Fchar_to_string): Use make_string_from_bytes.
Richard M. Stallman <rms@gnu.org>
parents:
21245
diff
changeset
|
2331 result = make_uninit_string (end - start); |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
2332 bcopy (BYTE_POS_ADDR (start_byte), SDATA (result), |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
2333 end_byte - start_byte); |
648 | 2334 |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2335 /* 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
|
2336 if (props) |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2337 { |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2338 update_buffer_properties (start, end); |
5130
ddee29e260d2
(make_buffer_string): Don't copy intervals
Richard M. Stallman <rms@gnu.org>
parents:
4943
diff
changeset
|
2339 |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2340 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
|
2341 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
|
2342 |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2343 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
|
2344 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
|
2345 end - start); |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2346 } |
1285
d50533e23dff
* editfns.c (make_buffer_string): Call copy_intervals_to_string().
Joseph Arceneaux <jla@gnu.org>
parents:
1254
diff
changeset
|
2347 |
648 | 2348 return result; |
2349 } | |
305 | 2350 |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2351 /* 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
|
2352 in the current buffer, if necessary. */ |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2353 |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2354 static void |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2355 update_buffer_properties (start, end) |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2356 int start, end; |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2357 { |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2358 /* 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
|
2359 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
|
2360 if (!NILP (Vbuffer_access_fontify_functions)) |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2361 { |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2362 Lisp_Object args[3]; |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2363 Lisp_Object tem; |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2364 |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2365 args[0] = Qbuffer_access_fontify_functions; |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2366 XSETINT (args[1], start); |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2367 XSETINT (args[2], end); |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2368 |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2369 /* 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
|
2370 has already been done. */ |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2371 if (!NILP (Vbuffer_access_fontified_property)) |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2372 { |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2373 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
|
2374 Vbuffer_access_fontified_property, |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2375 Qnil, Qnil); |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2376 if (! NILP (tem)) |
14126
edc94b82c3b3
(update_buffer_properties): Delete superfluous &'s.
Karl Heuer <kwzh@gnu.org>
parents:
14071
diff
changeset
|
2377 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
|
2378 } |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2379 else |
14126
edc94b82c3b3
(update_buffer_properties): Delete superfluous &'s.
Karl Heuer <kwzh@gnu.org>
parents:
14071
diff
changeset
|
2380 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
|
2381 } |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2382 } |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2383 |
305 | 2384 DEFUN ("buffer-substring", Fbuffer_substring, Sbuffer_substring, 2, 2, 0, |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
2385 doc: /* Return the contents of part of the current buffer as a string. |
39966
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2386 The two arguments START and END are character positions; |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2387 they can be in either order. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2388 The string returned is multibyte if the buffer is multibyte. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2389 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2390 This function copies the text properties of that part of the buffer |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2391 into the result string; if you don't want the text properties, |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
2392 use `buffer-substring-no-properties' instead. */) |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
2393 (start, end) |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2394 Lisp_Object start, end; |
305 | 2395 { |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2396 register int b, e; |
305 | 2397 |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2398 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
|
2399 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
|
2400 e = XINT (end); |
305 | 2401 |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2402 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
|
2403 } |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2404 |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2405 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
|
2406 Sbuffer_substring_no_properties, 2, 2, 0, |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
2407 doc: /* Return the characters of part of the buffer, without the text properties. |
39966
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2408 The two arguments START and END are character positions; |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
2409 they can be in either order. */) |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
2410 (start, end) |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2411 Lisp_Object start, end; |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2412 { |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2413 register int b, e; |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2414 |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2415 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
|
2416 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
|
2417 e = XINT (end); |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2418 |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2419 return make_buffer_string (b, e, 0); |
305 | 2420 } |
2421 | |
2422 DEFUN ("buffer-string", Fbuffer_string, Sbuffer_string, 0, 0, 0, | |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
2423 doc: /* Return the contents of the current buffer as a string. |
39966
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2424 If narrowing is in effect, this function returns only the visible part |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
2425 of the buffer. */) |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
2426 () |
305 | 2427 { |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
2428 return make_buffer_string (BEGV, ZV, 1); |
305 | 2429 } |
2430 | |
2431 DEFUN ("insert-buffer-substring", Finsert_buffer_substring, Sinsert_buffer_substring, | |
40981
fee88c193206
(Fuser_real_login_name): Reindent.
Pavel Janík <Pavel@Janik.cz>
parents:
40699
diff
changeset
|
2432 1, 3, 0, |
55424
04990cada43d
(Finsert_buffer_substring): Make argument names match their use in
Juanma Barranquero <lekktu@gmail.com>
parents:
55193
diff
changeset
|
2433 doc: /* Insert before point a substring of the contents of BUFFER. |
39966
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2434 BUFFER may be a buffer or a buffer name. |
55972
db2480202623
(Fuser_login_name, Ffloat_time, Fencode_time, Fcurrent_time_string)
Juanma Barranquero <lekktu@gmail.com>
parents:
55424
diff
changeset
|
2435 Arguments START and END are character positions specifying the substring. |
db2480202623
(Fuser_login_name, Ffloat_time, Fencode_time, Fcurrent_time_string)
Juanma Barranquero <lekktu@gmail.com>
parents:
55424
diff
changeset
|
2436 They default to the values of (point-min) and (point-max) in BUFFER. */) |
55424
04990cada43d
(Finsert_buffer_substring): Make argument names match their use in
Juanma Barranquero <lekktu@gmail.com>
parents:
55193
diff
changeset
|
2437 (buffer, start, end) |
04990cada43d
(Finsert_buffer_substring): Make argument names match their use in
Juanma Barranquero <lekktu@gmail.com>
parents:
55193
diff
changeset
|
2438 Lisp_Object buffer, start, end; |
305 | 2439 { |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2440 register int b, e, temp; |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2441 register struct buffer *bp, *obuf; |
55424
04990cada43d
(Finsert_buffer_substring): Make argument names match their use in
Juanma Barranquero <lekktu@gmail.com>
parents:
55193
diff
changeset
|
2442 Lisp_Object buf; |
04990cada43d
(Finsert_buffer_substring): Make argument names match their use in
Juanma Barranquero <lekktu@gmail.com>
parents:
55193
diff
changeset
|
2443 |
04990cada43d
(Finsert_buffer_substring): Make argument names match their use in
Juanma Barranquero <lekktu@gmail.com>
parents:
55193
diff
changeset
|
2444 buf = Fget_buffer (buffer); |
04990cada43d
(Finsert_buffer_substring): Make argument names match their use in
Juanma Barranquero <lekktu@gmail.com>
parents:
55193
diff
changeset
|
2445 if (NILP (buf)) |
04990cada43d
(Finsert_buffer_substring): Make argument names match their use in
Juanma Barranquero <lekktu@gmail.com>
parents:
55193
diff
changeset
|
2446 nsberror (buffer); |
04990cada43d
(Finsert_buffer_substring): Make argument names match their use in
Juanma Barranquero <lekktu@gmail.com>
parents:
55193
diff
changeset
|
2447 bp = XBUFFER (buf); |
16134
7558d82368f9
(Finsert_buffer_substring): Check for deleted buffer.
Karl Heuer <kwzh@gnu.org>
parents:
16097
diff
changeset
|
2448 if (NILP (bp->name)) |
7558d82368f9
(Finsert_buffer_substring): Check for deleted buffer.
Karl Heuer <kwzh@gnu.org>
parents:
16097
diff
changeset
|
2449 error ("Selecting deleted buffer"); |
305 | 2450 |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2451 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
|
2452 b = BUF_BEGV (bp); |
305 | 2453 else |
2454 { | |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
2455 CHECK_NUMBER_COERCE_MARKER (start); |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2456 b = XINT (start); |
305 | 2457 } |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2458 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
|
2459 e = BUF_ZV (bp); |
305 | 2460 else |
2461 { | |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
2462 CHECK_NUMBER_COERCE_MARKER (end); |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2463 e = XINT (end); |
305 | 2464 } |
2465 | |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2466 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
|
2467 temp = b, b = e, e = temp; |
305 | 2468 |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2469 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
|
2470 args_out_of_range (start, end); |
305 | 2471 |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2472 obuf = current_buffer; |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2473 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
|
2474 update_buffer_properties (b, e); |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2475 set_buffer_internal_1 (obuf); |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2476 |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2477 insert_from_buffer (bp, b, e - b, 0); |
305 | 2478 return Qnil; |
2479 } | |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2480 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2481 DEFUN ("compare-buffer-substrings", Fcompare_buffer_substrings, Scompare_buffer_substrings, |
40981
fee88c193206
(Fuser_real_login_name): Reindent.
Pavel Janík <Pavel@Janik.cz>
parents:
40699
diff
changeset
|
2482 6, 6, 0, |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
2483 doc: /* Compare two substrings of two buffers; return result as number. |
39966
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2484 the value is -N if first string is less after N-1 chars, |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2485 +N if first string is greater after N-1 chars, or 0 if strings match. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2486 Each substring is represented as three arguments: BUFFER, START and END. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2487 That makes six args in all, three for each substring. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2488 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2489 The value of `case-fold-search' in the current buffer |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
2490 determines whether case is significant or ignored. */) |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
2491 (buffer1, start1, end1, buffer2, start2, end2) |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2492 Lisp_Object buffer1, start1, end1, buffer2, start2, end2; |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2493 { |
21837
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2494 register int begp1, endp1, begp2, endp2, temp; |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2495 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
|
2496 register Lisp_Object *trt |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2497 = (!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
|
2498 ? 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
|
2499 int chars = 0; |
21837
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2500 int i1, i2, i1_byte, i2_byte; |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2501 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2502 /* Find the first buffer and its substring. */ |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2503 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2504 if (NILP (buffer1)) |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2505 bp1 = current_buffer; |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2506 else |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2507 { |
1854
5a18c36181fa
(Finsert_buffer_substring): Proper error for non-ex buffer.
Richard M. Stallman <rms@gnu.org>
parents:
1853
diff
changeset
|
2508 Lisp_Object buf1; |
5a18c36181fa
(Finsert_buffer_substring): Proper error for non-ex buffer.
Richard M. Stallman <rms@gnu.org>
parents:
1853
diff
changeset
|
2509 buf1 = Fget_buffer (buffer1); |
5a18c36181fa
(Finsert_buffer_substring): Proper error for non-ex buffer.
Richard M. Stallman <rms@gnu.org>
parents:
1853
diff
changeset
|
2510 if (NILP (buf1)) |
5a18c36181fa
(Finsert_buffer_substring): Proper error for non-ex buffer.
Richard M. Stallman <rms@gnu.org>
parents:
1853
diff
changeset
|
2511 nsberror (buffer1); |
5a18c36181fa
(Finsert_buffer_substring): Proper error for non-ex buffer.
Richard M. Stallman <rms@gnu.org>
parents:
1853
diff
changeset
|
2512 bp1 = XBUFFER (buf1); |
16134
7558d82368f9
(Finsert_buffer_substring): Check for deleted buffer.
Karl Heuer <kwzh@gnu.org>
parents:
16097
diff
changeset
|
2513 if (NILP (bp1->name)) |
7558d82368f9
(Finsert_buffer_substring): Check for deleted buffer.
Karl Heuer <kwzh@gnu.org>
parents:
16097
diff
changeset
|
2514 error ("Selecting deleted buffer"); |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2515 } |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2516 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2517 if (NILP (start1)) |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2518 begp1 = BUF_BEGV (bp1); |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2519 else |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2520 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
2521 CHECK_NUMBER_COERCE_MARKER (start1); |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2522 begp1 = XINT (start1); |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2523 } |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2524 if (NILP (end1)) |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2525 endp1 = BUF_ZV (bp1); |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2526 else |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2527 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
2528 CHECK_NUMBER_COERCE_MARKER (end1); |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2529 endp1 = XINT (end1); |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2530 } |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2531 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2532 if (begp1 > endp1) |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2533 temp = begp1, begp1 = endp1, endp1 = temp; |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2534 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2535 if (!(BUF_BEGV (bp1) <= begp1 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2536 && begp1 <= endp1 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2537 && endp1 <= BUF_ZV (bp1))) |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2538 args_out_of_range (start1, end1); |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2539 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2540 /* Likewise for second substring. */ |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2541 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2542 if (NILP (buffer2)) |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2543 bp2 = current_buffer; |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2544 else |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2545 { |
1854
5a18c36181fa
(Finsert_buffer_substring): Proper error for non-ex buffer.
Richard M. Stallman <rms@gnu.org>
parents:
1853
diff
changeset
|
2546 Lisp_Object buf2; |
5a18c36181fa
(Finsert_buffer_substring): Proper error for non-ex buffer.
Richard M. Stallman <rms@gnu.org>
parents:
1853
diff
changeset
|
2547 buf2 = Fget_buffer (buffer2); |
5a18c36181fa
(Finsert_buffer_substring): Proper error for non-ex buffer.
Richard M. Stallman <rms@gnu.org>
parents:
1853
diff
changeset
|
2548 if (NILP (buf2)) |
5a18c36181fa
(Finsert_buffer_substring): Proper error for non-ex buffer.
Richard M. Stallman <rms@gnu.org>
parents:
1853
diff
changeset
|
2549 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
|
2550 bp2 = XBUFFER (buf2); |
16134
7558d82368f9
(Finsert_buffer_substring): Check for deleted buffer.
Karl Heuer <kwzh@gnu.org>
parents:
16097
diff
changeset
|
2551 if (NILP (bp2->name)) |
7558d82368f9
(Finsert_buffer_substring): Check for deleted buffer.
Karl Heuer <kwzh@gnu.org>
parents:
16097
diff
changeset
|
2552 error ("Selecting deleted buffer"); |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2553 } |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2554 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2555 if (NILP (start2)) |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2556 begp2 = BUF_BEGV (bp2); |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2557 else |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2558 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
2559 CHECK_NUMBER_COERCE_MARKER (start2); |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2560 begp2 = XINT (start2); |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2561 } |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2562 if (NILP (end2)) |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2563 endp2 = BUF_ZV (bp2); |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2564 else |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2565 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
2566 CHECK_NUMBER_COERCE_MARKER (end2); |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2567 endp2 = XINT (end2); |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2568 } |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2569 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2570 if (begp2 > endp2) |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2571 temp = begp2, begp2 = endp2, endp2 = temp; |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2572 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2573 if (!(BUF_BEGV (bp2) <= begp2 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2574 && begp2 <= endp2 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2575 && endp2 <= BUF_ZV (bp2))) |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2576 args_out_of_range (start2, end2); |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2577 |
21837
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2578 i1 = begp1; |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2579 i2 = begp2; |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2580 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
|
2581 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
|
2582 |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2583 while (i1 < endp1 && i2 < endp2) |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2584 { |
21837
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2585 /* 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
|
2586 characters, not just the bytes. */ |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2587 int c1, c2; |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2588 |
42116
37b724c77b98
(Fcompare_buffer_substrings): Add QUIT to main loop.
Richard M. Stallman <rms@gnu.org>
parents:
41065
diff
changeset
|
2589 QUIT; |
37b724c77b98
(Fcompare_buffer_substrings): Add QUIT to main loop.
Richard M. Stallman <rms@gnu.org>
parents:
41065
diff
changeset
|
2590 |
21837
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2591 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
|
2592 { |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2593 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
|
2594 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
|
2595 i1++; |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2596 } |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2597 else |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2598 { |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2599 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
|
2600 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
|
2601 i1++; |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2602 } |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2603 |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2604 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
|
2605 { |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2606 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
|
2607 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
|
2608 i2++; |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2609 } |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2610 else |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2611 { |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2612 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
|
2613 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
|
2614 i2++; |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2615 } |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
2616 |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2617 if (trt) |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2618 { |
18106
b129c5fd7925
(Fcompare_buffer_substrings): trt contains Lisp_Objects.
Richard M. Stallman <rms@gnu.org>
parents:
18031
diff
changeset
|
2619 c1 = XINT (trt[c1]); |
b129c5fd7925
(Fcompare_buffer_substrings): trt contains Lisp_Objects.
Richard M. Stallman <rms@gnu.org>
parents:
18031
diff
changeset
|
2620 c2 = XINT (trt[c2]); |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2621 } |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2622 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
|
2623 return make_number (- 1 - chars); |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2624 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
|
2625 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
|
2626 |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2627 chars++; |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2628 } |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2629 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2630 /* The strings match as far as they go. |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2631 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
|
2632 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
|
2633 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
|
2634 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
|
2635 return make_number (- chars - 1); |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2636 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2637 /* Same length too => they are equal. */ |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2638 return make_number (0); |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2639 } |
305 | 2640 |
10480
fbb254882b9f
(subst_char_in_region_unwind): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10383
diff
changeset
|
2641 static Lisp_Object |
fbb254882b9f
(subst_char_in_region_unwind): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10383
diff
changeset
|
2642 subst_char_in_region_unwind (arg) |
fbb254882b9f
(subst_char_in_region_unwind): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10383
diff
changeset
|
2643 Lisp_Object arg; |
fbb254882b9f
(subst_char_in_region_unwind): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10383
diff
changeset
|
2644 { |
fbb254882b9f
(subst_char_in_region_unwind): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10383
diff
changeset
|
2645 return current_buffer->undo_list = arg; |
fbb254882b9f
(subst_char_in_region_unwind): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10383
diff
changeset
|
2646 } |
fbb254882b9f
(subst_char_in_region_unwind): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10383
diff
changeset
|
2647 |
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
|
2648 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
|
2649 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
|
2650 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
|
2651 { |
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
|
2652 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
|
2653 } |
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
|
2654 |
305 | 2655 DEFUN ("subst-char-in-region", Fsubst_char_in_region, |
40981
fee88c193206
(Fuser_real_login_name): Reindent.
Pavel Janík <Pavel@Janik.cz>
parents:
40699
diff
changeset
|
2656 Ssubst_char_in_region, 4, 5, 0, |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
2657 doc: /* From START to END, replace FROMCHAR with TOCHAR each time it occurs. |
39966
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2658 If optional arg NOUNDO is non-nil, don't record this change for undo |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2659 and don't mark the buffer as really changed. |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
2660 Both characters must have the same length of multi-byte form. */) |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
2661 (start, end, fromchar, tochar, noundo) |
305 | 2662 Lisp_Object start, end, fromchar, tochar, noundo; |
2663 { | |
20834
95a80c1e06c3
(Fsubst_char_in_region): Handle character-base
Kenichi Handa <handa@m17n.org>
parents:
20826
diff
changeset
|
2664 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
|
2665 int changed = 0; |
26853
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2666 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
|
2667 unsigned char *p; |
46293
1fb8f75062c6
Use macro SPECPDL_INDEX.
Juanma Barranquero <lekktu@gmail.com>
parents:
45398
diff
changeset
|
2668 int count = SPECPDL_INDEX (); |
25507
b9b4581adf36
(Fsubst_char_in_region): Adjust the way to check byte-combining
Kenichi Handa <handa@m17n.org>
parents:
25346
diff
changeset
|
2669 #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
|
2670 #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
|
2671 #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
|
2672 #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
|
2673 int maybe_byte_combining = COMBINING_NO; |
32420
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
2674 int last_changed = 0; |
28358
7ae3851c0a19
(Fsubst_char_in_region): Don't use INC_POS in unibyte
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2675 int multibyte_p = !NILP (current_buffer->enable_multibyte_characters); |
305 | 2676 |
2677 validate_region (&start, &end); | |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
2678 CHECK_NUMBER (fromchar); |
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
2679 CHECK_NUMBER (tochar); |
305 | 2680 |
28358
7ae3851c0a19
(Fsubst_char_in_region): Don't use INC_POS in unibyte
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2681 if (multibyte_p) |
17031 | 2682 { |
26853
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2683 len = CHAR_STRING (XFASTINT (fromchar), fromstr); |
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2684 if (CHAR_STRING (XFASTINT (tochar), tostr) != len) |
63696
43b9742ef102
(Fsubst_char_in_region): Follow error conventions.
Juanma Barranquero <lekktu@gmail.com>
parents:
62662
diff
changeset
|
2685 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
|
2686 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
|
2687 { |
b9b4581adf36
(Fsubst_char_in_region): Adjust the way to check byte-combining
Kenichi Handa <handa@m17n.org>
parents:
25346
diff
changeset
|
2688 /* 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
|
2689 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
|
2690 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
|
2691 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
|
2692 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
|
2693 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
|
2694 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
|
2695 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
|
2696 } |
17031 | 2697 } |
2698 else | |
2699 { | |
2700 len = 1; | |
26853
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2701 fromstr[0] = XFASTINT (fromchar); |
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2702 tostr[0] = XFASTINT (tochar); |
17031 | 2703 } |
2704 | |
20834
95a80c1e06c3
(Fsubst_char_in_region): Handle character-base
Kenichi Handa <handa@m17n.org>
parents:
20826
diff
changeset
|
2705 pos = XINT (start); |
95a80c1e06c3
(Fsubst_char_in_region): Handle character-base
Kenichi Handa <handa@m17n.org>
parents:
20826
diff
changeset
|
2706 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
|
2707 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
|
2708 end_byte = stop; |
305 | 2709 |
10480
fbb254882b9f
(subst_char_in_region_unwind): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10383
diff
changeset
|
2710 /* 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
|
2711 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
|
2712 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
|
2713 Also inhibit locking the file. */ |
10480
fbb254882b9f
(subst_char_in_region_unwind): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10383
diff
changeset
|
2714 if (!NILP (noundo)) |
fbb254882b9f
(subst_char_in_region_unwind): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10383
diff
changeset
|
2715 { |
fbb254882b9f
(subst_char_in_region_unwind): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10383
diff
changeset
|
2716 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
|
2717 current_buffer->undo_list); |
fbb254882b9f
(subst_char_in_region_unwind): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10383
diff
changeset
|
2718 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
|
2719 /* 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
|
2720 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
|
2721 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
|
2722 current_buffer->filename = Qnil; |
10480
fbb254882b9f
(subst_char_in_region_unwind): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10383
diff
changeset
|
2723 } |
fbb254882b9f
(subst_char_in_region_unwind): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10383
diff
changeset
|
2724 |
20834
95a80c1e06c3
(Fsubst_char_in_region): Handle character-base
Kenichi Handa <handa@m17n.org>
parents:
20826
diff
changeset
|
2725 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
|
2726 stop = min (stop, GPT_BYTE); |
17031 | 2727 while (1) |
305 | 2728 { |
23554
e06e84c477fa
(Fsubst_char_in_region): Correctly handle the case
Kenichi Handa <handa@m17n.org>
parents:
23553
diff
changeset
|
2729 int pos_byte_next = pos_byte; |
e06e84c477fa
(Fsubst_char_in_region): Correctly handle the case
Kenichi Handa <handa@m17n.org>
parents:
23553
diff
changeset
|
2730 |
20834
95a80c1e06c3
(Fsubst_char_in_region): Handle character-base
Kenichi Handa <handa@m17n.org>
parents:
20826
diff
changeset
|
2731 if (pos_byte >= stop) |
17031 | 2732 { |
20834
95a80c1e06c3
(Fsubst_char_in_region): Handle character-base
Kenichi Handa <handa@m17n.org>
parents:
20826
diff
changeset
|
2733 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
|
2734 stop = end_byte; |
17031 | 2735 } |
20834
95a80c1e06c3
(Fsubst_char_in_region): Handle character-base
Kenichi Handa <handa@m17n.org>
parents:
20826
diff
changeset
|
2736 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
|
2737 if (multibyte_p) |
7ae3851c0a19
(Fsubst_char_in_region): Don't use INC_POS in unibyte
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2738 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
|
2739 else |
7ae3851c0a19
(Fsubst_char_in_region): Don't use INC_POS in unibyte
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2740 ++pos_byte_next; |
23554
e06e84c477fa
(Fsubst_char_in_region): Correctly handle the case
Kenichi Handa <handa@m17n.org>
parents:
23553
diff
changeset
|
2741 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
|
2742 && p[0] == fromstr[0] |
17031 | 2743 && (len == 1 |
2744 || (p[1] == fromstr[1] | |
2745 && (len == 2 || (p[2] == fromstr[2] | |
2746 && (len == 3 || p[3] == fromstr[3])))))) | |
305 | 2747 { |
5130
ddee29e260d2
(make_buffer_string): Don't copy intervals
Richard M. Stallman <rms@gnu.org>
parents:
4943
diff
changeset
|
2748 if (! changed) |
ddee29e260d2
(make_buffer_string): Don't copy intervals
Richard M. Stallman <rms@gnu.org>
parents:
4943
diff
changeset
|
2749 { |
26853
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2750 changed = pos; |
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2751 modify_region (current_buffer, changed, XINT (end)); |
5242
0e99ea9941e2
(Fmessage): Use message2.
Richard M. Stallman <rms@gnu.org>
parents:
5130
diff
changeset
|
2752 |
0e99ea9941e2
(Fmessage): Use message2.
Richard M. Stallman <rms@gnu.org>
parents:
5130
diff
changeset
|
2753 if (! NILP (noundo)) |
0e99ea9941e2
(Fmessage): Use message2.
Richard M. Stallman <rms@gnu.org>
parents:
5130
diff
changeset
|
2754 { |
10308
90784ed0416f
Use SAVE_MODIFF and BUF_SAVE_MODIFF
Richard M. Stallman <rms@gnu.org>
parents:
9812
diff
changeset
|
2755 if (MODIFF - 1 == SAVE_MODIFF) |
90784ed0416f
Use SAVE_MODIFF and BUF_SAVE_MODIFF
Richard M. Stallman <rms@gnu.org>
parents:
9812
diff
changeset
|
2756 SAVE_MODIFF++; |
5242
0e99ea9941e2
(Fmessage): Use message2.
Richard M. Stallman <rms@gnu.org>
parents:
5130
diff
changeset
|
2757 if (MODIFF - 1 == current_buffer->auto_save_modified) |
0e99ea9941e2
(Fmessage): Use message2.
Richard M. Stallman <rms@gnu.org>
parents:
5130
diff
changeset
|
2758 current_buffer->auto_save_modified++; |
0e99ea9941e2
(Fmessage): Use message2.
Richard M. Stallman <rms@gnu.org>
parents:
5130
diff
changeset
|
2759 } |
5130
ddee29e260d2
(make_buffer_string): Don't copy intervals
Richard M. Stallman <rms@gnu.org>
parents:
4943
diff
changeset
|
2760 } |
ddee29e260d2
(make_buffer_string): Don't copy intervals
Richard M. Stallman <rms@gnu.org>
parents:
4943
diff
changeset
|
2761 |
22895
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2762 /* Take care of the case where the new character |
30480 | 2763 combines with neighboring bytes. */ |
23554
e06e84c477fa
(Fsubst_char_in_region): Correctly handle the case
Kenichi Handa <handa@m17n.org>
parents:
23553
diff
changeset
|
2764 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
|
2765 && (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
|
2766 ? (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
|
2767 && ! 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
|
2768 : ((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
|
2769 && ! 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
|
2770 || (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
|
2771 && ! 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
|
2772 { |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2773 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
|
2774 |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2775 struct gcpro gcpro1; |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2776 |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2777 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
|
2778 GCPRO1 (tem); |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2779 |
25507
b9b4581adf36
(Fsubst_char_in_region): Adjust the way to check byte-combining
Kenichi Handa <handa@m17n.org>
parents:
25346
diff
changeset
|
2780 /* 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
|
2781 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
|
2782 /* 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
|
2783 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
|
2784 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
|
2785 0, 0, 1); |
23554
e06e84c477fa
(Fsubst_char_in_region): Correctly handle the case
Kenichi Handa <handa@m17n.org>
parents:
23553
diff
changeset
|
2786 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
|
2787 if (pos_byte_next > pos_byte) |
e06e84c477fa
(Fsubst_char_in_region): Correctly handle the case
Kenichi Handa <handa@m17n.org>
parents:
23553
diff
changeset
|
2788 /* 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
|
2789 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
|
2790 decrease it now. */ |
077655e1e014
(Fsubst_char_in_region): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23554
diff
changeset
|
2791 pos--; |
23554
e06e84c477fa
(Fsubst_char_in_region): Correctly handle the case
Kenichi Handa <handa@m17n.org>
parents:
23553
diff
changeset
|
2792 else |
23565
077655e1e014
(Fsubst_char_in_region): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23554
diff
changeset
|
2793 INC_POS (pos_byte_next); |
30480 | 2794 |
22895
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2795 if (! NILP (noundo)) |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2796 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
|
2797 |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2798 UNGCPRO; |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2799 } |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2800 else |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2801 { |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2802 if (NILP (noundo)) |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2803 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
|
2804 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
|
2805 } |
26853
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2806 last_changed = pos + 1; |
305 | 2807 } |
23565
077655e1e014
(Fsubst_char_in_region): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23554
diff
changeset
|
2808 pos_byte = pos_byte_next; |
077655e1e014
(Fsubst_char_in_region): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23554
diff
changeset
|
2809 pos++; |
305 | 2810 } |
2811 | |
5130
ddee29e260d2
(make_buffer_string): Don't copy intervals
Richard M. Stallman <rms@gnu.org>
parents:
4943
diff
changeset
|
2812 if (changed) |
26853
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2813 { |
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2814 signal_after_change (changed, |
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2815 last_changed - changed, last_changed - changed); |
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2816 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
|
2817 } |
5130
ddee29e260d2
(make_buffer_string): Don't copy intervals
Richard M. Stallman <rms@gnu.org>
parents:
4943
diff
changeset
|
2818 |
10480
fbb254882b9f
(subst_char_in_region_unwind): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10383
diff
changeset
|
2819 unbind_to (count, Qnil); |
305 | 2820 return Qnil; |
2821 } | |
2822 | |
89878 | 2823 |
2824 static Lisp_Object check_translation P_ ((int, int, int, Lisp_Object)); | |
2825 | |
2826 /* Helper function for Ftranslate_region_internal. | |
2827 | |
2828 Check if a character sequence at POS (POS_BYTE) matches an element | |
2829 of VAL. VAL is a list (([FROM-CHAR ...] . TO) ...). If a matching | |
2830 element is found, return it. Otherwise return Qnil. */ | |
2831 | |
2832 static Lisp_Object | |
2833 check_translation (pos, pos_byte, end, val) | |
2834 int pos, pos_byte, end; | |
2835 Lisp_Object val; | |
2836 { | |
2837 int buf_size = 16, buf_used = 0; | |
2838 int *buf = alloca (sizeof (int) * buf_size); | |
2839 | |
2840 for (; CONSP (val); val = XCDR (val)) | |
2841 { | |
2842 Lisp_Object elt; | |
2843 int len, i; | |
2844 | |
2845 elt = XCAR (val); | |
2846 if (! CONSP (elt)) | |
2847 continue; | |
2848 elt = XCAR (elt); | |
2849 if (! VECTORP (elt)) | |
2850 continue; | |
2851 len = ASIZE (elt); | |
2852 if (len <= end - pos) | |
2853 { | |
2854 for (i = 0; i < len; i++) | |
2855 { | |
2856 if (buf_used <= i) | |
2857 { | |
2858 unsigned char *p = BYTE_POS_ADDR (pos_byte); | |
2859 int len; | |
2860 | |
2861 if (buf_used == buf_size) | |
2862 { | |
2863 int *newbuf; | |
2864 | |
2865 buf_size += 16; | |
2866 newbuf = alloca (sizeof (int) * buf_size); | |
2867 memcpy (newbuf, buf, sizeof (int) * buf_used); | |
2868 buf = newbuf; | |
2869 } | |
2870 buf[buf_used++] = STRING_CHAR_AND_LENGTH (p, 0, len); | |
2871 pos_byte += len; | |
2872 } | |
2873 if (XINT (AREF (elt, i)) != buf[i]) | |
2874 break; | |
2875 } | |
2876 if (i == len) | |
2877 return XCAR (val); | |
2878 } | |
2879 } | |
2880 return Qnil; | |
2881 } | |
2882 | |
2883 | |
57644
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2884 DEFUN ("translate-region-internal", Ftranslate_region_internal, |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2885 Stranslate_region_internal, 3, 3, 0, |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2886 doc: /* Internal use only. |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2887 From START to END, translate characters according to TABLE. |
89878 | 2888 TABLE is a string or a char-table; the Nth character in it is the |
2889 mapping for the character with code N. | |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
2890 It returns the number of characters changed. */) |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
2891 (start, end, table) |
305 | 2892 Lisp_Object start; |
2893 Lisp_Object end; | |
2894 register Lisp_Object table; | |
2895 { | |
2896 register unsigned char *tt; /* Trans table. */ | |
2897 register int nc; /* New character. */ | |
2898 int cnt; /* Number of changes made. */ | |
2899 int size; /* Size of translate table. */ | |
57644
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2900 int pos, pos_byte, end_pos; |
26415
bda6a3a2bf96
(Ftranslate_region): Check the buffer multibyteness.
Kenichi Handa <handa@m17n.org>
parents:
26389
diff
changeset
|
2901 int multibyte = !NILP (current_buffer->enable_multibyte_characters); |
54213
29d4d158e5eb
(Ftranslate_region): Handle multibyte chars in the arg
Kenichi Handa <handa@m17n.org>
parents:
53819
diff
changeset
|
2902 int string_multibyte; |
89840
c49eea8699c8
(Ftranslate_region_internal): Renamed from
Kenichi Handa <handa@m17n.org>
parents:
89601
diff
changeset
|
2903 Lisp_Object val; |
305 | 2904 |
2905 validate_region (&start, &end); | |
57644
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2906 if (CHAR_TABLE_P (table)) |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2907 { |
89878 | 2908 if (! EQ (XCHAR_TABLE (table)->purpose, Qtranslation_table)) |
2909 error ("Not a translation table"); | |
57644
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2910 size = MAX_CHAR; |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2911 tt = NULL; |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2912 } |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2913 else |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2914 { |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2915 CHECK_STRING (table); |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2916 |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2917 if (! multibyte && (SCHARS (table) < SBYTES (table))) |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2918 table = string_make_unibyte (table); |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2919 string_multibyte = SCHARS (table) < SBYTES (table); |
89840
c49eea8699c8
(Ftranslate_region_internal): Renamed from
Kenichi Handa <handa@m17n.org>
parents:
89601
diff
changeset
|
2920 size = SBYTES (table); |
57644
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2921 tt = SDATA (table); |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2922 } |
305 | 2923 |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
2924 pos = XINT (start); |
54214
a2f5ab3b6d1b
(Ftranslate_region): Fix previous change
Kenichi Handa <handa@m17n.org>
parents:
54213
diff
changeset
|
2925 pos_byte = CHAR_TO_BYTE (pos); |
57725
c0675c413aa3
(Fformat): Allocate discarded table with SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
57644
diff
changeset
|
2926 end_pos = XINT (end); |
89878 | 2927 modify_region (current_buffer, pos, end_pos); |
305 | 2928 |
2929 cnt = 0; | |
57644
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2930 for (; pos < end_pos; ) |
305 | 2931 { |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
2932 register unsigned char *p = BYTE_POS_ADDR (pos_byte); |
57644
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2933 unsigned char *str, buf[MAX_MULTIBYTE_LENGTH]; |
54213
29d4d158e5eb
(Ftranslate_region): Handle multibyte chars in the arg
Kenichi Handa <handa@m17n.org>
parents:
53819
diff
changeset
|
2934 int len, str_len; |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
2935 int oc; |
89878 | 2936 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
|
2937 |
26415
bda6a3a2bf96
(Ftranslate_region): Check the buffer multibyteness.
Kenichi Handa <handa@m17n.org>
parents:
26389
diff
changeset
|
2938 if (multibyte) |
54214
a2f5ab3b6d1b
(Ftranslate_region): Fix previous change
Kenichi Handa <handa@m17n.org>
parents:
54213
diff
changeset
|
2939 oc = STRING_CHAR_AND_LENGTH (p, MAX_MULTIBYTE_LENGTH, len); |
26415
bda6a3a2bf96
(Ftranslate_region): Check the buffer multibyteness.
Kenichi Handa <handa@m17n.org>
parents:
26389
diff
changeset
|
2940 else |
bda6a3a2bf96
(Ftranslate_region): Check the buffer multibyteness.
Kenichi Handa <handa@m17n.org>
parents:
26389
diff
changeset
|
2941 oc = *p, len = 1; |
54213
29d4d158e5eb
(Ftranslate_region): Handle multibyte chars in the arg
Kenichi Handa <handa@m17n.org>
parents:
53819
diff
changeset
|
2942 if (oc < size) |
305 | 2943 { |
57644
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2944 if (tt) |
54213
29d4d158e5eb
(Ftranslate_region): Handle multibyte chars in the arg
Kenichi Handa <handa@m17n.org>
parents:
53819
diff
changeset
|
2945 { |
57644
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2946 if (string_multibyte) |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2947 { |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2948 str = tt + string_char_to_byte (table, oc); |
90050
1df66cb75f66
(Ftranslate_region_internal): Don't convert unibyte
Kenichi Handa <handa@m17n.org>
parents:
90044
diff
changeset
|
2949 nc = STRING_CHAR_AND_LENGTH (str, MAX_MULTIBYTE_LENGTH, |
57644
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2950 str_len); |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2951 } |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2952 else |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2953 { |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2954 nc = tt[oc]; |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2955 if (! ASCII_BYTE_P (nc) && multibyte) |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2956 { |
90050
1df66cb75f66
(Ftranslate_region_internal): Don't convert unibyte
Kenichi Handa <handa@m17n.org>
parents:
90044
diff
changeset
|
2957 str_len = BYTE8_STRING (nc, buf); |
57644
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2958 str = buf; |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2959 } |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2960 else |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2961 { |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2962 str_len = 1; |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2963 str = tt + oc; |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2964 } |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2965 } |
54213
29d4d158e5eb
(Ftranslate_region): Handle multibyte chars in the arg
Kenichi Handa <handa@m17n.org>
parents:
53819
diff
changeset
|
2966 } |
29d4d158e5eb
(Ftranslate_region): Handle multibyte chars in the arg
Kenichi Handa <handa@m17n.org>
parents:
53819
diff
changeset
|
2967 else |
29d4d158e5eb
(Ftranslate_region): Handle multibyte chars in the arg
Kenichi Handa <handa@m17n.org>
parents:
53819
diff
changeset
|
2968 { |
57644
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2969 int c; |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2970 |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2971 nc = oc; |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2972 val = CHAR_TABLE_REF (table, oc); |
90050
1df66cb75f66
(Ftranslate_region_internal): Don't convert unibyte
Kenichi Handa <handa@m17n.org>
parents:
90044
diff
changeset
|
2973 if (CHARACTERP (val) |
57644
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2974 && (c = XINT (val), CHAR_VALID_P (c, 0))) |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2975 { |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2976 nc = c; |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2977 str_len = CHAR_STRING (nc, buf); |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2978 str = buf; |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2979 } |
90050
1df66cb75f66
(Ftranslate_region_internal): Don't convert unibyte
Kenichi Handa <handa@m17n.org>
parents:
90044
diff
changeset
|
2980 else if (VECTORP (val) || (CONSP (val))) |
1df66cb75f66
(Ftranslate_region_internal): Don't convert unibyte
Kenichi Handa <handa@m17n.org>
parents:
90044
diff
changeset
|
2981 { |
1df66cb75f66
(Ftranslate_region_internal): Don't convert unibyte
Kenichi Handa <handa@m17n.org>
parents:
90044
diff
changeset
|
2982 /* VAL is [TO_CHAR ...] or (([FROM-CHAR ...] . TO) ...) |
1df66cb75f66
(Ftranslate_region_internal): Don't convert unibyte
Kenichi Handa <handa@m17n.org>
parents:
90044
diff
changeset
|
2983 where TO is TO-CHAR or [TO-CHAR ...]. */ |
1df66cb75f66
(Ftranslate_region_internal): Don't convert unibyte
Kenichi Handa <handa@m17n.org>
parents:
90044
diff
changeset
|
2984 nc = -1; |
1df66cb75f66
(Ftranslate_region_internal): Don't convert unibyte
Kenichi Handa <handa@m17n.org>
parents:
90044
diff
changeset
|
2985 } |
54213
29d4d158e5eb
(Ftranslate_region): Handle multibyte chars in the arg
Kenichi Handa <handa@m17n.org>
parents:
53819
diff
changeset
|
2986 } |
57644
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2987 |
90050
1df66cb75f66
(Ftranslate_region_internal): Don't convert unibyte
Kenichi Handa <handa@m17n.org>
parents:
90044
diff
changeset
|
2988 if (nc != oc && nc >= 0) |
305 | 2989 { |
89878 | 2990 /* Simple one char to one char translation. */ |
54214
a2f5ab3b6d1b
(Ftranslate_region): Fix previous change
Kenichi Handa <handa@m17n.org>
parents:
54213
diff
changeset
|
2991 if (len != str_len) |
22895
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2992 { |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2993 Lisp_Object string; |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2994 |
54214
a2f5ab3b6d1b
(Ftranslate_region): Fix previous change
Kenichi Handa <handa@m17n.org>
parents:
54213
diff
changeset
|
2995 /* This is less efficient, because it moves the gap, |
89878 | 2996 but it should handle multibyte characters correctly. */ |
54213
29d4d158e5eb
(Ftranslate_region): Handle multibyte chars in the arg
Kenichi Handa <handa@m17n.org>
parents:
53819
diff
changeset
|
2997 string = make_multibyte_string (str, 1, str_len); |
54214
a2f5ab3b6d1b
(Ftranslate_region): Fix previous change
Kenichi Handa <handa@m17n.org>
parents:
54213
diff
changeset
|
2998 replace_range (pos, pos + 1, string, 1, 0, 1); |
a2f5ab3b6d1b
(Ftranslate_region): Fix previous change
Kenichi Handa <handa@m17n.org>
parents:
54213
diff
changeset
|
2999 len = str_len; |
22895
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
3000 } |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
3001 else |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
3002 { |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
3003 record_change (pos, 1); |
54213
29d4d158e5eb
(Ftranslate_region): Handle multibyte chars in the arg
Kenichi Handa <handa@m17n.org>
parents:
53819
diff
changeset
|
3004 while (str_len-- > 0) |
29d4d158e5eb
(Ftranslate_region): Handle multibyte chars in the arg
Kenichi Handa <handa@m17n.org>
parents:
53819
diff
changeset
|
3005 *p++ = *str++; |
22895
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
3006 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
|
3007 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
|
3008 } |
305 | 3009 ++cnt; |
3010 } | |
90050
1df66cb75f66
(Ftranslate_region_internal): Don't convert unibyte
Kenichi Handa <handa@m17n.org>
parents:
90044
diff
changeset
|
3011 else if (nc < 0) |
89840
c49eea8699c8
(Ftranslate_region_internal): Renamed from
Kenichi Handa <handa@m17n.org>
parents:
89601
diff
changeset
|
3012 { |
89878 | 3013 Lisp_Object string; |
3014 | |
3015 if (CONSP (val)) | |
3016 { | |
3017 val = check_translation (pos, pos_byte, end_pos, val); | |
3018 if (NILP (val)) | |
3019 { | |
3020 pos_byte += len; | |
3021 pos++; | |
3022 continue; | |
3023 } | |
3024 /* VAL is ([FROM-CHAR ...] . TO). */ | |
3025 len = ASIZE (XCAR (val)); | |
3026 val = XCDR (val); | |
3027 } | |
3028 else | |
3029 len = 1; | |
3030 | |
3031 if (VECTORP (val)) | |
3032 { | |
3033 int i; | |
3034 | |
3035 string = Fmake_string (make_number (ASIZE (val)), | |
3036 AREF (val, 0)); | |
3037 for (i = 1; i < ASIZE (val); i++) | |
3038 Faset (string, make_number (i), AREF (val, i)); | |
3039 } | |
3040 else | |
3041 { | |
3042 string = Fmake_string (make_number (1), val); | |
3043 } | |
3044 replace_range (pos, pos + len, string, 1, 0, 1); | |
3045 pos_byte += SBYTES (string); | |
3046 pos += SCHARS (string); | |
3047 cnt += SCHARS (string); | |
3048 end_pos += SCHARS (string) - len; | |
3049 continue; | |
89840
c49eea8699c8
(Ftranslate_region_internal): Renamed from
Kenichi Handa <handa@m17n.org>
parents:
89601
diff
changeset
|
3050 } |
305 | 3051 } |
54214
a2f5ab3b6d1b
(Ftranslate_region): Fix previous change
Kenichi Handa <handa@m17n.org>
parents:
54213
diff
changeset
|
3052 pos_byte += len; |
23565
077655e1e014
(Fsubst_char_in_region): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23554
diff
changeset
|
3053 pos++; |
305 | 3054 } |
3055 | |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3056 return make_number (cnt); |
305 | 3057 } |
3058 | |
3059 DEFUN ("delete-region", Fdelete_region, Sdelete_region, 2, 2, "r", | |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
3060 doc: /* Delete the text between point and mark. |
55972
db2480202623
(Fuser_login_name, Ffloat_time, Fencode_time, Fcurrent_time_string)
Juanma Barranquero <lekktu@gmail.com>
parents:
55424
diff
changeset
|
3061 |
39966
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3062 When called from a program, expects two arguments, |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
3063 positions (integers or markers) specifying the stretch to be deleted. */) |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
3064 (start, end) |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
3065 Lisp_Object start, end; |
305 | 3066 { |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
3067 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
|
3068 del_range (XINT (start), XINT (end)); |
305 | 3069 return Qnil; |
3070 } | |
26742
936b39bd05b4
* editfns.c (Fdelete_and_extract_region): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
26699
diff
changeset
|
3071 |
936b39bd05b4
* editfns.c (Fdelete_and_extract_region): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
26699
diff
changeset
|
3072 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
|
3073 Sdelete_and_extract_region, 2, 2, 0, |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
3074 doc: /* Delete the text between START and END and return it. */) |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
3075 (start, end) |
26742
936b39bd05b4
* editfns.c (Fdelete_and_extract_region): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
26699
diff
changeset
|
3076 Lisp_Object start, end; |
936b39bd05b4
* editfns.c (Fdelete_and_extract_region): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
26699
diff
changeset
|
3077 { |
936b39bd05b4
* editfns.c (Fdelete_and_extract_region): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
26699
diff
changeset
|
3078 validate_region (&start, &end); |
57606
6a526f57129e
(Fdelete_and_extract_region): If region is empty, return null string.
Richard M. Stallman <rms@gnu.org>
parents:
57076
diff
changeset
|
3079 if (XINT (start) == XINT (end)) |
6a526f57129e
(Fdelete_and_extract_region): If region is empty, return null string.
Richard M. Stallman <rms@gnu.org>
parents:
57076
diff
changeset
|
3080 return build_string (""); |
26742
936b39bd05b4
* editfns.c (Fdelete_and_extract_region): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
26699
diff
changeset
|
3081 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
|
3082 } |
305 | 3083 |
3084 DEFUN ("widen", Fwiden, Swiden, 0, 0, "", | |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
3085 doc: /* Remove restrictions (narrowing) from current buffer. |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
3086 This allows the buffer's full text to be seen and edited. */) |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
3087 () |
305 | 3088 { |
19207
be370e94fb42
(Fwiden, Fnarrow_to_region, save_restriction_restore):
Richard M. Stallman <rms@gnu.org>
parents:
19032
diff
changeset
|
3089 if (BEG != BEGV || Z != ZV) |
be370e94fb42
(Fwiden, Fnarrow_to_region, save_restriction_restore):
Richard M. Stallman <rms@gnu.org>
parents:
19032
diff
changeset
|
3090 current_buffer->clip_changed = 1; |
305 | 3091 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
|
3092 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
|
3093 SET_BUF_ZV_BOTH (current_buffer, Z, Z_BYTE); |
330 | 3094 /* Changing the buffer bounds invalidates any recorded current column. */ |
3095 invalidate_current_column (); | |
305 | 3096 return Qnil; |
3097 } | |
3098 | |
3099 DEFUN ("narrow-to-region", Fnarrow_to_region, Snarrow_to_region, 2, 2, "r", | |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
3100 doc: /* Restrict editing in this buffer to the current region. |
39966
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3101 The rest of the text becomes temporarily invisible and untouchable |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3102 but is not deleted; if you save the buffer in a file, the invisible |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3103 text is included in the file. \\[widen] makes all visible again. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3104 See also `save-restriction'. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3105 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3106 When calling from a program, pass two arguments; positions (integers |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
3107 or markers) bounding the text that should remain visible. */) |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
3108 (start, end) |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
3109 register Lisp_Object start, end; |
305 | 3110 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
3111 CHECK_NUMBER_COERCE_MARKER (start); |
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
3112 CHECK_NUMBER_COERCE_MARKER (end); |
305 | 3113 |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
3114 if (XINT (start) > XINT (end)) |
305 | 3115 { |
10383
a7fe0fb11314
(Fnarrow_to_region): Swap using temp Lisp_Object, not int.
Karl Heuer <kwzh@gnu.org>
parents:
10382
diff
changeset
|
3116 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
|
3117 tem = start; start = end; end = tem; |
305 | 3118 } |
3119 | |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
3120 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
|
3121 args_out_of_range (start, end); |
305 | 3122 |
19207
be370e94fb42
(Fwiden, Fnarrow_to_region, save_restriction_restore):
Richard M. Stallman <rms@gnu.org>
parents:
19032
diff
changeset
|
3123 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
|
3124 current_buffer->clip_changed = 1; |
be370e94fb42
(Fwiden, Fnarrow_to_region, save_restriction_restore):
Richard M. Stallman <rms@gnu.org>
parents:
19032
diff
changeset
|
3125 |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3126 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
|
3127 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
|
3128 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
|
3129 SET_PT (XFASTINT (start)); |
16039
855c8d8ba0f0
Change all references from point to PT.
Karl Heuer <kwzh@gnu.org>
parents:
15910
diff
changeset
|
3130 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
|
3131 SET_PT (XFASTINT (end)); |
330 | 3132 /* Changing the buffer bounds invalidates any recorded current column. */ |
3133 invalidate_current_column (); | |
305 | 3134 return Qnil; |
3135 } | |
3136 | |
3137 Lisp_Object | |
3138 save_restriction_save () | |
3139 { | |
30931
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3140 if (BEGV == BEG && ZV == Z) |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3141 /* 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
|
3142 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
|
3143 recognizes as meaning `no restriction'. */ |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3144 return Fcurrent_buffer (); |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3145 else |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3146 /* 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
|
3147 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
|
3148 { |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3149 Lisp_Object beg, end; |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3150 |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3151 beg = buildmark (BEGV, BEGV_BYTE); |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3152 end = buildmark (ZV, ZV_BYTE); |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3153 |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3154 /* 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
|
3155 XMARKER(end)->insertion_type = 1; |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3156 |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3157 return Fcons (beg, end); |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3158 } |
305 | 3159 } |
3160 | |
3161 Lisp_Object | |
3162 save_restriction_restore (data) | |
3163 Lisp_Object data; | |
3164 { | |
30931
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3165 if (CONSP (data)) |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3166 /* A pair of marks bounding a saved restriction. */ |
305 | 3167 { |
30931
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3168 struct Lisp_Marker *beg = XMARKER (XCAR (data)); |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3169 struct Lisp_Marker *end = XMARKER (XCDR (data)); |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3170 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
|
3171 |
46921
40c8bb63c063
(save_restriction_restore): Defend from unchained marker.
Richard M. Stallman <rms@gnu.org>
parents:
46639
diff
changeset
|
3172 if (buf /* Verify marker still points to a buffer. */ |
40c8bb63c063
(save_restriction_restore): Defend from unchained marker.
Richard M. Stallman <rms@gnu.org>
parents:
46639
diff
changeset
|
3173 && (beg->charpos != BUF_BEGV (buf) || end->charpos != BUF_ZV (buf))) |
30931
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3174 /* 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
|
3175 the saved restriction. */ |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3176 { |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3177 int pt = BUF_PT (buf); |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3178 |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3179 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
|
3180 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
|
3181 |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3182 if (pt < beg->charpos || pt > end->charpos) |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3183 /* 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
|
3184 SET_BUF_PT_BOTH (buf, |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3185 clip_to_bounds (beg->charpos, pt, end->charpos), |
46921
40c8bb63c063
(save_restriction_restore): Defend from unchained marker.
Richard M. Stallman <rms@gnu.org>
parents:
46639
diff
changeset
|
3186 clip_to_bounds (beg->bytepos, BUF_PT_BYTE (buf), |
30931
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3187 end->bytepos)); |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49472
diff
changeset
|
3188 |
30931
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3189 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
|
3190 } |
305 | 3191 } |
30931
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3192 else |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3193 /* 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
|
3194 { |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3195 struct buffer *buf = XBUFFER (data); |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3196 |
46921
40c8bb63c063
(save_restriction_restore): Defend from unchained marker.
Richard M. Stallman <rms@gnu.org>
parents:
46639
diff
changeset
|
3197 if (buf /* Verify marker still points to a buffer. */ |
40c8bb63c063
(save_restriction_restore): Defend from unchained marker.
Richard M. Stallman <rms@gnu.org>
parents:
46639
diff
changeset
|
3198 && (BUF_BEGV (buf) != BUF_BEG (buf) || BUF_ZV (buf) != BUF_Z (buf))) |
30931
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3199 /* 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
|
3200 { |
46921
40c8bb63c063
(save_restriction_restore): Defend from unchained marker.
Richard M. Stallman <rms@gnu.org>
parents:
46639
diff
changeset
|
3201 SET_BUF_BEGV_BOTH (buf, BUF_BEG (buf), BUF_BEG_BYTE (buf)); |
40c8bb63c063
(save_restriction_restore): Defend from unchained marker.
Richard M. Stallman <rms@gnu.org>
parents:
46639
diff
changeset
|
3202 SET_BUF_ZV_BOTH (buf, BUF_Z (buf), BUF_Z_BYTE (buf)); |
30931
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3203 |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3204 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
|
3205 } |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3206 } |
305 | 3207 |
3208 return Qnil; | |
3209 } | |
3210 | |
3211 DEFUN ("save-restriction", Fsave_restriction, Ssave_restriction, 0, UNEVALLED, 0, | |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
3212 doc: /* Execute BODY, saving and restoring current buffer's restrictions. |
39966
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3213 The buffer's restrictions make parts of the beginning and end invisible. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3214 (They are set up with `narrow-to-region' and eliminated with `widen'.) |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3215 This special form, `save-restriction', saves the current buffer's restrictions |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3216 when it is entered, and restores them when it is exited. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3217 So any `narrow-to-region' within BODY lasts only until the end of the form. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3218 The old restrictions settings are restored |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3219 even in case of abnormal exit (throw or error). |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3220 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3221 The value returned is the value of the last form in BODY. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3222 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3223 Note: if you are using both `save-excursion' and `save-restriction', |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3224 use `save-excursion' outermost: |
40140
9bf80d5fff41
(Fsave_excursion, Fsave_current_buffer)
Miles Bader <miles@gnu.org>
parents:
40131
diff
changeset
|
3225 (save-excursion (save-restriction ...)) |
9bf80d5fff41
(Fsave_excursion, Fsave_current_buffer)
Miles Bader <miles@gnu.org>
parents:
40131
diff
changeset
|
3226 |
9bf80d5fff41
(Fsave_excursion, Fsave_current_buffer)
Miles Bader <miles@gnu.org>
parents:
40131
diff
changeset
|
3227 usage: (save-restriction &rest BODY) */) |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
3228 (body) |
305 | 3229 Lisp_Object body; |
3230 { | |
3231 register Lisp_Object val; | |
46293
1fb8f75062c6
Use macro SPECPDL_INDEX.
Juanma Barranquero <lekktu@gmail.com>
parents:
45398
diff
changeset
|
3232 int count = SPECPDL_INDEX (); |
305 | 3233 |
3234 record_unwind_protect (save_restriction_restore, save_restriction_save ()); | |
3235 val = Fprogn (body); | |
3236 return unbind_to (count, val); | |
3237 } | |
3238 | |
38059
0b34b024286d
(Fmessage_box): If the frame is not under a window
Eli Zaretskii <eliz@gnu.org>
parents:
37916
diff
changeset
|
3239 /* Buffer for the most recent text displayed by Fmessage_box. */ |
5884
d02095ea13a5
(Fmessage): Copy the text to be displayed into a malloc'd buffer.
Karl Heuer <kwzh@gnu.org>
parents:
5882
diff
changeset
|
3240 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
|
3241 |
d02095ea13a5
(Fmessage): Copy the text to be displayed into a malloc'd buffer.
Karl Heuer <kwzh@gnu.org>
parents:
5882
diff
changeset
|
3242 /* 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
|
3243 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
|
3244 |
305 | 3245 DEFUN ("message", Fmessage, Smessage, 1, MANY, 0, |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
3246 doc: /* Print a one-line message at the bottom of the screen. |
57736 | 3247 The message also goes into the `*Messages*' buffer. |
3248 \(In keyboard macros, that's all it does.) | |
3249 | |
39966
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3250 The first argument is a format control string, and the rest are data |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3251 to be formatted under control of the string. See `format' for details. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3252 |
57736 | 3253 If the first argument is nil, the function clears any existing message; |
3254 this lets the minibuffer contents show. See also `current-message'. | |
40131
de086e415fa2
(Finsert, Finsert_and_inherit, Finsert_before_markers, Fmessage)
Miles Bader <miles@gnu.org>
parents:
40046
diff
changeset
|
3255 |
de086e415fa2
(Finsert, Finsert_and_inherit, Finsert_before_markers, Fmessage)
Miles Bader <miles@gnu.org>
parents:
40046
diff
changeset
|
3256 usage: (message STRING &rest ARGS) */) |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
3257 (nargs, args) |
305 | 3258 int nargs; |
3259 Lisp_Object *args; | |
3260 { | |
46639
8587dd21917c
(Fmessage): Treat "" like nil.
Richard M. Stallman <rms@gnu.org>
parents:
46464
diff
changeset
|
3261 if (NILP (args[0]) |
8587dd21917c
(Fmessage): Treat "" like nil.
Richard M. Stallman <rms@gnu.org>
parents:
46464
diff
changeset
|
3262 || (STRINGP (args[0]) |
8587dd21917c
(Fmessage): Treat "" like nil.
Richard M. Stallman <rms@gnu.org>
parents:
46464
diff
changeset
|
3263 && SBYTES (args[0]) == 0)) |
1916
e21c1f3e37cb
* editfns.c (Fmessage): Don't forget to return a value when
Jim Blandy <jimb@redhat.com>
parents:
1854
diff
changeset
|
3264 { |
e21c1f3e37cb
* editfns.c (Fmessage): Don't forget to return a value when
Jim Blandy <jimb@redhat.com>
parents:
1854
diff
changeset
|
3265 message (0); |
59662
c140948a6044
(Fmessage): If arg is "", return "" (as before).
Richard M. Stallman <rms@gnu.org>
parents:
59658
diff
changeset
|
3266 return args[0]; |
1916
e21c1f3e37cb
* editfns.c (Fmessage): Don't forget to return a value when
Jim Blandy <jimb@redhat.com>
parents:
1854
diff
changeset
|
3267 } |
1426
67fd35416ba3
* * editfns.c (Fmessage): With no arguments, clear any active
Jim Blandy <jimb@redhat.com>
parents:
1285
diff
changeset
|
3268 else |
67fd35416ba3
* * editfns.c (Fmessage): With no arguments, clear any active
Jim Blandy <jimb@redhat.com>
parents:
1285
diff
changeset
|
3269 { |
67fd35416ba3
* * editfns.c (Fmessage): With no arguments, clear any active
Jim Blandy <jimb@redhat.com>
parents:
1285
diff
changeset
|
3270 register Lisp_Object val; |
48115
72f8d789f551
(Fmessage): Revert last change to properly handle %% format.
Andreas Schwab <schwab@suse.de>
parents:
48111
diff
changeset
|
3271 val = Fformat (nargs, args); |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
3272 message3 (val, SBYTES (val), STRING_MULTIBYTE (val)); |
1426
67fd35416ba3
* * editfns.c (Fmessage): With no arguments, clear any active
Jim Blandy <jimb@redhat.com>
parents:
1285
diff
changeset
|
3273 return val; |
67fd35416ba3
* * editfns.c (Fmessage): With no arguments, clear any active
Jim Blandy <jimb@redhat.com>
parents:
1285
diff
changeset
|
3274 } |
305 | 3275 } |
3276 | |
8975
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3277 DEFUN ("message-box", Fmessage_box, Smessage_box, 1, MANY, 0, |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
3278 doc: /* Display a message, in a dialog box if possible. |
39966
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3279 If a dialog box is not available, use the echo area. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3280 The first argument is a format control string, and the rest are data |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3281 to be formatted under control of the string. See `format' for details. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3282 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3283 If the first argument is nil, clear any existing message; let the |
40131
de086e415fa2
(Finsert, Finsert_and_inherit, Finsert_before_markers, Fmessage)
Miles Bader <miles@gnu.org>
parents:
40046
diff
changeset
|
3284 minibuffer contents show. |
de086e415fa2
(Finsert, Finsert_and_inherit, Finsert_before_markers, Fmessage)
Miles Bader <miles@gnu.org>
parents:
40046
diff
changeset
|
3285 |
de086e415fa2
(Finsert, Finsert_and_inherit, Finsert_before_markers, Fmessage)
Miles Bader <miles@gnu.org>
parents:
40046
diff
changeset
|
3286 usage: (message-box STRING &rest ARGS) */) |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
3287 (nargs, args) |
8975
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3288 int nargs; |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3289 Lisp_Object *args; |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3290 { |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3291 if (NILP (args[0])) |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3292 { |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3293 message (0); |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3294 return Qnil; |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3295 } |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3296 else |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3297 { |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3298 register Lisp_Object val; |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3299 val = Fformat (nargs, args); |
13878
2a71500dfb93
(Fmessage_box, Fmessage_or_box):
Richard M. Stallman <rms@gnu.org>
parents:
13767
diff
changeset
|
3300 #ifdef HAVE_MENUS |
38059
0b34b024286d
(Fmessage_box): If the frame is not under a window
Eli Zaretskii <eliz@gnu.org>
parents:
37916
diff
changeset
|
3301 /* The MS-DOS frames support popup menus even though they are |
0b34b024286d
(Fmessage_box): If the frame is not under a window
Eli Zaretskii <eliz@gnu.org>
parents:
37916
diff
changeset
|
3302 not FRAME_WINDOW_P. */ |
0b34b024286d
(Fmessage_box): If the frame is not under a window
Eli Zaretskii <eliz@gnu.org>
parents:
37916
diff
changeset
|
3303 if (FRAME_WINDOW_P (XFRAME (selected_frame)) |
0b34b024286d
(Fmessage_box): If the frame is not under a window
Eli Zaretskii <eliz@gnu.org>
parents:
37916
diff
changeset
|
3304 || FRAME_MSDOS_P (XFRAME (selected_frame))) |
8975
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3305 { |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3306 Lisp_Object pane, menu, obj; |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3307 struct gcpro gcpro1; |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3308 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
|
3309 GCPRO1 (pane); |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3310 menu = Fcons (val, pane); |
62662
9733e98a93e4
(Fmessage_box): Use "Information" for frame title.
Nick Roberts <nickrob@snap.net.nz>
parents:
61700
diff
changeset
|
3311 obj = Fx_popup_dialog (Qt, menu, Qt); |
8975
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3312 UNGCPRO; |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3313 return val; |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3314 } |
38059
0b34b024286d
(Fmessage_box): If the frame is not under a window
Eli Zaretskii <eliz@gnu.org>
parents:
37916
diff
changeset
|
3315 #endif /* HAVE_MENUS */ |
8975
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3316 /* 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
|
3317 if (! message_text) |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3318 { |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3319 message_text = (char *)xmalloc (80); |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3320 message_length = 80; |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3321 } |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
3322 if (SBYTES (val) > message_length) |
8975
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3323 { |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
3324 message_length = SBYTES (val); |
8975
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3325 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
|
3326 } |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
3327 bcopy (SDATA (val), message_text, SBYTES (val)); |
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
3328 message2 (message_text, SBYTES (val), |
21358
e9f7d8708bae
(Fmessage_box): Pass the missing third argument
Richard M. Stallman <rms@gnu.org>
parents:
21257
diff
changeset
|
3329 STRING_MULTIBYTE (val)); |
8975
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3330 return val; |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3331 } |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3332 } |
13878
2a71500dfb93
(Fmessage_box, Fmessage_or_box):
Richard M. Stallman <rms@gnu.org>
parents:
13767
diff
changeset
|
3333 #ifdef HAVE_MENUS |
8975
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3334 extern Lisp_Object last_nonmenu_event; |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3335 #endif |
13878
2a71500dfb93
(Fmessage_box, Fmessage_or_box):
Richard M. Stallman <rms@gnu.org>
parents:
13767
diff
changeset
|
3336 |
8975
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3337 DEFUN ("message-or-box", Fmessage_or_box, Smessage_or_box, 1, MANY, 0, |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
3338 doc: /* Display a message in a dialog box or in the echo area. |
39966
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3339 If this command was invoked with the mouse, use a dialog box if |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3340 `use-dialog-box' is non-nil. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3341 Otherwise, use the echo area. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3342 The first argument is a format control string, and the rest are data |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3343 to be formatted under control of the string. See `format' for details. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3344 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3345 If the first argument is nil, clear any existing message; let the |
40131
de086e415fa2
(Finsert, Finsert_and_inherit, Finsert_before_markers, Fmessage)
Miles Bader <miles@gnu.org>
parents:
40046
diff
changeset
|
3346 minibuffer contents show. |
de086e415fa2
(Finsert, Finsert_and_inherit, Finsert_before_markers, Fmessage)
Miles Bader <miles@gnu.org>
parents:
40046
diff
changeset
|
3347 |
de086e415fa2
(Finsert, Finsert_and_inherit, Finsert_before_markers, Fmessage)
Miles Bader <miles@gnu.org>
parents:
40046
diff
changeset
|
3348 usage: (message-or-box STRING &rest ARGS) */) |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
3349 (nargs, args) |
8975
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3350 int nargs; |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3351 Lisp_Object *args; |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3352 { |
13878
2a71500dfb93
(Fmessage_box, Fmessage_or_box):
Richard M. Stallman <rms@gnu.org>
parents:
13767
diff
changeset
|
3353 #ifdef HAVE_MENUS |
26699
ed4ab9d24450
(Fmessage_or_box): Use use_dialog_box.
Dave Love <fx@gnu.org>
parents:
26629
diff
changeset
|
3354 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
|
3355 && use_dialog_box) |
8981
6e1a5ff3d795
(Fmessage_or_box): Use Fmessage_box with new name.
Richard M. Stallman <rms@gnu.org>
parents:
8975
diff
changeset
|
3356 return Fmessage_box (nargs, args); |
8975
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3357 #endif |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3358 return Fmessage (nargs, args); |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3359 } |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3360 |
18937
ddb91108a9d2
(Fcurrent_message): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18756
diff
changeset
|
3361 DEFUN ("current-message", Fcurrent_message, Scurrent_message, 0, 0, 0, |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
3362 doc: /* Return the string currently displayed in the echo area, or nil if none. */) |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
3363 () |
18937
ddb91108a9d2
(Fcurrent_message): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18756
diff
changeset
|
3364 { |
25346
15ec35852b48
Remove conditional compilation on NO_PROMPT_IN_BUFFER.
Gerd Moellmann <gerd@gnu.org>
parents:
25018
diff
changeset
|
3365 return current_message (); |
18937
ddb91108a9d2
(Fcurrent_message): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18756
diff
changeset
|
3366 } |
ddb91108a9d2
(Fcurrent_message): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18756
diff
changeset
|
3367 |
25815 | 3368 |
41062
07a4ff5f0909
(Fpropertize): Allow call with 1 arg.
Richard M. Stallman <rms@gnu.org>
parents:
40981
diff
changeset
|
3369 DEFUN ("propertize", Fpropertize, Spropertize, 1, MANY, 0, |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
3370 doc: /* Return a copy of STRING with text properties added. |
39966
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3371 First argument is the string to copy. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3372 Remaining arguments form a sequence of PROPERTY VALUE pairs for text |
40131
de086e415fa2
(Finsert, Finsert_and_inherit, Finsert_before_markers, Fmessage)
Miles Bader <miles@gnu.org>
parents:
40046
diff
changeset
|
3373 properties to add to the result. |
de086e415fa2
(Finsert, Finsert_and_inherit, Finsert_before_markers, Fmessage)
Miles Bader <miles@gnu.org>
parents:
40046
diff
changeset
|
3374 usage: (propertize STRING &rest PROPERTIES) */) |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
3375 (nargs, args) |
25815 | 3376 int nargs; |
3377 Lisp_Object *args; | |
3378 { | |
3379 Lisp_Object properties, string; | |
3380 struct gcpro gcpro1, gcpro2; | |
3381 int i; | |
3382 | |
3383 /* Number of args must be odd. */ | |
41062
07a4ff5f0909
(Fpropertize): Allow call with 1 arg.
Richard M. Stallman <rms@gnu.org>
parents:
40981
diff
changeset
|
3384 if ((nargs & 1) == 0 || nargs < 1) |
25815 | 3385 error ("Wrong number of arguments"); |
3386 | |
3387 properties = string = Qnil; | |
3388 GCPRO2 (properties, string); | |
30480 | 3389 |
25815 | 3390 /* First argument must be a string. */ |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
3391 CHECK_STRING (args[0]); |
25815 | 3392 string = Fcopy_sequence (args[0]); |
3393 | |
3394 for (i = 1; i < nargs; i += 2) | |
65324
3c228c69b2e5
(Fpropertize): Don't insist that properties be symbols.
Richard M. Stallman <rms@gnu.org>
parents:
64770
diff
changeset
|
3395 properties = Fcons (args[i], Fcons (args[i + 1], properties)); |
25815 | 3396 |
3397 Fadd_text_properties (make_number (0), | |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
3398 make_number (SCHARS (string)), |
25815 | 3399 properties, string); |
3400 RETURN_UNGCPRO (string); | |
3401 } | |
3402 | |
3403 | |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3404 /* 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
|
3405 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
|
3406 |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3407 #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
|
3408 (((MULTIBYTE) && ! STRING_MULTIBYTE (STRING)) \ |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
3409 ? count_size_as_multibyte (SDATA (STRING), SBYTES (STRING)) \ |
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
3410 : SBYTES (STRING)) |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3411 |
305 | 3412 DEFUN ("format", Fformat, Sformat, 1, MANY, 0, |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
3413 doc: /* Format a string out of a control-string and arguments. |
39966
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3414 The first argument is a control string. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3415 The other arguments are substituted into it to make the result, a string. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3416 It may contain %-sequences meaning to substitute the next argument. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3417 %s means print a string argument. Actually, prints any object, with `princ'. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3418 %d means print as number in decimal (%o octal, %x hex). |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3419 %X is like %x, but uses upper case. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3420 %e means print a number in exponential notation. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3421 %f means print a number in decimal-point notation. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3422 %g means print a number in exponential notation |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3423 or decimal-point notation, whichever uses fewer characters. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3424 %c means print a number as a single character. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3425 %S means print any object as an s-expression (using `prin1'). |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3426 The argument used for %d, %o, %x, %e, %f, %g or %c must be a number. |
40131
de086e415fa2
(Finsert, Finsert_and_inherit, Finsert_before_markers, Fmessage)
Miles Bader <miles@gnu.org>
parents:
40046
diff
changeset
|
3427 Use %% to put a single % into the output. |
de086e415fa2
(Finsert, Finsert_and_inherit, Finsert_before_markers, Fmessage)
Miles Bader <miles@gnu.org>
parents:
40046
diff
changeset
|
3428 |
53687
4f06a8a0e7a6
For `format', make source and documentation match.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53541
diff
changeset
|
3429 The basic structure of a %-sequence is |
4f06a8a0e7a6
For `format', make source and documentation match.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53541
diff
changeset
|
3430 % <flags> <width> <precision> character |
4f06a8a0e7a6
For `format', make source and documentation match.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53541
diff
changeset
|
3431 where flags is [- #0]+, width is [0-9]+, and precision is .[0-9]+ |
4f06a8a0e7a6
For `format', make source and documentation match.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53541
diff
changeset
|
3432 |
40131
de086e415fa2
(Finsert, Finsert_and_inherit, Finsert_before_markers, Fmessage)
Miles Bader <miles@gnu.org>
parents:
40046
diff
changeset
|
3433 usage: (format STRING &rest OBJECTS) */) |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
3434 (nargs, args) |
305 | 3435 int nargs; |
3436 register Lisp_Object *args; | |
3437 { | |
3438 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
|
3439 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
|
3440 char *buf, *p; |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3441 register unsigned char *format, *end, *format_start; |
25782
8f59abd3a02b
(init_editfns): Remove unused variables.
Gerd Moellmann <gerd@gnu.org>
parents:
25662
diff
changeset
|
3442 int nchars; |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3443 /* 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
|
3444 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
|
3445 int multibyte = 0; |
22698
ea6ef56295b4
(Fformat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents:
22669
diff
changeset
|
3446 /* 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
|
3447 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
|
3448 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
|
3449 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
|
3450 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
|
3451 unsigned char *this_format; |
48764
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3452 /* Precision for each spec, or -1, a flag value meaning no precision |
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3453 was given in that spec. Element 0, corresonding to the format |
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3454 string itself, will not be used. Element NARGS, corresponding to |
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3455 no argument, *will* be assigned to in the case that a `%' and `.' |
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3456 occur after the final format specifier. */ |
54846
e8865bfda38b
(Fformat): Fix allocation size of precision array.
Kim F. Storm <storm@cua.dk>
parents:
54655
diff
changeset
|
3457 int *precision = (int *) (alloca((nargs + 1) * sizeof (int))); |
20826
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3458 int longest_format; |
20804
14fa73136e64
(CONVERTED_BYTE_SIZE): Fix the logic.
Kenichi Handa <handa@m17n.org>
parents:
20706
diff
changeset
|
3459 Lisp_Object val; |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3460 int arg_intervals = 0; |
56194
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
3461 USE_SAFE_ALLOCA; |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3462 |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3463 /* discarded[I] is 1 if byte I of the format |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3464 string was not copied into the output. |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3465 It is 2 if byte I was not the first byte of its character. */ |
57725
c0675c413aa3
(Fformat): Allocate discarded table with SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
57644
diff
changeset
|
3466 char *discarded = 0; |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3467 |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3468 /* Each element records, for one argument, |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3469 the start and end bytepos in the output string, |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3470 and whether the argument is a string with intervals. |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3471 info[0] is unused. Unused elements have -1 for start. */ |
25018 | 3472 struct info |
3473 { | |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3474 int start, end, intervals; |
25018 | 3475 } *info = 0; |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3476 |
305 | 3477 /* It should not be necessary to GCPRO ARGS, because |
3478 the caller in the interpreter should take care of that. */ | |
3479 | |
20826
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3480 /* 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
|
3481 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
|
3482 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
|
3483 and in that case, we won't know it here. */ |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3484 for (n = 0; n < nargs; n++) |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3485 { |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3486 if (STRINGP (args[n]) && STRING_MULTIBYTE (args[n])) |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3487 multibyte = 1; |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3488 /* Piggyback on this loop to initialize precision[N]. */ |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3489 precision[n] = -1; |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3490 } |
56560
1a84eb100ef3
(Fformat): Allocated extra (dummy) element in info.
Kim F. Storm <storm@cua.dk>
parents:
56386
diff
changeset
|
3491 precision[nargs] = -1; |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3492 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
3493 CHECK_STRING (args[0]); |
50430
4d74ea083bd2
(Fformat): Use a copy of FORMAT string so that we can
Kenichi Handa <handa@m17n.org>
parents:
49600
diff
changeset
|
3494 /* We may have to change "%S" to "%s". */ |
4d74ea083bd2
(Fformat): Use a copy of FORMAT string so that we can
Kenichi Handa <handa@m17n.org>
parents:
49600
diff
changeset
|
3495 args[0] = Fcopy_sequence (args[0]); |
20826
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3496 |
50746
2a57a6e6b390
(Fformat): Set abort_on_gc during first scan of format.
Richard M. Stallman <rms@gnu.org>
parents:
50555
diff
changeset
|
3497 /* GC should never happen here, so abort if it does. */ |
2a57a6e6b390
(Fformat): Set abort_on_gc during first scan of format.
Richard M. Stallman <rms@gnu.org>
parents:
50555
diff
changeset
|
3498 abort_on_gc++; |
2a57a6e6b390
(Fformat): Set abort_on_gc during first scan of format.
Richard M. Stallman <rms@gnu.org>
parents:
50555
diff
changeset
|
3499 |
20826
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3500 /* If we start out planning a unibyte result, |
50746
2a57a6e6b390
(Fformat): Set abort_on_gc during first scan of format.
Richard M. Stallman <rms@gnu.org>
parents:
50555
diff
changeset
|
3501 then discover it has to be multibyte, we jump back to retry. |
2a57a6e6b390
(Fformat): Set abort_on_gc during first scan of format.
Richard M. Stallman <rms@gnu.org>
parents:
50555
diff
changeset
|
3502 That can only happen from the first large while loop below. */ |
20826
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3503 retry: |
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3504 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
3505 format = SDATA (args[0]); |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3506 format_start = format; |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
3507 end = format + SBYTES (args[0]); |
20826
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3508 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
|
3509 |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3510 /* Make room in result for all the non-%-codes in the control string. */ |
56194
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
3511 total = 5 + CONVERTED_BYTE_SIZE (multibyte, args[0]) + 1; |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3512 |
54846
e8865bfda38b
(Fformat): Fix allocation size of precision array.
Kim F. Storm <storm@cua.dk>
parents:
54655
diff
changeset
|
3513 /* Allocate the info and discarded tables. */ |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3514 { |
56560
1a84eb100ef3
(Fformat): Allocated extra (dummy) element in info.
Kim F. Storm <storm@cua.dk>
parents:
56386
diff
changeset
|
3515 int nbytes = (nargs+1) * sizeof *info; |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3516 int i; |
57725
c0675c413aa3
(Fformat): Allocate discarded table with SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
57644
diff
changeset
|
3517 if (!info) |
c0675c413aa3
(Fformat): Allocate discarded table with SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
57644
diff
changeset
|
3518 info = (struct info *) alloca (nbytes); |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3519 bzero (info, nbytes); |
56560
1a84eb100ef3
(Fformat): Allocated extra (dummy) element in info.
Kim F. Storm <storm@cua.dk>
parents:
56386
diff
changeset
|
3520 for (i = 0; i <= nargs; i++) |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3521 info[i].start = -1; |
57725
c0675c413aa3
(Fformat): Allocate discarded table with SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
57644
diff
changeset
|
3522 if (!discarded) |
c0675c413aa3
(Fformat): Allocate discarded table with SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
57644
diff
changeset
|
3523 SAFE_ALLOCA (discarded, char *, SBYTES (args[0])); |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3524 bzero (discarded, SBYTES (args[0])); |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3525 } |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3526 |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3527 /* Add to TOTAL enough space to hold the converted arguments. */ |
305 | 3528 |
3529 n = 0; | |
3530 while (format != end) | |
3531 if (*format++ == '%') | |
3532 { | |
34566
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3533 int thissize = 0; |
42484
717eee813b2c
(Fformat): Update thissize from field_width
Richard M. Stallman <rms@gnu.org>
parents:
42116
diff
changeset
|
3534 int actual_width = 0; |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3535 unsigned char *this_format_start = format - 1; |
48764
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3536 int field_width = 0; |
34566
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3537 |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3538 /* General format specifications look like |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3539 |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3540 '%' [flags] [field-width] [precision] format |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3541 |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3542 where |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3543 |
53687
4f06a8a0e7a6
For `format', make source and documentation match.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53541
diff
changeset
|
3544 flags ::= [- #0]+ |
34566
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3545 field-width ::= [0-9]+ |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3546 precision ::= '.' [0-9]* |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3547 |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3548 If a field-width is specified, it specifies to which width |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3549 the output should be padded with blanks, iff the output |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3550 string is shorter than field-width. |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3551 |
48764
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3552 If precision is specified, it specifies the number of |
34566
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3553 digits to print after the '.' for floats, or the max. |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3554 number of chars to print from a string. */ |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3555 |
53687
4f06a8a0e7a6
For `format', make source and documentation match.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53541
diff
changeset
|
3556 while (index ("-0# ", *format)) |
34566
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3557 ++format; |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3558 |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3559 if (*format >= '0' && *format <= '9') |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3560 { |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3561 for (field_width = 0; *format >= '0' && *format <= '9'; ++format) |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3562 field_width = 10 * field_width + *format - '0'; |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3563 } |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3564 |
48764
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3565 /* N is not incremented for another few lines below, so refer to |
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3566 element N+1 (which might be precision[NARGS]). */ |
34566
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3567 if (*format == '.') |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3568 { |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3569 ++format; |
48764
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3570 for (precision[n+1] = 0; *format >= '0' && *format <= '9'; ++format) |
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3571 precision[n+1] = 10 * precision[n+1] + *format - '0'; |
34566
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3572 } |
305 | 3573 |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3574 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
|
3575 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
|
3576 |
23197
0d3baa5514b7
(Fformat): Detect incomplete format spec at string's end.
Karl Heuer <kwzh@gnu.org>
parents:
23166
diff
changeset
|
3577 if (format == end) |
0d3baa5514b7
(Fformat): Detect incomplete format spec at string's end.
Karl Heuer <kwzh@gnu.org>
parents:
23166
diff
changeset
|
3578 error ("Format string ends in middle of format specifier"); |
305 | 3579 if (*format == '%') |
3580 format++; | |
3581 else if (++n >= nargs) | |
12831
3917c5d131d3
(Fformat): Limit minlen to avoid stack overflow.
Richard M. Stallman <rms@gnu.org>
parents:
12623
diff
changeset
|
3582 error ("Not enough arguments for format string"); |
305 | 3583 else if (*format == 'S') |
3584 { | |
3585 /* For `S', prin1 the argument and then treat like a string. */ | |
3586 register Lisp_Object tem; | |
3587 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
|
3588 if (STRING_MULTIBYTE (tem) && ! multibyte) |
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3589 { |
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3590 multibyte = 1; |
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3591 goto retry; |
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3592 } |
305 | 3593 args[n] = tem; |
50430
4d74ea083bd2
(Fformat): Use a copy of FORMAT string so that we can
Kenichi Handa <handa@m17n.org>
parents:
49600
diff
changeset
|
3594 /* If we restart the loop, we should not come here again |
4d74ea083bd2
(Fformat): Use a copy of FORMAT string so that we can
Kenichi Handa <handa@m17n.org>
parents:
49600
diff
changeset
|
3595 because args[n] is now a string and calling |
4d74ea083bd2
(Fformat): Use a copy of FORMAT string so that we can
Kenichi Handa <handa@m17n.org>
parents:
49600
diff
changeset
|
3596 Fprin1_to_string on it produces superflous double |
4d74ea083bd2
(Fformat): Use a copy of FORMAT string so that we can
Kenichi Handa <handa@m17n.org>
parents:
49600
diff
changeset
|
3597 quotes. So, change "%S" to "%s" now. */ |
4d74ea083bd2
(Fformat): Use a copy of FORMAT string so that we can
Kenichi Handa <handa@m17n.org>
parents:
49600
diff
changeset
|
3598 *format = 's'; |
305 | 3599 goto string; |
3600 } | |
9163
41fe5f636879
(lisp_time_argument, Finsert, Finsert_and_inherit, Finsert_before_markers,
Karl Heuer <kwzh@gnu.org>
parents:
9154
diff
changeset
|
3601 else if (SYMBOLP (args[n])) |
305 | 3602 { |
46447
8e01c92219ab
(Fstring_to_char): Don't use XSTRING/XSETSTRING to copy a lisp value.
Ken Raeburn <raeburn@raeburn.org>
parents:
46443
diff
changeset
|
3603 args[n] = SYMBOL_NAME (args[n]); |
20861
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
3604 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
|
3605 { |
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
3606 multibyte = 1; |
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
3607 goto retry; |
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
3608 } |
305 | 3609 goto string; |
3610 } | |
9163
41fe5f636879
(lisp_time_argument, Finsert, Finsert_and_inherit, Finsert_before_markers,
Karl Heuer <kwzh@gnu.org>
parents:
9154
diff
changeset
|
3611 else if (STRINGP (args[n])) |
305 | 3612 { |
3613 string: | |
6528
d0f6a386b7cb
(Fformat): Validate number and type of arguments.
Karl Heuer <kwzh@gnu.org>
parents:
6206
diff
changeset
|
3614 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
|
3615 error ("Format specifier doesn't match argument type"); |
48764
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3616 /* In the case (PRECISION[N] > 0), THISSIZE may not need |
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3617 to be as large as is calculated here. Easy check for |
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3618 the case PRECISION = 0. */ |
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3619 thissize = precision[n] ? CONVERTED_BYTE_SIZE (multibyte, args[n]) : 0; |
42484
717eee813b2c
(Fformat): Update thissize from field_width
Richard M. Stallman <rms@gnu.org>
parents:
42116
diff
changeset
|
3620 actual_width = lisp_string_width (args[n], -1, NULL, NULL); |
305 | 3621 } |
3622 /* 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
|
3623 else if (INTEGERP (args[n]) && *format != 's') |
305 | 3624 { |
3591
507f64624555
Apply typo patches from Paul Eggert.
Jim Blandy <jimb@redhat.com>
parents:
3522
diff
changeset
|
3625 /* The following loop assumes the Lisp type indicates |
305 | 3626 the proper way to pass the argument. |
3627 So make sure we have a flonum if the argument should | |
3628 be a double. */ | |
3629 if (*format == 'e' || *format == 'f' || *format == 'g') | |
3630 args[n] = Ffloat (args[n]); | |
23326
df3f641c9ca1
(Fformat): Check format control characters.
Kenichi Handa <handa@m17n.org>
parents:
23292
diff
changeset
|
3631 else |
df3f641c9ca1
(Fformat): Check format control characters.
Kenichi Handa <handa@m17n.org>
parents:
23292
diff
changeset
|
3632 if (*format != 'd' && *format != 'o' && *format != 'x' |
24505 | 3633 && *format != 'i' && *format != 'X' && *format != 'c') |
23326
df3f641c9ca1
(Fformat): Check format control characters.
Kenichi Handa <handa@m17n.org>
parents:
23292
diff
changeset
|
3634 error ("Invalid format operation %%%c", *format); |
df3f641c9ca1
(Fformat): Check format control characters.
Kenichi Handa <handa@m17n.org>
parents:
23292
diff
changeset
|
3635 |
30480 | 3636 thissize = 30; |
49285
7ec1335b6d36
(Fformat): Convert an unibyte char argument that is
Kenichi Handa <handa@m17n.org>
parents:
48908
diff
changeset
|
3637 if (*format == 'c') |
21064
90bdbe2754c8
(Fformat): Format multibyte characters by "%c"
Kenichi Handa <handa@m17n.org>
parents:
21052
diff
changeset
|
3638 { |
89483 | 3639 if (! ASCII_CHAR_P (XINT (args[n])) |
49472
3fd3c5521557
(Fformat): Add comment about the treatment of 0 as a multibyte
Kenichi Handa <handa@m17n.org>
parents:
49443
diff
changeset
|
3640 /* Note: No one can remeber why we have to treat |
3fd3c5521557
(Fformat): Add comment about the treatment of 0 as a multibyte
Kenichi Handa <handa@m17n.org>
parents:
49443
diff
changeset
|
3641 the character 0 as a multibyte character here. |
3fd3c5521557
(Fformat): Add comment about the treatment of 0 as a multibyte
Kenichi Handa <handa@m17n.org>
parents:
49443
diff
changeset
|
3642 But, until it causes a real problem, let's |
3fd3c5521557
(Fformat): Add comment about the treatment of 0 as a multibyte
Kenichi Handa <handa@m17n.org>
parents:
49443
diff
changeset
|
3643 don't change it. */ |
49285
7ec1335b6d36
(Fformat): Convert an unibyte char argument that is
Kenichi Handa <handa@m17n.org>
parents:
48908
diff
changeset
|
3644 || XINT (args[n]) == 0) |
21064
90bdbe2754c8
(Fformat): Format multibyte characters by "%c"
Kenichi Handa <handa@m17n.org>
parents:
21052
diff
changeset
|
3645 { |
49285
7ec1335b6d36
(Fformat): Convert an unibyte char argument that is
Kenichi Handa <handa@m17n.org>
parents:
48908
diff
changeset
|
3646 if (! multibyte) |
7ec1335b6d36
(Fformat): Convert an unibyte char argument that is
Kenichi Handa <handa@m17n.org>
parents:
48908
diff
changeset
|
3647 { |
7ec1335b6d36
(Fformat): Convert an unibyte char argument that is
Kenichi Handa <handa@m17n.org>
parents:
48908
diff
changeset
|
3648 multibyte = 1; |
7ec1335b6d36
(Fformat): Convert an unibyte char argument that is
Kenichi Handa <handa@m17n.org>
parents:
48908
diff
changeset
|
3649 goto retry; |
7ec1335b6d36
(Fformat): Convert an unibyte char argument that is
Kenichi Handa <handa@m17n.org>
parents:
48908
diff
changeset
|
3650 } |
7ec1335b6d36
(Fformat): Convert an unibyte char argument that is
Kenichi Handa <handa@m17n.org>
parents:
48908
diff
changeset
|
3651 args[n] = Fchar_to_string (args[n]); |
7ec1335b6d36
(Fformat): Convert an unibyte char argument that is
Kenichi Handa <handa@m17n.org>
parents:
48908
diff
changeset
|
3652 thissize = SBYTES (args[n]); |
21064
90bdbe2754c8
(Fformat): Format multibyte characters by "%c"
Kenichi Handa <handa@m17n.org>
parents:
21052
diff
changeset
|
3653 } |
49285
7ec1335b6d36
(Fformat): Convert an unibyte char argument that is
Kenichi Handa <handa@m17n.org>
parents:
48908
diff
changeset
|
3654 else if (! ASCII_BYTE_P (XINT (args[n])) && multibyte) |
7ec1335b6d36
(Fformat): Convert an unibyte char argument that is
Kenichi Handa <handa@m17n.org>
parents:
48908
diff
changeset
|
3655 { |
7ec1335b6d36
(Fformat): Convert an unibyte char argument that is
Kenichi Handa <handa@m17n.org>
parents:
48908
diff
changeset
|
3656 args[n] |
7ec1335b6d36
(Fformat): Convert an unibyte char argument that is
Kenichi Handa <handa@m17n.org>
parents:
48908
diff
changeset
|
3657 = Fchar_to_string (Funibyte_char_to_multibyte (args[n])); |
7ec1335b6d36
(Fformat): Convert an unibyte char argument that is
Kenichi Handa <handa@m17n.org>
parents:
48908
diff
changeset
|
3658 thissize = SBYTES (args[n]); |
7ec1335b6d36
(Fformat): Convert an unibyte char argument that is
Kenichi Handa <handa@m17n.org>
parents:
48908
diff
changeset
|
3659 } |
21064
90bdbe2754c8
(Fformat): Format multibyte characters by "%c"
Kenichi Handa <handa@m17n.org>
parents:
21052
diff
changeset
|
3660 } |
305 | 3661 } |
9163
41fe5f636879
(lisp_time_argument, Finsert, Finsert_and_inherit, Finsert_before_markers,
Karl Heuer <kwzh@gnu.org>
parents:
9154
diff
changeset
|
3662 else if (FLOATP (args[n]) && *format != 's') |
305 | 3663 { |
3664 if (! (*format == 'e' || *format == 'f' || *format == 'g')) | |
48020
7ac7ca5ac550
(Fformat): Detect invalid format letters for floats.
Richard M. Stallman <rms@gnu.org>
parents:
47763
diff
changeset
|
3665 { |
7ac7ca5ac550
(Fformat): Detect invalid format letters for floats.
Richard M. Stallman <rms@gnu.org>
parents:
47763
diff
changeset
|
3666 if (*format != 'd' && *format != 'o' && *format != 'x' |
7ac7ca5ac550
(Fformat): Detect invalid format letters for floats.
Richard M. Stallman <rms@gnu.org>
parents:
47763
diff
changeset
|
3667 && *format != 'i' && *format != 'X' && *format != 'c') |
7ac7ca5ac550
(Fformat): Detect invalid format letters for floats.
Richard M. Stallman <rms@gnu.org>
parents:
47763
diff
changeset
|
3668 error ("Invalid format operation %%%c", *format); |
7ac7ca5ac550
(Fformat): Detect invalid format letters for floats.
Richard M. Stallman <rms@gnu.org>
parents:
47763
diff
changeset
|
3669 args[n] = Ftruncate (args[n], Qnil); |
7ac7ca5ac550
(Fformat): Detect invalid format letters for floats.
Richard M. Stallman <rms@gnu.org>
parents:
47763
diff
changeset
|
3670 } |
34566
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3671 |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3672 /* Note that we're using sprintf to print floats, |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3673 so we have to take into account what that function |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3674 prints. */ |
48782
b02bdb795a5c
(Fformat): Use alloca, not _alloca.
Juanma Barranquero <lekktu@gmail.com>
parents:
48781
diff
changeset
|
3675 /* Filter out flag value of -1. */ |
48908 | 3676 thissize = (MAX_10_EXP + 100 |
3677 + (precision[n] > 0 ? precision[n] : 0)); | |
305 | 3678 } |
3679 else | |
3680 { | |
3681 /* Anything but a string, convert to a string using princ. */ | |
3682 register Lisp_Object tem; | |
3683 tem = Fprin1_to_string (args[n], Qt); | |
53541
41ceb9298a4e
(Fformat): Fix '&' to '&&'.
Kenichi Handa <handa@m17n.org>
parents:
52451
diff
changeset
|
3684 if (STRING_MULTIBYTE (tem) && ! multibyte) |
20826
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3685 { |
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3686 multibyte = 1; |
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3687 goto retry; |
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3688 } |
305 | 3689 args[n] = tem; |
3690 goto string; | |
3691 } | |
30480 | 3692 |
42484
717eee813b2c
(Fformat): Update thissize from field_width
Richard M. Stallman <rms@gnu.org>
parents:
42116
diff
changeset
|
3693 thissize += max (0, field_width - actual_width); |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3694 total += thissize + 4; |
305 | 3695 } |
3696 | |
50746
2a57a6e6b390
(Fformat): Set abort_on_gc during first scan of format.
Richard M. Stallman <rms@gnu.org>
parents:
50555
diff
changeset
|
3697 abort_on_gc--; |
2a57a6e6b390
(Fformat): Set abort_on_gc during first scan of format.
Richard M. Stallman <rms@gnu.org>
parents:
50555
diff
changeset
|
3698 |
20826
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3699 /* 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
|
3700 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
|
3701 |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3702 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
|
3703 |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3704 /* 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
|
3705 Note that TOTAL is an overestimate. */ |
56194
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
3706 SAFE_ALLOCA (buf, char *, total); |
4019
0463aae99f4e
* editfns.c (Fformat): Since floats occupy two elements in the
Jim Blandy <jimb@redhat.com>
parents:
3776
diff
changeset
|
3707 |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3708 p = buf; |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3709 nchars = 0; |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3710 n = 0; |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3711 |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3712 /* Scan the format and store result in BUF. */ |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
3713 format = SDATA (args[0]); |
50746
2a57a6e6b390
(Fformat): Set abort_on_gc during first scan of format.
Richard M. Stallman <rms@gnu.org>
parents:
50555
diff
changeset
|
3714 format_start = format; |
2a57a6e6b390
(Fformat): Set abort_on_gc during first scan of format.
Richard M. Stallman <rms@gnu.org>
parents:
50555
diff
changeset
|
3715 end = format + SBYTES (args[0]); |
22698
ea6ef56295b4
(Fformat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents:
22669
diff
changeset
|
3716 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
|
3717 while (format != end) |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3718 { |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3719 if (*format == '%') |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3720 { |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3721 int minlen; |
21225
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3722 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
|
3723 unsigned char *this_format_start = format; |
305 | 3724 |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3725 discarded[format - format_start] = 1; |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3726 format++; |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3727 |
53687
4f06a8a0e7a6
For `format', make source and documentation match.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53541
diff
changeset
|
3728 while (index("-0# ", *format)) |
4f06a8a0e7a6
For `format', make source and documentation match.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53541
diff
changeset
|
3729 { |
4f06a8a0e7a6
For `format', make source and documentation match.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53541
diff
changeset
|
3730 if (*format == '-') |
4f06a8a0e7a6
For `format', make source and documentation match.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53541
diff
changeset
|
3731 { |
4f06a8a0e7a6
For `format', make source and documentation match.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53541
diff
changeset
|
3732 negative = 1; |
4f06a8a0e7a6
For `format', make source and documentation match.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53541
diff
changeset
|
3733 } |
4f06a8a0e7a6
For `format', make source and documentation match.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53541
diff
changeset
|
3734 discarded[format - format_start] = 1; |
4f06a8a0e7a6
For `format', make source and documentation match.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53541
diff
changeset
|
3735 ++format; |
4f06a8a0e7a6
For `format', make source and documentation match.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53541
diff
changeset
|
3736 } |
4f06a8a0e7a6
For `format', make source and documentation match.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53541
diff
changeset
|
3737 |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3738 minlen = atoi (format); |
53687
4f06a8a0e7a6
For `format', make source and documentation match.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53541
diff
changeset
|
3739 |
4f06a8a0e7a6
For `format', make source and documentation match.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53541
diff
changeset
|
3740 while ((*format >= '0' && *format <= '9') || *format == '.') |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3741 { |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3742 discarded[format - format_start] = 1; |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3743 format++; |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3744 } |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3745 |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3746 if (*format++ == '%') |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3747 { |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3748 *p++ = '%'; |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3749 nchars++; |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3750 continue; |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3751 } |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3752 |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3753 ++n; |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3754 |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3755 discarded[format - format_start - 1] = 1; |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3756 info[n].start = nchars; |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3757 |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3758 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
|
3759 { |
48764
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3760 /* handle case (precision[n] >= 0) */ |
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3761 |
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3762 int width, padding; |
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3763 int nbytes, start, end; |
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3764 int nchars_string; |
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3765 |
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3766 /* lisp_string_width ignores a precision of 0, but GNU |
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3767 libc functions print 0 characters when the precision |
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3768 is 0. Imitate libc behavior here. Changing |
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3769 lisp_string_width is the right thing, and will be |
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3770 done, but meanwhile we work with it. */ |
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3771 |
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3772 if (precision[n] == 0) |
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3773 width = nchars_string = nbytes = 0; |
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3774 else if (precision[n] > 0) |
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3775 width = lisp_string_width (args[n], precision[n], &nchars_string, &nbytes); |
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3776 else |
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3777 { /* no precision spec given for this argument */ |
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3778 width = lisp_string_width (args[n], -1, NULL, NULL); |
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3779 nbytes = SBYTES (args[n]); |
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3780 nchars_string = SCHARS (args[n]); |
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3781 } |
21225
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3782 |
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3783 /* 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
|
3784 padding = minlen - width; |
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3785 if (! negative) |
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3786 while (padding-- > 0) |
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3787 { |
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3788 *p++ = ' '; |
35461
f0f0e9179ed6
(Fformat): Don't extend text properties from arguments
Gerd Moellmann <gerd@gnu.org>
parents:
35440
diff
changeset
|
3789 ++nchars; |
21225
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3790 } |
305 | 3791 |
35461
f0f0e9179ed6
(Fformat): Don't extend text properties from arguments
Gerd Moellmann <gerd@gnu.org>
parents:
35440
diff
changeset
|
3792 start = nchars; |
48764
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3793 nchars += nchars_string; |
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3794 end = nchars; |
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3795 |
22698
ea6ef56295b4
(Fformat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents:
22669
diff
changeset
|
3796 if (p > buf |
ea6ef56295b4
(Fformat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents:
22669
diff
changeset
|
3797 && multibyte |
22712
6f129ed55108
(Fformat): Replace explicit numeric constants with proper macros.
Kenichi Handa <handa@m17n.org>
parents:
22698
diff
changeset
|
3798 && !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
|
3799 && STRING_MULTIBYTE (args[n]) |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
3800 && !CHAR_HEAD_P (SREF (args[n], 0))) |
22698
ea6ef56295b4
(Fformat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents:
22669
diff
changeset
|
3801 maybe_combine_byte = 1; |
48764
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3802 |
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3803 p += copy_text (SDATA (args[n]), p, |
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3804 nbytes, |
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3805 STRING_MULTIBYTE (args[n]), multibyte); |
305 | 3806 |
21225
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3807 if (negative) |
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3808 while (padding-- > 0) |
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3809 { |
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3810 *p++ = ' '; |
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3811 nchars++; |
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3812 } |
25018 | 3813 |
3814 /* If this argument has text properties, record where | |
3815 in the result string it appears. */ | |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
3816 if (STRING_INTERVALS (args[n])) |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3817 info[n].intervals = arg_intervals = 1; |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3818 } |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3819 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
|
3820 { |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3821 int this_nchars; |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3822 |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3823 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
|
3824 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
|
3825 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
|
3826 |
21202
ef954087e7b9
(Fformat): Properly print floats.
Richard M. Stallman <rms@gnu.org>
parents:
21200
diff
changeset
|
3827 if (INTEGERP (args[n])) |
ef954087e7b9
(Fformat): Properly print floats.
Richard M. Stallman <rms@gnu.org>
parents:
21200
diff
changeset
|
3828 sprintf (p, this_format, XINT (args[n])); |
ef954087e7b9
(Fformat): Properly print floats.
Richard M. Stallman <rms@gnu.org>
parents:
21200
diff
changeset
|
3829 else |
25662
0a7261c1d487
Use XCAR, XCDR, and XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25656
diff
changeset
|
3830 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
|
3831 |
22698
ea6ef56295b4
(Fformat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents:
22669
diff
changeset
|
3832 if (p > buf |
ea6ef56295b4
(Fformat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents:
22669
diff
changeset
|
3833 && multibyte |
22712
6f129ed55108
(Fformat): Replace explicit numeric constants with proper macros.
Kenichi Handa <handa@m17n.org>
parents:
22698
diff
changeset
|
3834 && !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
|
3835 && !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
|
3836 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
|
3837 this_nchars = strlen (p); |
29008
939760ef7379
(Fformat): Be sure to convert 8-bit characters to
Kenichi Handa <handa@m17n.org>
parents:
28545
diff
changeset
|
3838 if (multibyte) |
56194
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
3839 p += str_to_multibyte (p, buf + total - 1 - p, this_nchars); |
29008
939760ef7379
(Fformat): Be sure to convert 8-bit characters to
Kenichi Handa <handa@m17n.org>
parents:
28545
diff
changeset
|
3840 else |
939760ef7379
(Fformat): Be sure to convert 8-bit characters to
Kenichi Handa <handa@m17n.org>
parents:
28545
diff
changeset
|
3841 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
|
3842 nchars += this_nchars; |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3843 } |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3844 |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3845 info[n].end = nchars; |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3846 } |
20861
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
3847 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
|
3848 { |
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
3849 /* Copy a whole multibyte character. */ |
22698
ea6ef56295b4
(Fformat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents:
22669
diff
changeset
|
3850 if (p > buf |
ea6ef56295b4
(Fformat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents:
22669
diff
changeset
|
3851 && multibyte |
22712
6f129ed55108
(Fformat): Replace explicit numeric constants with proper macros.
Kenichi Handa <handa@m17n.org>
parents:
22698
diff
changeset
|
3852 && !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
|
3853 && !CHAR_HEAD_P (*format)) |
22698
ea6ef56295b4
(Fformat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents:
22669
diff
changeset
|
3854 maybe_combine_byte = 1; |
20861
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
3855 *p++ = *format++; |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3856 while (! CHAR_HEAD_P (*format)) |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3857 { |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3858 discarded[format - format_start] = 2; |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3859 *p++ = *format++; |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3860 } |
20861
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
3861 nchars++; |
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
3862 } |
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
3863 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
|
3864 { |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3865 /* 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
|
3866 int len = copy_text (format, p, 1, 0, 1); |
305 | 3867 |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3868 p += len; |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3869 format++; |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3870 nchars++; |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3871 } |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3872 else |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3873 *p++ = *format++, nchars++; |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3874 } |
305 | 3875 |
56194
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
3876 if (p > buf + total) |
34566
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3877 abort (); |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3878 |
22698
ea6ef56295b4
(Fformat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents:
22669
diff
changeset
|
3879 if (maybe_combine_byte) |
ea6ef56295b4
(Fformat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents:
22669
diff
changeset
|
3880 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
|
3881 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
|
3882 |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3883 /* If we allocated BUF with malloc, free it too. */ |
57725
c0675c413aa3
(Fformat): Allocate discarded table with SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
57644
diff
changeset
|
3884 SAFE_FREE (); |
305 | 3885 |
25018 | 3886 /* If the format string has text properties, or any of the string |
3887 arguments has text properties, set up text properties of the | |
3888 result string. */ | |
30480 | 3889 |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3890 if (STRING_INTERVALS (args[0]) || arg_intervals) |
25018 | 3891 { |
3892 Lisp_Object len, new_len, props; | |
3893 struct gcpro gcpro1; | |
30480 | 3894 |
25018 | 3895 /* Add text properties from the format string. */ |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
3896 len = make_number (SCHARS (args[0])); |
25018 | 3897 props = text_property_list (args[0], make_number (0), len, Qnil); |
3898 GCPRO1 (props); | |
30480 | 3899 |
25018 | 3900 if (CONSP (props)) |
3901 { | |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3902 int bytepos = 0, position = 0, translated = 0, argn = 1; |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3903 Lisp_Object list; |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3904 |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3905 /* Adjust the bounds of each text property |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3906 to the proper start and end in the output string. */ |
57076
d2baef38bbd7
(Fformat): Handle format strings with multiple text
Kim F. Storm <storm@cua.dk>
parents:
56560
diff
changeset
|
3907 |
d2baef38bbd7
(Fformat): Handle format strings with multiple text
Kim F. Storm <storm@cua.dk>
parents:
56560
diff
changeset
|
3908 /* Put the positions in PROPS in increasing order, so that |
d2baef38bbd7
(Fformat): Handle format strings with multiple text
Kim F. Storm <storm@cua.dk>
parents:
56560
diff
changeset
|
3909 we can do (effectively) one scan through the position |
d2baef38bbd7
(Fformat): Handle format strings with multiple text
Kim F. Storm <storm@cua.dk>
parents:
56560
diff
changeset
|
3910 space of the format string. */ |
d2baef38bbd7
(Fformat): Handle format strings with multiple text
Kim F. Storm <storm@cua.dk>
parents:
56560
diff
changeset
|
3911 props = Fnreverse (props); |
d2baef38bbd7
(Fformat): Handle format strings with multiple text
Kim F. Storm <storm@cua.dk>
parents:
56560
diff
changeset
|
3912 |
d2baef38bbd7
(Fformat): Handle format strings with multiple text
Kim F. Storm <storm@cua.dk>
parents:
56560
diff
changeset
|
3913 /* BYTEPOS is the byte position in the format string, |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3914 POSITION is the untranslated char position in it, |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3915 TRANSLATED is the translated char position in BUF, |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3916 and ARGN is the number of the next arg we will come to. */ |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3917 for (list = props; CONSP (list); list = XCDR (list)) |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3918 { |
50555
37d227b879ad
(Fformat): Lisp_Object/int mixup.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50499
diff
changeset
|
3919 Lisp_Object item; |
37d227b879ad
(Fformat): Lisp_Object/int mixup.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50499
diff
changeset
|
3920 int pos; |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3921 |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3922 item = XCAR (list); |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3923 |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3924 /* First adjust the property start position. */ |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3925 pos = XINT (XCAR (item)); |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3926 |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3927 /* Advance BYTEPOS, POSITION, TRANSLATED and ARGN |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3928 up to this position. */ |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3929 for (; position < pos; bytepos++) |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3930 { |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3931 if (! discarded[bytepos]) |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3932 position++, translated++; |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3933 else if (discarded[bytepos] == 1) |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3934 { |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3935 position++; |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3936 if (translated == info[argn].start) |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3937 { |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3938 translated += info[argn].end - info[argn].start; |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3939 argn++; |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3940 } |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3941 } |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3942 } |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3943 |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3944 XSETCAR (item, make_number (translated)); |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3945 |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3946 /* Likewise adjust the property end position. */ |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3947 pos = XINT (XCAR (XCDR (item))); |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3948 |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3949 for (; bytepos < pos; bytepos++) |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3950 { |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3951 if (! discarded[bytepos]) |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3952 position++, translated++; |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3953 else if (discarded[bytepos] == 1) |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3954 { |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3955 position++; |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3956 if (translated == info[argn].start) |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3957 { |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3958 translated += info[argn].end - info[argn].start; |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3959 argn++; |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3960 } |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3961 } |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3962 } |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3963 |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3964 XSETCAR (XCDR (item), make_number (translated)); |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3965 } |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3966 |
25018 | 3967 add_text_properties_from_list (val, props, make_number (0)); |
3968 } | |
3969 | |
3970 /* Add text properties from arguments. */ | |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3971 if (arg_intervals) |
25018 | 3972 for (n = 1; n < nargs; ++n) |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3973 if (info[n].intervals) |
25018 | 3974 { |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
3975 len = make_number (SCHARS (args[n])); |
25018 | 3976 new_len = make_number (info[n].end - info[n].start); |
3977 props = text_property_list (args[n], make_number (0), len, Qnil); | |
3978 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
|
3979 /* 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
|
3980 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
|
3981 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
|
3982 make_composition_value_copy (props); |
25018 | 3983 add_text_properties_from_list (val, props, |
3984 make_number (info[n].start)); | |
3985 } | |
3986 | |
3987 UNGCPRO; | |
3988 } | |
3989 | |
20804
14fa73136e64
(CONVERTED_BYTE_SIZE): Fix the logic.
Kenichi Handa <handa@m17n.org>
parents:
20706
diff
changeset
|
3990 return val; |
305 | 3991 } |
3992 | |
3993 Lisp_Object | |
49443
f9f7612c767a
(format2): New function, replaces format1
Richard M. Stallman <rms@gnu.org>
parents:
49293
diff
changeset
|
3994 format2 (string1, arg0, arg1) |
305 | 3995 char *string1; |
49443
f9f7612c767a
(format2): New function, replaces format1
Richard M. Stallman <rms@gnu.org>
parents:
49293
diff
changeset
|
3996 Lisp_Object arg0, arg1; |
305 | 3997 { |
49443
f9f7612c767a
(format2): New function, replaces format1
Richard M. Stallman <rms@gnu.org>
parents:
49293
diff
changeset
|
3998 Lisp_Object args[3]; |
f9f7612c767a
(format2): New function, replaces format1
Richard M. Stallman <rms@gnu.org>
parents:
49293
diff
changeset
|
3999 args[0] = build_string (string1); |
f9f7612c767a
(format2): New function, replaces format1
Richard M. Stallman <rms@gnu.org>
parents:
49293
diff
changeset
|
4000 args[1] = arg0; |
f9f7612c767a
(format2): New function, replaces format1
Richard M. Stallman <rms@gnu.org>
parents:
49293
diff
changeset
|
4001 args[2] = arg1; |
f9f7612c767a
(format2): New function, replaces format1
Richard M. Stallman <rms@gnu.org>
parents:
49293
diff
changeset
|
4002 return Fformat (3, args); |
305 | 4003 } |
4004 | |
4005 DEFUN ("char-equal", Fchar_equal, Schar_equal, 2, 2, 0, | |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
4006 doc: /* Return t if two characters match, optionally ignoring case. |
39966
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
4007 Both arguments must be characters (i.e. integers). |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
4008 Case is ignored if `case-fold-search' is non-nil in the current buffer. */) |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
4009 (c1, c2) |
305 | 4010 register Lisp_Object c1, c2; |
4011 { | |
20688
16c458803c32
(Fchar_equal): Fix case-conversion code.
Richard M. Stallman <rms@gnu.org>
parents:
20606
diff
changeset
|
4012 int i1, i2; |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
4013 CHECK_NUMBER (c1); |
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
4014 CHECK_NUMBER (c2); |
305 | 4015 |
20688
16c458803c32
(Fchar_equal): Fix case-conversion code.
Richard M. Stallman <rms@gnu.org>
parents:
20606
diff
changeset
|
4016 if (XINT (c1) == XINT (c2)) |
305 | 4017 return Qt; |
20688
16c458803c32
(Fchar_equal): Fix case-conversion code.
Richard M. Stallman <rms@gnu.org>
parents:
20606
diff
changeset
|
4018 if (NILP (current_buffer->case_fold_search)) |
16c458803c32
(Fchar_equal): Fix case-conversion code.
Richard M. Stallman <rms@gnu.org>
parents:
20606
diff
changeset
|
4019 return Qnil; |
16c458803c32
(Fchar_equal): Fix case-conversion code.
Richard M. Stallman <rms@gnu.org>
parents:
20606
diff
changeset
|
4020 |
16c458803c32
(Fchar_equal): Fix case-conversion code.
Richard M. Stallman <rms@gnu.org>
parents:
20606
diff
changeset
|
4021 /* Do these in separate statements, |
16c458803c32
(Fchar_equal): Fix case-conversion code.
Richard M. Stallman <rms@gnu.org>
parents:
20606
diff
changeset
|
4022 then compare the variables. |
16c458803c32
(Fchar_equal): Fix case-conversion code.
Richard M. Stallman <rms@gnu.org>
parents:
20606
diff
changeset
|
4023 because of the way DOWNCASE uses temp variables. */ |
89025
1c45126c0974
(Fchar_equal): Fix for the unibyte case.
Kenichi Handa <handa@m17n.org>
parents:
89009
diff
changeset
|
4024 i1 = XFASTINT (c1); |
1c45126c0974
(Fchar_equal): Fix for the unibyte case.
Kenichi Handa <handa@m17n.org>
parents:
89009
diff
changeset
|
4025 if (NILP (current_buffer->enable_multibyte_characters) |
1c45126c0974
(Fchar_equal): Fix for the unibyte case.
Kenichi Handa <handa@m17n.org>
parents:
89009
diff
changeset
|
4026 && ! ASCII_CHAR_P (i1)) |
1c45126c0974
(Fchar_equal): Fix for the unibyte case.
Kenichi Handa <handa@m17n.org>
parents:
89009
diff
changeset
|
4027 { |
1c45126c0974
(Fchar_equal): Fix for the unibyte case.
Kenichi Handa <handa@m17n.org>
parents:
89009
diff
changeset
|
4028 MAKE_CHAR_MULTIBYTE (i1); |
1c45126c0974
(Fchar_equal): Fix for the unibyte case.
Kenichi Handa <handa@m17n.org>
parents:
89009
diff
changeset
|
4029 } |
1c45126c0974
(Fchar_equal): Fix for the unibyte case.
Kenichi Handa <handa@m17n.org>
parents:
89009
diff
changeset
|
4030 i2 = XFASTINT (c2); |
1c45126c0974
(Fchar_equal): Fix for the unibyte case.
Kenichi Handa <handa@m17n.org>
parents:
89009
diff
changeset
|
4031 if (NILP (current_buffer->enable_multibyte_characters) |
1c45126c0974
(Fchar_equal): Fix for the unibyte case.
Kenichi Handa <handa@m17n.org>
parents:
89009
diff
changeset
|
4032 && ! ASCII_CHAR_P (i2)) |
1c45126c0974
(Fchar_equal): Fix for the unibyte case.
Kenichi Handa <handa@m17n.org>
parents:
89009
diff
changeset
|
4033 { |
1c45126c0974
(Fchar_equal): Fix for the unibyte case.
Kenichi Handa <handa@m17n.org>
parents:
89009
diff
changeset
|
4034 MAKE_CHAR_MULTIBYTE (i2); |
1c45126c0974
(Fchar_equal): Fix for the unibyte case.
Kenichi Handa <handa@m17n.org>
parents:
89009
diff
changeset
|
4035 } |
1c45126c0974
(Fchar_equal): Fix for the unibyte case.
Kenichi Handa <handa@m17n.org>
parents:
89009
diff
changeset
|
4036 i1 = DOWNCASE (i1); |
1c45126c0974
(Fchar_equal): Fix for the unibyte case.
Kenichi Handa <handa@m17n.org>
parents:
89009
diff
changeset
|
4037 i2 = DOWNCASE (i2); |
20688
16c458803c32
(Fchar_equal): Fix case-conversion code.
Richard M. Stallman <rms@gnu.org>
parents:
20606
diff
changeset
|
4038 return (i1 == i2 ? Qt : Qnil); |
305 | 4039 } |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4040 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4041 /* 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
|
4042 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
|
4043 differ in size). |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4044 |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
4045 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
|
4046 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
|
4047 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
|
4048 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
|
4049 |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4050 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
|
4051 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
|
4052 rest untouched. Most of this is copied from adjust_markers in insdel.c. |
30480 | 4053 |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
4054 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
|
4055 |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
4056 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
|
4057 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
|
4058 start1_byte, end1_byte, start2_byte, end2_byte) |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4059 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
|
4060 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
|
4061 { |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
4062 register int amt1, amt1_byte, amt2, amt2_byte, diff, diff_byte, mpos; |
51670
beceb827c1ce
(save_excursion_restore, transpose_markers): Update for new types.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
51042
diff
changeset
|
4063 register struct Lisp_Marker *marker; |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4064 |
7862
0b6f46029ea2
(transpose_markers): Allow for gap at start of region.
Karl Heuer <kwzh@gnu.org>
parents:
7710
diff
changeset
|
4065 /* 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
|
4066 if (PT < start1) |
987ab382275c
(Ftranspose_regions): Fix overlays after moving markers.
Karl Heuer <kwzh@gnu.org>
parents:
7506
diff
changeset
|
4067 ; |
987ab382275c
(Ftranspose_regions): Fix overlays after moving markers.
Karl Heuer <kwzh@gnu.org>
parents:
7506
diff
changeset
|
4068 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
|
4069 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
|
4070 PT_BYTE + (end2_byte - end1_byte)); |
7519
987ab382275c
(Ftranspose_regions): Fix overlays after moving markers.
Karl Heuer <kwzh@gnu.org>
parents:
7506
diff
changeset
|
4071 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
|
4072 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
|
4073 (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
|
4074 - (end1_byte - start1_byte))); |
7519
987ab382275c
(Ftranspose_regions): Fix overlays after moving markers.
Karl Heuer <kwzh@gnu.org>
parents:
7506
diff
changeset
|
4075 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
|
4076 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
|
4077 PT_BYTE - (start2_byte - start1_byte)); |
7519
987ab382275c
(Ftranspose_regions): Fix overlays after moving markers.
Karl Heuer <kwzh@gnu.org>
parents:
7506
diff
changeset
|
4078 |
7862
0b6f46029ea2
(transpose_markers): Allow for gap at start of region.
Karl Heuer <kwzh@gnu.org>
parents:
7710
diff
changeset
|
4079 /* 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
|
4080 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
|
4081 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
|
4082 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
|
4083 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
|
4084 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
|
4085 the dirty work to Fmarker_position, below. */ |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4086 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4087 /* The difference between the region's lengths */ |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4088 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
|
4089 diff_byte = (end2_byte - start2_byte) - (end1_byte - start1_byte); |
30480 | 4090 |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4091 /* 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
|
4092 region plus the distance between the regions. */ |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4093 amt1 = (end2 - start2) + (start2 - end1); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4094 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
|
4095 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
|
4096 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
|
4097 |
51670
beceb827c1ce
(save_excursion_restore, transpose_markers): Update for new types.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
51042
diff
changeset
|
4098 for (marker = BUF_MARKERS (current_buffer); marker; marker = marker->next) |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4099 { |
51670
beceb827c1ce
(save_excursion_restore, transpose_markers): Update for new types.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
51042
diff
changeset
|
4100 mpos = marker->bytepos; |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
4101 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
|
4102 { |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
4103 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
|
4104 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
|
4105 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
|
4106 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
|
4107 else |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
4108 mpos -= amt2_byte; |
51670
beceb827c1ce
(save_excursion_restore, transpose_markers): Update for new types.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
51042
diff
changeset
|
4109 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
|
4110 } |
51670
beceb827c1ce
(save_excursion_restore, transpose_markers): Update for new types.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
51042
diff
changeset
|
4111 mpos = marker->charpos; |
7862
0b6f46029ea2
(transpose_markers): Allow for gap at start of region.
Karl Heuer <kwzh@gnu.org>
parents:
7710
diff
changeset
|
4112 if (mpos >= start1 && mpos < end2) |
0b6f46029ea2
(transpose_markers): Allow for gap at start of region.
Karl Heuer <kwzh@gnu.org>
parents:
7710
diff
changeset
|
4113 { |
0b6f46029ea2
(transpose_markers): Allow for gap at start of region.
Karl Heuer <kwzh@gnu.org>
parents:
7710
diff
changeset
|
4114 if (mpos < end1) |
0b6f46029ea2
(transpose_markers): Allow for gap at start of region.
Karl Heuer <kwzh@gnu.org>
parents:
7710
diff
changeset
|
4115 mpos += amt1; |
0b6f46029ea2
(transpose_markers): Allow for gap at start of region.
Karl Heuer <kwzh@gnu.org>
parents:
7710
diff
changeset
|
4116 else if (mpos < start2) |
0b6f46029ea2
(transpose_markers): Allow for gap at start of region.
Karl Heuer <kwzh@gnu.org>
parents:
7710
diff
changeset
|
4117 mpos += diff; |
0b6f46029ea2
(transpose_markers): Allow for gap at start of region.
Karl Heuer <kwzh@gnu.org>
parents:
7710
diff
changeset
|
4118 else |
0b6f46029ea2
(transpose_markers): Allow for gap at start of region.
Karl Heuer <kwzh@gnu.org>
parents:
7710
diff
changeset
|
4119 mpos -= amt2; |
0b6f46029ea2
(transpose_markers): Allow for gap at start of region.
Karl Heuer <kwzh@gnu.org>
parents:
7710
diff
changeset
|
4120 } |
51670
beceb827c1ce
(save_excursion_restore, transpose_markers): Update for new types.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
51042
diff
changeset
|
4121 marker->charpos = mpos; |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4122 } |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4123 } |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4124 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4125 DEFUN ("transpose-regions", Ftranspose_regions, Stranspose_regions, 4, 5, 0, |
55972
db2480202623
(Fuser_login_name, Ffloat_time, Fencode_time, Fcurrent_time_string)
Juanma Barranquero <lekktu@gmail.com>
parents:
55424
diff
changeset
|
4126 doc: /* Transpose region STARTR1 to ENDR1 with STARTR2 to ENDR2. |
39966
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
4127 The regions may not be overlapping, because the size of the buffer is |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
4128 never changed in a transposition. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
4129 |
55972
db2480202623
(Fuser_login_name, Ffloat_time, Fencode_time, Fcurrent_time_string)
Juanma Barranquero <lekktu@gmail.com>
parents:
55424
diff
changeset
|
4130 Optional fifth arg LEAVE-MARKERS, if non-nil, means don't update |
39966
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
4131 any markers that happen to be located in the regions. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
4132 |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
4133 Transposing beyond buffer boundaries is an error. */) |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
4134 (startr1, endr1, startr2, endr2, leave_markers) |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4135 Lisp_Object startr1, endr1, startr2, endr2, leave_markers; |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4136 { |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
4137 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
|
4138 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
|
4139 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
|
4140 unsigned char *start1_addr, *start2_addr, *temp; |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4141 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4142 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
|
4143 cur_intv = BUF_INTERVALS (current_buffer); |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4144 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4145 validate_region (&startr1, &endr1); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4146 validate_region (&startr2, &endr2); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4147 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4148 start1 = XFASTINT (startr1); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4149 end1 = XFASTINT (endr1); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4150 start2 = XFASTINT (startr2); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4151 end2 = XFASTINT (endr2); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4152 gap = GPT; |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4153 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4154 /* Swap the regions if they're reversed. */ |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4155 if (start2 < end1) |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4156 { |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4157 register int glumph = start1; |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4158 start1 = start2; |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4159 start2 = glumph; |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4160 glumph = end1; |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4161 end1 = end2; |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4162 end2 = glumph; |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4163 } |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4164 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4165 len1 = end1 - start1; |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4166 len2 = end2 - start2; |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4167 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4168 if (start2 < end1) |
21245
6cde55b7c9de
Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents:
21235
diff
changeset
|
4169 error ("Transposed regions overlap"); |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4170 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
|
4171 error ("Transposed region has length 0"); |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4172 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4173 /* The possibilities are: |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4174 1. Adjacent (contiguous) regions, or separate but equal regions |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4175 (no, really equal, in this case!), or |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4176 2. Separate regions of unequal size. |
30480 | 4177 |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4178 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
|
4179 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
|
4180 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
|
4181 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
|
4182 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4183 /* 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
|
4184 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
|
4185 around it if necessary. This would be extremely efficient, |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4186 especially considering that people are likely to do |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4187 transpositions near where they are working interactively, which |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4188 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
|
4189 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
|
4190 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
|
4191 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
|
4192 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
|
4193 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
|
4194 |
67bb3bb1b62d
(Ftranspose_regions): Take addresses only after move gap.
Richard M. Stallman <rms@gnu.org>
parents:
7207
diff
changeset
|
4195 /* 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
|
4196 we will operate on. */ |
67bb3bb1b62d
(Ftranspose_regions): Take addresses only after move gap.
Richard M. Stallman <rms@gnu.org>
parents:
7207
diff
changeset
|
4197 if (start1 < gap && gap < end2) |
67bb3bb1b62d
(Ftranspose_regions): Take addresses only after move gap.
Richard M. Stallman <rms@gnu.org>
parents:
7207
diff
changeset
|
4198 { |
67bb3bb1b62d
(Ftranspose_regions): Take addresses only after move gap.
Richard M. Stallman <rms@gnu.org>
parents:
7207
diff
changeset
|
4199 if (gap - start1 < end2 - gap) |
67bb3bb1b62d
(Ftranspose_regions): Take addresses only after move gap.
Richard M. Stallman <rms@gnu.org>
parents:
7207
diff
changeset
|
4200 move_gap (start1); |
67bb3bb1b62d
(Ftranspose_regions): Take addresses only after move gap.
Richard M. Stallman <rms@gnu.org>
parents:
7207
diff
changeset
|
4201 else |
67bb3bb1b62d
(Ftranspose_regions): Take addresses only after move gap.
Richard M. Stallman <rms@gnu.org>
parents:
7207
diff
changeset
|
4202 move_gap (end2); |
67bb3bb1b62d
(Ftranspose_regions): Take addresses only after move gap.
Richard M. Stallman <rms@gnu.org>
parents:
7207
diff
changeset
|
4203 } |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
4204 |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
4205 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
|
4206 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
|
4207 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
|
4208 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
|
4209 |
29008
939760ef7379
(Fformat): Be sure to convert 8-bit characters to
Kenichi Handa <handa@m17n.org>
parents:
28545
diff
changeset
|
4210 #ifdef BYTE_COMBINING_DEBUG |
21245
6cde55b7c9de
Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents:
21235
diff
changeset
|
4211 if (end1 == start2) |
6cde55b7c9de
Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents:
21235
diff
changeset
|
4212 { |
29008
939760ef7379
(Fformat): Be sure to convert 8-bit characters to
Kenichi Handa <handa@m17n.org>
parents:
28545
diff
changeset
|
4213 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
|
4214 len2_byte, start1, start1_byte) |
939760ef7379
(Fformat): Be sure to convert 8-bit characters to
Kenichi Handa <handa@m17n.org>
parents:
28545
diff
changeset
|
4215 || 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
|
4216 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
|
4217 || 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
|
4218 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
|
4219 abort (); |
21245
6cde55b7c9de
Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents:
21235
diff
changeset
|
4220 } |
6cde55b7c9de
Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents:
21235
diff
changeset
|
4221 else |
6cde55b7c9de
Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents:
21235
diff
changeset
|
4222 { |
29008
939760ef7379
(Fformat): Be sure to convert 8-bit characters to
Kenichi Handa <handa@m17n.org>
parents:
28545
diff
changeset
|
4223 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
|
4224 len2_byte, start1, start1_byte) |
939760ef7379
(Fformat): Be sure to convert 8-bit characters to
Kenichi Handa <handa@m17n.org>
parents:
28545
diff
changeset
|
4225 || 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
|
4226 len1_byte, start2, start2_byte) |
939760ef7379
(Fformat): Be sure to convert 8-bit characters to
Kenichi Handa <handa@m17n.org>
parents:
28545
diff
changeset
|
4227 || 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
|
4228 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
|
4229 || 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
|
4230 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
|
4231 abort (); |
21245
6cde55b7c9de
Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents:
21235
diff
changeset
|
4232 } |
29008
939760ef7379
(Fformat): Be sure to convert 8-bit characters to
Kenichi Handa <handa@m17n.org>
parents:
28545
diff
changeset
|
4233 #endif |
939760ef7379
(Fformat): Be sure to convert 8-bit characters to
Kenichi Handa <handa@m17n.org>
parents:
28545
diff
changeset
|
4234 |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4235 /* 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
|
4236 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
|
4237 allocation... interesting. Later, don't fool with it now. */ |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4238 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4239 /* Working without memmove, for portability (sigh), so must be |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4240 careful of overlapping subsections of the array... */ |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4241 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4242 if (end1 == start2) /* adjacent regions */ |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4243 { |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4244 modify_region (current_buffer, start1, end2); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4245 record_change (start1, len1 + len2); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4246 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4247 tmp_interval1 = copy_intervals (cur_intv, start1, len1); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4248 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
|
4249 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
|
4250 Qnil, Qnil); |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4251 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4252 /* 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
|
4253 if (len1_byte < len2_byte) |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4254 { |
56194
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
4255 USE_SAFE_ALLOCA; |
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
4256 |
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
4257 SAFE_ALLOCA (temp, unsigned char *, len2_byte); |
7862
0b6f46029ea2
(transpose_markers): Allow for gap at start of region.
Karl Heuer <kwzh@gnu.org>
parents:
7710
diff
changeset
|
4258 |
0b6f46029ea2
(transpose_markers): Allow for gap at start of region.
Karl Heuer <kwzh@gnu.org>
parents:
7710
diff
changeset
|
4259 /* 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
|
4260 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
|
4261 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
|
4262 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
|
4263 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
|
4264 |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
4265 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
|
4266 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
|
4267 bcopy (temp, start1_addr, len2_byte); |
57725
c0675c413aa3
(Fformat): Allocate discarded table with SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
57644
diff
changeset
|
4268 SAFE_FREE (); |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4269 } |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4270 else |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4271 /* First region not smaller than second. */ |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4272 { |
56194
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
4273 USE_SAFE_ALLOCA; |
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
4274 |
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
4275 SAFE_ALLOCA (temp, unsigned char *, len1_byte); |
23166
6072f28afec9
(Ftranspose_regions): Use BYTE_POS_ADDR to get an
Kenichi Handa <handa@m17n.org>
parents:
23132
diff
changeset
|
4276 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
|
4277 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
|
4278 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
|
4279 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
|
4280 bcopy (temp, start1_addr + len2_byte, len1_byte); |
57725
c0675c413aa3
(Fformat): Allocate discarded table with SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
57644
diff
changeset
|
4281 SAFE_FREE (); |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4282 } |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4283 graft_intervals_into_buffer (tmp_interval1, start1 + len2, |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4284 len1, current_buffer, 0); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4285 graft_intervals_into_buffer (tmp_interval2, start1, |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4286 len2, current_buffer, 0); |
26853
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
4287 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
|
4288 update_compositions (start1 + len2, end2, CHECK_TAIL); |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4289 } |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4290 /* Non-adjacent regions, because end1 != start2, bleagh... */ |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4291 else |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4292 { |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
4293 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
|
4294 |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
4295 if (len1_byte == len2_byte) |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4296 /* Regions are same size, though, how nice. */ |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4297 { |
56194
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
4298 USE_SAFE_ALLOCA; |
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
4299 |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4300 modify_region (current_buffer, start1, end1); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4301 modify_region (current_buffer, start2, end2); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4302 record_change (start1, len1); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4303 record_change (start2, len2); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4304 tmp_interval1 = copy_intervals (cur_intv, start1, len1); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4305 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
|
4306 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
|
4307 Qnil, Qnil); |
192b3ebd108e
(Fcurrent_time_zone): Convert Fmake_list argument to Lisp_Integer.
Richard M. Stallman <rms@gnu.org>
parents:
18661
diff
changeset
|
4308 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
|
4309 Qnil, Qnil); |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4310 |
56194
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
4311 SAFE_ALLOCA (temp, unsigned char *, len1_byte); |
23166
6072f28afec9
(Ftranspose_regions): Use BYTE_POS_ADDR to get an
Kenichi Handa <handa@m17n.org>
parents:
23132
diff
changeset
|
4312 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
|
4313 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
|
4314 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
|
4315 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
|
4316 bcopy (temp, start2_addr, len1_byte); |
57725
c0675c413aa3
(Fformat): Allocate discarded table with SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
57644
diff
changeset
|
4317 SAFE_FREE (); |
56194
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
4318 |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4319 graft_intervals_into_buffer (tmp_interval1, start2, |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4320 len1, current_buffer, 0); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4321 graft_intervals_into_buffer (tmp_interval2, start1, |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4322 len2, current_buffer, 0); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4323 } |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4324 |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
4325 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
|
4326 /* 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
|
4327 { |
56194
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
4328 USE_SAFE_ALLOCA; |
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
4329 |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4330 modify_region (current_buffer, start1, end2); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4331 record_change (start1, (end2 - start1)); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4332 tmp_interval1 = copy_intervals (cur_intv, start1, len1); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4333 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
|
4334 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
|
4335 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
|
4336 Qnil, Qnil); |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4337 |
7250
67bb3bb1b62d
(Ftranspose_regions): Take addresses only after move gap.
Richard M. Stallman <rms@gnu.org>
parents:
7207
diff
changeset
|
4338 /* holds region 2 */ |
56194
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
4339 SAFE_ALLOCA (temp, unsigned char *, len2_byte); |
23166
6072f28afec9
(Ftranspose_regions): Use BYTE_POS_ADDR to get an
Kenichi Handa <handa@m17n.org>
parents:
23132
diff
changeset
|
4340 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
|
4341 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
|
4342 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
|
4343 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
|
4344 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
|
4345 bcopy (temp, start1_addr, len2_byte); |
57725
c0675c413aa3
(Fformat): Allocate discarded table with SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
57644
diff
changeset
|
4346 SAFE_FREE (); |
56194
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
4347 |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4348 graft_intervals_into_buffer (tmp_interval1, end2 - len1, |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4349 len1, current_buffer, 0); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4350 graft_intervals_into_buffer (tmp_interval_mid, start1 + len2, |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4351 len_mid, current_buffer, 0); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4352 graft_intervals_into_buffer (tmp_interval2, start1, |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4353 len2, current_buffer, 0); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4354 } |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4355 else |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4356 /* Second region smaller than first. */ |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4357 { |
56194
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
4358 USE_SAFE_ALLOCA; |
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
4359 |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4360 record_change (start1, (end2 - start1)); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4361 modify_region (current_buffer, start1, end2); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4362 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4363 tmp_interval1 = copy_intervals (cur_intv, start1, len1); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4364 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
|
4365 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
|
4366 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
|
4367 Qnil, Qnil); |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4368 |
7250
67bb3bb1b62d
(Ftranspose_regions): Take addresses only after move gap.
Richard M. Stallman <rms@gnu.org>
parents:
7207
diff
changeset
|
4369 /* holds region 1 */ |
56194
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
4370 SAFE_ALLOCA (temp, unsigned char *, len1_byte); |
23166
6072f28afec9
(Ftranspose_regions): Use BYTE_POS_ADDR to get an
Kenichi Handa <handa@m17n.org>
parents:
23132
diff
changeset
|
4371 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
|
4372 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
|
4373 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
|
4374 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
|
4375 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
|
4376 bcopy (temp, start1_addr + len2_byte + len_mid, len1_byte); |
57725
c0675c413aa3
(Fformat): Allocate discarded table with SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
57644
diff
changeset
|
4377 SAFE_FREE (); |
56194
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
4378 |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4379 graft_intervals_into_buffer (tmp_interval1, end2 - len1, |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4380 len1, current_buffer, 0); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4381 graft_intervals_into_buffer (tmp_interval_mid, start1 + len2, |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4382 len_mid, current_buffer, 0); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4383 graft_intervals_into_buffer (tmp_interval2, start1, |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4384 len2, current_buffer, 0); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4385 } |
26853
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
4386 |
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
4387 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
|
4388 update_compositions (end2 - len1, end2, CHECK_BORDER); |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4389 } |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4390 |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
4391 /* 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
|
4392 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
|
4393 should be organized in some sorted data tree. */ |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4394 if (NILP (leave_markers)) |
7519
987ab382275c
(Ftranspose_regions): Fix overlays after moving markers.
Karl Heuer <kwzh@gnu.org>
parents:
7506
diff
changeset
|
4395 { |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
4396 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
|
4397 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
|
4398 start2_byte, start2_byte + len2_byte); |
54555
b136a4512609
* insdel.c (adjust_markers_for_insert): Call fix_start_end_in_overlays.
Masatake YAMATO <jet@gyve.org>
parents:
54242
diff
changeset
|
4399 fix_start_end_in_overlays (start1, end2); |
7519
987ab382275c
(Ftranspose_regions): Fix overlays after moving markers.
Karl Heuer <kwzh@gnu.org>
parents:
7506
diff
changeset
|
4400 } |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4401 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4402 return Qnil; |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4403 } |
305 | 4404 |
4405 | |
4406 void | |
4407 syms_of_editfns () | |
4408 { | |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
4409 environbuf = 0; |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
4410 |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
4411 Qbuffer_access_fontify_functions |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
4412 = intern ("buffer-access-fontify-functions"); |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
4413 staticpro (&Qbuffer_access_fontify_functions); |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
4414 |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
4415 DEFVAR_LISP ("inhibit-field-text-motion", &Vinhibit_field_text_motion, |
43862
7263004fcb03
(syms_of_editfns): Fix typo.
Juanma Barranquero <lekktu@gmail.com>
parents:
43042
diff
changeset
|
4416 doc: /* Non-nil means text motion commands don't notice fields. */); |
27077
19a664c654ab
(Vinhibit_field_text_motion): New variable.
Gerd Moellmann <gerd@gnu.org>
parents:
26853
diff
changeset
|
4417 Vinhibit_field_text_motion = Qnil; |
19a664c654ab
(Vinhibit_field_text_motion): New variable.
Gerd Moellmann <gerd@gnu.org>
parents:
26853
diff
changeset
|
4418 |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
4419 DEFVAR_LISP ("buffer-access-fontify-functions", |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
4420 &Vbuffer_access_fontify_functions, |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
4421 doc: /* List of functions called by `buffer-substring' to fontify if necessary. |
39966
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
4422 Each function is called with two arguments which specify the range |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
4423 of the buffer being accessed. */); |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
4424 Vbuffer_access_fontify_functions = Qnil; |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
4425 |
14440
e99b3302c154
(syms_of_editfns): Make buffer-access-fontify-functions
Richard M. Stallman <rms@gnu.org>
parents:
14391
diff
changeset
|
4426 { |
e99b3302c154
(syms_of_editfns): Make buffer-access-fontify-functions
Richard M. Stallman <rms@gnu.org>
parents:
14391
diff
changeset
|
4427 Lisp_Object obuf; |
e99b3302c154
(syms_of_editfns): Make buffer-access-fontify-functions
Richard M. Stallman <rms@gnu.org>
parents:
14391
diff
changeset
|
4428 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
|
4429 obuf = Fcurrent_buffer (); |
e99b3302c154
(syms_of_editfns): Make buffer-access-fontify-functions
Richard M. Stallman <rms@gnu.org>
parents:
14391
diff
changeset
|
4430 /* 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
|
4431 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
|
4432 /* 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
|
4433 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
|
4434 Qnil); |
e99b3302c154
(syms_of_editfns): Make buffer-access-fontify-functions
Richard M. Stallman <rms@gnu.org>
parents:
14391
diff
changeset
|
4435 Fset_buffer (obuf); |
e99b3302c154
(syms_of_editfns): Make buffer-access-fontify-functions
Richard M. Stallman <rms@gnu.org>
parents:
14391
diff
changeset
|
4436 } |
e99b3302c154
(syms_of_editfns): Make buffer-access-fontify-functions
Richard M. Stallman <rms@gnu.org>
parents:
14391
diff
changeset
|
4437 |
14220 | 4438 DEFVAR_LISP ("buffer-access-fontified-property", |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
4439 &Vbuffer_access_fontified_property, |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
4440 doc: /* Property which (if non-nil) indicates text has been fontified. |
39966
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
4441 `buffer-substring' need not call the `buffer-access-fontify-functions' |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
4442 functions if all the text being accessed has this property. */); |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
4443 Vbuffer_access_fontified_property = Qnil; |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
4444 |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
4445 DEFVAR_LISP ("system-name", &Vsystem_name, |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
4446 doc: /* The name of the machine Emacs is running on. */); |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
4447 |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
4448 DEFVAR_LISP ("user-full-name", &Vuser_full_name, |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
4449 doc: /* The full name of the user logged in. */); |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
4450 |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
4451 DEFVAR_LISP ("user-login-name", &Vuser_login_name, |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
4452 doc: /* The user's name, taken from environment variables if possible. */); |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
4453 |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
4454 DEFVAR_LISP ("user-real-login-name", &Vuser_real_login_name, |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
4455 doc: /* The user's name, based upon the real uid only. */); |
305 | 4456 |
59644
d8d85276ffed
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
58029
diff
changeset
|
4457 DEFVAR_LISP ("operating-system-release", &Voperating_system_release, |
d8d85276ffed
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
58029
diff
changeset
|
4458 doc: /* The release of the operating system Emacs is running on. */); |
d8d85276ffed
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
58029
diff
changeset
|
4459 |
25833
65cab65c4a28
(Fpropertize): Renamed from Fproperties.
Gerd Moellmann <gerd@gnu.org>
parents:
25815
diff
changeset
|
4460 defsubr (&Spropertize); |
305 | 4461 defsubr (&Schar_equal); |
4462 defsubr (&Sgoto_char); | |
4463 defsubr (&Sstring_to_char); | |
4464 defsubr (&Schar_to_string); | |
4465 defsubr (&Sbuffer_substring); | |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
4466 defsubr (&Sbuffer_substring_no_properties); |
305 | 4467 defsubr (&Sbuffer_string); |
4468 | |
4469 defsubr (&Spoint_marker); | |
4470 defsubr (&Smark_marker); | |
4471 defsubr (&Spoint); | |
4472 defsubr (&Sregion_beginning); | |
4473 defsubr (&Sregion_end); | |
20861
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
4474 |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
4475 staticpro (&Qfield); |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
4476 Qfield = intern ("field"); |
30439
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
4477 staticpro (&Qboundary); |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
4478 Qboundary = intern ("boundary"); |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
4479 defsubr (&Sfield_beginning); |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
4480 defsubr (&Sfield_end); |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
4481 defsubr (&Sfield_string); |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
4482 defsubr (&Sfield_string_no_properties); |
26347
7fd9f4ecdd29
(Fdelete_field): Renamed from Ferase_field.
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
4483 defsubr (&Sdelete_field); |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
4484 defsubr (&Sconstrain_to_field); |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
4485 |
20861
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
4486 defsubr (&Sline_beginning_position); |
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
4487 defsubr (&Sline_end_position); |
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
4488 |
305 | 4489 /* defsubr (&Smark); */ |
4490 /* defsubr (&Sset_mark); */ | |
4491 defsubr (&Ssave_excursion); | |
16298
17304eb73f97
(Fsave_current_buffer): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16269
diff
changeset
|
4492 defsubr (&Ssave_current_buffer); |
305 | 4493 |
4494 defsubr (&Sbufsize); | |
4495 defsubr (&Spoint_max); | |
4496 defsubr (&Spoint_min); | |
4497 defsubr (&Spoint_min_marker); | |
4498 defsubr (&Spoint_max_marker); | |
21821
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
4499 defsubr (&Sgap_position); |
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
4500 defsubr (&Sgap_size); |
20861
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
4501 defsubr (&Sposition_bytes); |
22645
e5b201634497
(Fbyte_to_position): New function.
Richard M. Stallman <rms@gnu.org>
parents:
22199
diff
changeset
|
4502 defsubr (&Sbyte_to_position); |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
4503 |
305 | 4504 defsubr (&Sbobp); |
4505 defsubr (&Seobp); | |
4506 defsubr (&Sbolp); | |
4507 defsubr (&Seolp); | |
512 | 4508 defsubr (&Sfollowing_char); |
4509 defsubr (&Sprevious_char); | |
305 | 4510 defsubr (&Schar_after); |
17031 | 4511 defsubr (&Schar_before); |
305 | 4512 defsubr (&Sinsert); |
4513 defsubr (&Sinsert_before_markers); | |
4714
350231e38e68
(Finsert_and_inherit): New function.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
4514 defsubr (&Sinsert_and_inherit); |
350231e38e68
(Finsert_and_inherit): New function.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
4515 defsubr (&Sinsert_and_inherit_before_markers); |
305 | 4516 defsubr (&Sinsert_char); |
89034
63f566c131d7
(Finsert_byte): New function.
Kenichi Handa <handa@m17n.org>
parents:
89025
diff
changeset
|
4517 defsubr (&Sinsert_byte); |
305 | 4518 |
4519 defsubr (&Suser_login_name); | |
4520 defsubr (&Suser_real_login_name); | |
4521 defsubr (&Suser_uid); | |
4522 defsubr (&Suser_real_uid); | |
4523 defsubr (&Suser_full_name); | |
5373
a70b89d2d6bb
(Femacs_pid): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5242
diff
changeset
|
4524 defsubr (&Semacs_pid); |
448 | 4525 defsubr (&Scurrent_time); |
57987
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
4526 defsubr (&Sget_internal_run_time); |
9154
b4739bcefc44
(Fformat_time_string): Mostly rewritten, to handle
Richard M. Stallman <rms@gnu.org>
parents:
8981
diff
changeset
|
4527 defsubr (&Sformat_time_string); |
30480 | 4528 defsubr (&Sfloat_time); |
9801
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
4529 defsubr (&Sdecode_time); |
11402
66d935214d8e
(Fencode_time): Use XINT to examine `zone'.
Richard M. Stallman <rms@gnu.org>
parents:
11263
diff
changeset
|
4530 defsubr (&Sencode_time); |
305 | 4531 defsubr (&Scurrent_time_string); |
962
3533821d6edc
* editfns.c (Fcurrent_time_zone): Doc fix.
Jim Blandy <jimb@redhat.com>
parents:
690
diff
changeset
|
4532 defsubr (&Scurrent_time_zone); |
13019
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
4533 defsubr (&Sset_time_zone_rule); |
305 | 4534 defsubr (&Ssystem_name); |
4535 defsubr (&Smessage); | |
8975
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
4536 defsubr (&Smessage_box); |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
4537 defsubr (&Smessage_or_box); |
18937
ddb91108a9d2
(Fcurrent_message): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18756
diff
changeset
|
4538 defsubr (&Scurrent_message); |
305 | 4539 defsubr (&Sformat); |
4540 | |
4541 defsubr (&Sinsert_buffer_substring); | |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
4542 defsubr (&Scompare_buffer_substrings); |
305 | 4543 defsubr (&Ssubst_char_in_region); |
57644
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
4544 defsubr (&Stranslate_region_internal); |
305 | 4545 defsubr (&Sdelete_region); |
26742
936b39bd05b4
* editfns.c (Fdelete_and_extract_region): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
26699
diff
changeset
|
4546 defsubr (&Sdelete_and_extract_region); |
305 | 4547 defsubr (&Swiden); |
4548 defsubr (&Snarrow_to_region); | |
4549 defsubr (&Ssave_restriction); | |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4550 defsubr (&Stranspose_regions); |
305 | 4551 } |
52401 | 4552 |
4553 /* arch-tag: fc3827d8-6f60-4067-b11e-c3218031b018 | |
4554 (do not change this comment) */ |