Mercurial > emacs
annotate src/editfns.c @ 61402:b2be03118df9
*** empty log message ***
author | Kim F. Storm <storm@cua.dk> |
---|---|
date | Fri, 08 Apr 2005 23:32:54 +0000 |
parents | 595361160197 |
children | 8a54ce1fae6a 4da4a09e8b1b |
rev | line source |
---|---|
305 | 1 /* Lisp functions pertaining to editing. |
61017
595361160197
(Fgoto_char): Fix docstring. Probably left-over from Emacs-20.1.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
59662
diff
changeset
|
2 Copyright (C) 1985, 1986, 1987, 1989, 1993, 1994, 1995, 1996, 1997, 1998, |
595361160197
(Fgoto_char): Fix docstring. Probably left-over from Emacs-20.1.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
59662
diff
changeset
|
3 1999, 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc. |
305 | 4 |
5 This file is part of GNU Emacs. | |
6 | |
7 GNU Emacs is free software; you can redistribute it and/or modify | |
8 it under the terms of the GNU General Public License as published by | |
12244 | 9 the Free Software Foundation; either version 2, or (at your option) |
305 | 10 any later version. |
11 | |
12 GNU Emacs is distributed in the hope that it will be useful, | |
13 but WITHOUT ANY WARRANTY; without even the implied warranty of | |
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
15 GNU General Public License for more details. | |
16 | |
17 You should have received a copy of the GNU General Public License | |
18 along with GNU Emacs; see the file COPYING. If not, write to | |
14862 | 19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
20 Boston, MA 02111-1307, USA. */ | |
305 | 21 |
22 | |
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
parents:
26058
diff
changeset
|
23 #include <config.h> |
2962
79314d830f7d
* editfns.c: #include <sys/types.h>, to get time_t for Eggert's
Jim Blandy <jimb@redhat.com>
parents:
2921
diff
changeset
|
24 #include <sys/types.h> |
58029
46a652255057
Move #include "systime.h" before <sys/resource.h>.
Eli Zaretskii <eliz@gnu.org>
parents:
58011
diff
changeset
|
25 #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
|
26 |
372 | 27 #ifdef VMS |
577 | 28 #include "vms-pwd.h" |
372 | 29 #else |
305 | 30 #include <pwd.h> |
372 | 31 #endif |
32 | |
21514 | 33 #ifdef HAVE_UNISTD_H |
34 #include <unistd.h> | |
35 #endif | |
36 | |
59644
d8d85276ffed
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
58029
diff
changeset
|
37 #ifdef HAVE_SYS_UTSNAME_H |
d8d85276ffed
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
58029
diff
changeset
|
38 #include <sys/utsname.h> |
d8d85276ffed
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
58029
diff
changeset
|
39 #endif |
d8d85276ffed
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
58029
diff
changeset
|
40 |
58029
46a652255057
Move #include "systime.h" before <sys/resource.h>.
Eli Zaretskii <eliz@gnu.org>
parents:
58011
diff
changeset
|
41 /* 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
|
42 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
|
43 <sys/resource.h> */ |
46a652255057
Move #include "systime.h" before <sys/resource.h>.
Eli Zaretskii <eliz@gnu.org>
parents:
58011
diff
changeset
|
44 #include "systime.h" |
58011
79614f2016d5
editfns.c: Adding in better patch
Steven Tamm <steventamm@mac.com>
parents:
58010
diff
changeset
|
45 |
79614f2016d5
editfns.c: Adding in better patch
Steven Tamm <steventamm@mac.com>
parents:
58010
diff
changeset
|
46 #if defined HAVE_SYS_RESOURCE_H |
57987
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
47 #include <sys/resource.h> |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
48 #endif |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
49 |
40699
d51d2fa675d0
Move the include of ctype.h after unistd.h.
Richard M. Stallman <rms@gnu.org>
parents:
40656
diff
changeset
|
50 #include <ctype.h> |
d51d2fa675d0
Move the include of ctype.h after unistd.h.
Richard M. Stallman <rms@gnu.org>
parents:
40656
diff
changeset
|
51 |
305 | 52 #include "lisp.h" |
1285
d50533e23dff
* editfns.c (make_buffer_string): Call copy_intervals_to_string().
Joseph Arceneaux <jla@gnu.org>
parents:
1254
diff
changeset
|
53 #include "intervals.h" |
305 | 54 #include "buffer.h" |
17031 | 55 #include "charset.h" |
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
parents:
26058
diff
changeset
|
56 #include "coding.h" |
38059
0b34b024286d
(Fmessage_box): If the frame is not under a window
Eli Zaretskii <eliz@gnu.org>
parents:
37916
diff
changeset
|
57 #include "frame.h" |
305 | 58 #include "window.h" |
59 | |
38519
200c049178cc
(toplevel) [STDC_HEADERS]: Include float.h.
Gerd Moellmann <gerd@gnu.org>
parents:
38059
diff
changeset
|
60 #ifdef STDC_HEADERS |
200c049178cc
(toplevel) [STDC_HEADERS]: Include float.h.
Gerd Moellmann <gerd@gnu.org>
parents:
38059
diff
changeset
|
61 #include <float.h> |
200c049178cc
(toplevel) [STDC_HEADERS]: Include float.h.
Gerd Moellmann <gerd@gnu.org>
parents:
38059
diff
changeset
|
62 #define MAX_10_EXP DBL_MAX_10_EXP |
200c049178cc
(toplevel) [STDC_HEADERS]: Include float.h.
Gerd Moellmann <gerd@gnu.org>
parents:
38059
diff
changeset
|
63 #else |
200c049178cc
(toplevel) [STDC_HEADERS]: Include float.h.
Gerd Moellmann <gerd@gnu.org>
parents:
38059
diff
changeset
|
64 #define MAX_10_EXP 310 |
200c049178cc
(toplevel) [STDC_HEADERS]: Include float.h.
Gerd Moellmann <gerd@gnu.org>
parents:
38059
diff
changeset
|
65 #endif |
200c049178cc
(toplevel) [STDC_HEADERS]: Include float.h.
Gerd Moellmann <gerd@gnu.org>
parents:
38059
diff
changeset
|
66 |
19441
2e2b54ae9b9d
(NULL): Define, if not defined.
Richard M. Stallman <rms@gnu.org>
parents:
19416
diff
changeset
|
67 #ifndef NULL |
2e2b54ae9b9d
(NULL): Define, if not defined.
Richard M. Stallman <rms@gnu.org>
parents:
19416
diff
changeset
|
68 #define NULL 0 |
2e2b54ae9b9d
(NULL): Define, if not defined.
Richard M. Stallman <rms@gnu.org>
parents:
19416
diff
changeset
|
69 #endif |
2e2b54ae9b9d
(NULL): Define, if not defined.
Richard M. Stallman <rms@gnu.org>
parents:
19416
diff
changeset
|
70 |
31095
e19d38e14720
[USE_CRT_DLL]: Remove unnecessary extern, which screws
Andrew Innes <andrewi@gnu.org>
parents:
31016
diff
changeset
|
71 #ifndef USE_CRT_DLL |
13025
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
72 extern char **environ; |
31095
e19d38e14720
[USE_CRT_DLL]: Remove unnecessary extern, which screws
Andrew Innes <andrewi@gnu.org>
parents:
31016
diff
changeset
|
73 #endif |
e19d38e14720
[USE_CRT_DLL]: Remove unnecessary extern, which screws
Andrew Innes <andrewi@gnu.org>
parents:
31016
diff
changeset
|
74 |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
75 extern Lisp_Object make_time P_ ((time_t)); |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
76 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
|
77 const struct tm *, int)); |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
78 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
|
79 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
|
80 static void update_buffer_properties P_ ((int, int)); |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
81 static Lisp_Object region_limit P_ ((int)); |
55193
1b09eb24ab02
(lisp_time_argument): Provide externally.
Eli Zaretskii <eliz@gnu.org>
parents:
54846
diff
changeset
|
82 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
|
83 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
|
84 size_t, const struct tm *, int)); |
46464
e05dd5b81fc7
(general_insert_function): Insertion function now
Ken Raeburn <raeburn@raeburn.org>
parents:
46447
diff
changeset
|
85 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
|
86 void (*) (Lisp_Object, int, int, int, |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
87 int, int), |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
88 int, int, 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 P_ ((Lisp_Object)); |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
90 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
|
91 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
|
92 |
31336 | 93 #ifdef HAVE_INDEX |
94 extern char *index P_ ((const char *, int)); | |
95 #endif | |
96 | |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
97 Lisp_Object Vbuffer_access_fontify_functions; |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
98 Lisp_Object Qbuffer_access_fontify_functions; |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
99 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
|
100 |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
101 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
|
102 |
27077
19a664c654ab
(Vinhibit_field_text_motion): New variable.
Gerd Moellmann <gerd@gnu.org>
parents:
26853
diff
changeset
|
103 /* 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
|
104 |
19a664c654ab
(Vinhibit_field_text_motion): New variable.
Gerd Moellmann <gerd@gnu.org>
parents:
26853
diff
changeset
|
105 Lisp_Object Vinhibit_field_text_motion; |
19a664c654ab
(Vinhibit_field_text_motion): New variable.
Gerd Moellmann <gerd@gnu.org>
parents:
26853
diff
changeset
|
106 |
305 | 107 /* Some static data, and a function to initialize it for each run */ |
108 | |
109 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
|
110 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
|
111 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
|
112 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
|
113 Lisp_Object Voperating_system_release; /* Operating System Release */ |
305 | 114 |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
115 /* Symbol for the text property used to mark fields. */ |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
116 |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
117 Lisp_Object Qfield; |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
118 |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
119 /* A special value for Qfield properties. */ |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
120 |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
121 Lisp_Object Qboundary; |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
122 |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
123 |
305 | 124 void |
125 init_editfns () | |
126 { | |
330 | 127 char *user_name; |
25782
8f59abd3a02b
(init_editfns): Remove unused variables.
Gerd Moellmann <gerd@gnu.org>
parents:
25662
diff
changeset
|
128 register unsigned char *p; |
305 | 129 struct passwd *pw; /* password entry for the current user */ |
130 Lisp_Object tem; | |
131 | |
132 /* 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
|
133 init_system_name (); |
305 | 134 |
135 #ifndef CANNOT_DUMP | |
136 /* Don't bother with this on initial start when just dumping out */ | |
137 if (!initialized) | |
138 return; | |
139 #endif /* not CANNOT_DUMP */ | |
140 | |
141 pw = (struct passwd *) getpwuid (getuid ()); | |
9572 | 142 #ifdef MSDOS |
143 /* We let the real user name default to "root" because that's quite | |
144 accurate on MSDOG and because it lets Emacs find the init file. | |
145 (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
|
146 Vuser_real_login_name = build_string (pw ? pw->pw_name : "root"); |
9572 | 147 #else |
12026
505a894d943e
(syms_of_editfns): user-login-name renamed from user-name.
Karl Heuer <kwzh@gnu.org>
parents:
11912
diff
changeset
|
148 Vuser_real_login_name = build_string (pw ? pw->pw_name : "unknown"); |
9572 | 149 #endif |
305 | 150 |
330 | 151 /* Get the effective user name, by consulting environment variables, |
152 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
|
153 user_name = (char *) getenv ("LOGNAME"); |
330 | 154 if (!user_name) |
9801
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
155 #ifdef WINDOWSNT |
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
156 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
|
157 #else /* WINDOWSNT */ |
5907
5fdb226fe9a4
(init_editfns): Look at LOGNAME before USER.
Karl Heuer <kwzh@gnu.org>
parents:
5884
diff
changeset
|
158 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
|
159 #endif /* WINDOWSNT */ |
305 | 160 if (!user_name) |
330 | 161 { |
162 pw = (struct passwd *) getpwuid (geteuid ()); | |
163 user_name = (char *) (pw ? pw->pw_name : "unknown"); | |
164 } | |
12026
505a894d943e
(syms_of_editfns): user-login-name renamed from user-name.
Karl Heuer <kwzh@gnu.org>
parents:
11912
diff
changeset
|
165 Vuser_login_name = build_string (user_name); |
305 | 166 |
330 | 167 /* If the user name claimed in the environment vars differs from |
168 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
|
169 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
|
170 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
|
171 : Vuser_login_name); |
30480 | 172 |
11447
d51e912495be
(init_editfns): Add casts.
Richard M. Stallman <rms@gnu.org>
parents:
11433
diff
changeset
|
173 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
|
174 if (p) |
9ab21ef32537
(init_editfns): Use NAME envvar to init user-full-name.
Richard M. Stallman <rms@gnu.org>
parents:
10480
diff
changeset
|
175 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
|
176 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
|
177 Vuser_full_name = build_string ("unknown"); |
59644
d8d85276ffed
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
58029
diff
changeset
|
178 |
d8d85276ffed
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
58029
diff
changeset
|
179 #ifdef HAVE_SYS_UTSNAME_H |
d8d85276ffed
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
58029
diff
changeset
|
180 { |
d8d85276ffed
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
58029
diff
changeset
|
181 struct utsname uts; |
d8d85276ffed
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
58029
diff
changeset
|
182 uname (&uts); |
d8d85276ffed
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
58029
diff
changeset
|
183 Voperating_system_release = build_string (uts.release); |
d8d85276ffed
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
58029
diff
changeset
|
184 } |
d8d85276ffed
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
58029
diff
changeset
|
185 #else |
d8d85276ffed
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
58029
diff
changeset
|
186 Voperating_system_release = Qnil; |
d8d85276ffed
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
58029
diff
changeset
|
187 #endif |
305 | 188 } |
189 | |
190 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
|
191 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
|
192 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
|
193 (character) |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
194 Lisp_Object character; |
305 | 195 { |
17031 | 196 int len; |
26853
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
197 unsigned char str[MAX_MULTIBYTE_LENGTH]; |
17031 | 198 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
199 CHECK_NUMBER (character); |
305 | 200 |
35998
5cf8398ba424
(Fchar_to_string): If CHARACTER is less than 256,
Kenichi Handa <handa@m17n.org>
parents:
35845
diff
changeset
|
201 len = (SINGLE_BYTE_CHAR_P (XFASTINT (character)) |
5cf8398ba424
(Fchar_to_string): If CHARACTER is less than 256,
Kenichi Handa <handa@m17n.org>
parents:
35845
diff
changeset
|
202 ? (*str = (unsigned char)(XFASTINT (character)), 1) |
5cf8398ba424
(Fchar_to_string): If CHARACTER is less than 256,
Kenichi Handa <handa@m17n.org>
parents:
35845
diff
changeset
|
203 : char_to_string (XFASTINT (character), str)); |
21257
205a5aa4aa2f
(Fchar_to_string): Use make_string_from_bytes.
Richard M. Stallman <rms@gnu.org>
parents:
21245
diff
changeset
|
204 return make_string_from_bytes (str, 1, len); |
305 | 205 } |
206 | |
207 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
|
208 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
|
209 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
|
210 (string) |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
211 register Lisp_Object string; |
305 | 212 { |
213 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
|
214 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
|
215 if (SCHARS (string)) |
23650
3cc42e65f25b
(Fstring_to_char): Don't return a multibyte character
Kenichi Handa <handa@m17n.org>
parents:
23596
diff
changeset
|
216 { |
3cc42e65f25b
(Fstring_to_char): Don't return a multibyte character
Kenichi Handa <handa@m17n.org>
parents:
23596
diff
changeset
|
217 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
|
218 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
|
219 else |
46443
b612fecce4cc
(Fstring_to_char): Use string macros instead of Lisp_String fields.
Ken Raeburn <raeburn@raeburn.org>
parents:
46370
diff
changeset
|
220 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
|
221 } |
305 | 222 else |
9305
ac077e2a75f1
(Fstring_to_char, Fpoint, Fbufsize, Fpoint_min, Fpoint_max, Ffollowing_char,
Karl Heuer <kwzh@gnu.org>
parents:
9265
diff
changeset
|
223 XSETFASTINT (val, 0); |
305 | 224 return val; |
225 } | |
226 | |
227 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
|
228 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
|
229 int charpos, bytepos; |
305 | 230 { |
231 register Lisp_Object mark; | |
232 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
|
233 set_marker_both (mark, Qnil, charpos, bytepos); |
305 | 234 return mark; |
235 } | |
236 | |
237 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
|
238 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
|
239 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
|
240 () |
305 | 241 { |
242 Lisp_Object temp; | |
16039
855c8d8ba0f0
Change all references from point to PT.
Karl Heuer <kwzh@gnu.org>
parents:
15910
diff
changeset
|
243 XSETFASTINT (temp, PT); |
305 | 244 return temp; |
245 } | |
246 | |
247 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
|
248 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
|
249 () |
305 | 250 { |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
251 return buildmark (PT, PT_BYTE); |
305 | 252 } |
253 | |
254 int | |
255 clip_to_bounds (lower, num, upper) | |
256 int lower, num, upper; | |
257 { | |
258 if (num < lower) | |
259 return lower; | |
260 else if (num > upper) | |
261 return upper; | |
262 else | |
263 return num; | |
264 } | |
265 | |
266 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
|
267 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
|
268 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
|
269 (position) |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
270 register Lisp_Object position; |
305 | 271 { |
17031 | 272 int pos; |
273 | |
21226
c8d0df2cbd3d
(Fgoto_char): If POSITION is a marker pointing a
Richard M. Stallman <rms@gnu.org>
parents:
21225
diff
changeset
|
274 if (MARKERP (position) |
c8d0df2cbd3d
(Fgoto_char): If POSITION is a marker pointing a
Richard M. Stallman <rms@gnu.org>
parents:
21225
diff
changeset
|
275 && 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
|
276 { |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
277 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
|
278 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
|
279 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
|
280 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
|
281 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
|
282 else |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
283 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
|
284 |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
285 return position; |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
286 } |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
287 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
288 CHECK_NUMBER_COERCE_MARKER (position); |
305 | 289 |
17031 | 290 pos = clip_to_bounds (BEGV, XINT (position), ZV); |
291 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
|
292 return position; |
305 | 293 } |
294 | |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
295 |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
296 /* Return the start or end position of the region. |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
297 BEGINNINGP non-zero means return the start. |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
298 If there is no region active, signal an error. */ |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
299 |
305 | 300 static Lisp_Object |
301 region_limit (beginningp) | |
302 int beginningp; | |
303 { | |
4047
e950abdc9ed2
(region_limit): Declare Vmark_even_if_inactive.
Roland McGrath <roland@gnu.org>
parents:
4038
diff
changeset
|
304 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
|
305 Lisp_Object m; |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49472
diff
changeset
|
306 |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
307 if (!NILP (Vtransient_mark_mode) |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
308 && 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
|
309 && 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
|
310 Fsignal (Qmark_inactive, Qnil); |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49472
diff
changeset
|
311 |
305 | 312 m = Fmarker_position (current_buffer->mark); |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
313 if (NILP (m)) |
43042
63639e690611
(region_limit): Nicer error message.
Richard M. Stallman <rms@gnu.org>
parents:
42484
diff
changeset
|
314 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
|
315 |
52451
c7860e5cc982
(region_limit): Support any non-zero value of BEGINNINGP.
Eli Zaretskii <eliz@gnu.org>
parents:
52401
diff
changeset
|
316 if ((PT < XFASTINT (m)) == (beginningp != 0)) |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
317 m = make_number (PT); |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
318 return m; |
305 | 319 } |
320 | |
321 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
|
322 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
|
323 () |
305 | 324 { |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
325 return region_limit (1); |
305 | 326 } |
327 | |
328 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
|
329 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
|
330 () |
305 | 331 { |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
332 return region_limit (0); |
305 | 333 } |
334 | |
335 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
|
336 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
|
337 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
|
338 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
|
339 () |
305 | 340 { |
341 return current_buffer->mark; | |
342 } | |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
343 |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
344 |
48094
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
345 /* 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
|
346 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
|
347 of length LEN. */ |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
348 |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
349 static int |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
350 overlays_around (pos, vec, len) |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
351 int pos; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
352 Lisp_Object *vec; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
353 int len; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
354 { |
51841
59ba1f5d0a16
(overlays_around): Use new type for overlays_(before|after).
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
51670
diff
changeset
|
355 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
|
356 struct Lisp_Overlay *tail; |
48094
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
357 int startpos, endpos; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
358 int idx = 0; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
359 |
51841
59ba1f5d0a16
(overlays_around): Use new type for overlays_(before|after).
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
51670
diff
changeset
|
360 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
|
361 { |
51841
59ba1f5d0a16
(overlays_around): Use new type for overlays_(before|after).
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
51670
diff
changeset
|
362 XSETMISC (overlay, tail); |
48094
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
363 |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
364 end = OVERLAY_END (overlay); |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
365 endpos = OVERLAY_POSITION (end); |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
366 if (endpos < pos) |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
367 break; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
368 start = OVERLAY_START (overlay); |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
369 startpos = OVERLAY_POSITION (start); |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
370 if (startpos <= pos) |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
371 { |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
372 if (idx < len) |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
373 vec[idx] = overlay; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
374 /* 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
|
375 idx++; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
376 } |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
377 } |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
378 |
51841
59ba1f5d0a16
(overlays_around): Use new type for overlays_(before|after).
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
51670
diff
changeset
|
379 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
|
380 { |
51841
59ba1f5d0a16
(overlays_around): Use new type for overlays_(before|after).
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
51670
diff
changeset
|
381 XSETMISC (overlay, tail); |
48094
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
382 |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
383 start = OVERLAY_START (overlay); |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
384 startpos = OVERLAY_POSITION (start); |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
385 if (pos < startpos) |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
386 break; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
387 end = OVERLAY_END (overlay); |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
388 endpos = OVERLAY_POSITION (end); |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
389 if (pos <= endpos) |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
390 { |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
391 if (idx < len) |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
392 vec[idx] = overlay; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
393 idx++; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
394 } |
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 idx; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
398 } |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
399 |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
400 /* 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
|
401 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
|
402 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
|
403 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
|
404 text properties. |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
405 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
|
406 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
|
407 with OBJECT. */ |
48134
ef2b87569c38
(get_pos_property): Don't hardcode Qfield.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48115
diff
changeset
|
408 Lisp_Object |
48094
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
409 get_pos_property (position, prop, object) |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
410 Lisp_Object position, object; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
411 register Lisp_Object prop; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
412 { |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
413 CHECK_NUMBER_COERCE_MARKER (position); |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
414 |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
415 if (NILP (object)) |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
416 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
|
417 else if (WINDOWP (object)) |
edeae7524de9
(get_pos_property): Don't assume that `object' = nil.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50746
diff
changeset
|
418 object = XWINDOW (object)->buffer; |
edeae7524de9
(get_pos_property): Don't assume that `object' = nil.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50746
diff
changeset
|
419 |
edeae7524de9
(get_pos_property): Don't assume that `object' = nil.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50746
diff
changeset
|
420 if (!BUFFERP (object)) |
edeae7524de9
(get_pos_property): Don't assume that `object' = nil.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50746
diff
changeset
|
421 /* 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
|
422 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
|
423 could be obeyed. */ |
edeae7524de9
(get_pos_property): Don't assume that `object' = nil.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50746
diff
changeset
|
424 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
|
425 else |
48094
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
426 { |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
427 int posn = XINT (position); |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
428 int noverlays; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
429 Lisp_Object *overlay_vec, tem; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
430 struct buffer *obuf = current_buffer; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
431 |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
432 set_buffer_temp (XBUFFER (object)); |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
433 |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
434 /* 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
|
435 noverlays = 40; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
436 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
|
437 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
|
438 |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
439 /* If there are more than 40, |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
440 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
|
441 if (noverlays > 40) |
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 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
|
444 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
|
445 } |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
446 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
|
447 |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
448 set_buffer_temp (obuf); |
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 /* 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
|
451 while (--noverlays >= 0) |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
452 { |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
453 Lisp_Object ol = overlay_vec[noverlays]; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
454 tem = Foverlay_get (ol, prop); |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
455 if (!NILP (tem)) |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
456 { |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
457 /* 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
|
458 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
|
459 if ((OVERLAY_POSITION (start) == posn |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
460 && XMARKER (start)->insertion_type == 1) |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
461 || (OVERLAY_POSITION (finish) == posn |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
462 && XMARKER (finish)->insertion_type == 0)) |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
463 ; /* 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
|
464 else |
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 return tem; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
467 } |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
468 } |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
469 } |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49472
diff
changeset
|
470 |
51042
edeae7524de9
(get_pos_property): Don't assume that `object' = nil.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50746
diff
changeset
|
471 { /* 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
|
472 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
|
473 if (stickiness > 0) |
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 (position, prop, object); |
edeae7524de9
(get_pos_property): Don't assume that `object' = nil.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50746
diff
changeset
|
475 else if (stickiness < 0 |
edeae7524de9
(get_pos_property): Don't assume that `object' = nil.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50746
diff
changeset
|
476 && 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
|
477 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
|
478 prop, object); |
edeae7524de9
(get_pos_property): Don't assume that `object' = nil.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50746
diff
changeset
|
479 else |
edeae7524de9
(get_pos_property): Don't assume that `object' = nil.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50746
diff
changeset
|
480 return Qnil; |
edeae7524de9
(get_pos_property): Don't assume that `object' = nil.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50746
diff
changeset
|
481 } |
48094
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
482 } |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
483 } |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
484 |
26389
e2acf63b5403
(Fline_beginning_position): If N is not 1,
Richard M. Stallman <rms@gnu.org>
parents:
26372
diff
changeset
|
485 /* 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
|
486 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
|
487 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
|
488 |
41065
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
489 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
|
490 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
|
491 |
26389
e2acf63b5403
(Fline_beginning_position): If N is not 1,
Richard M. Stallman <rms@gnu.org>
parents:
26372
diff
changeset
|
492 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
|
493 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
|
494 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
|
495 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
|
496 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
|
497 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
|
498 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
|
499 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
|
500 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
|
501 |
e2acf63b5403
(Fline_beginning_position): If N is not 1,
Richard M. Stallman <rms@gnu.org>
parents:
26372
diff
changeset
|
502 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
|
503 is not stored. */ |
e2acf63b5403
(Fline_beginning_position): If N is not 1,
Richard M. Stallman <rms@gnu.org>
parents:
26372
diff
changeset
|
504 |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
505 static void |
41065
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
506 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
|
507 Lisp_Object pos; |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
508 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
|
509 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
|
510 int *beg, *end; |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
511 { |
30439
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
512 /* Fields right before and after the point. */ |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
513 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
|
514 /* 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
|
515 int at_field_start = 0; |
e2acf63b5403
(Fline_beginning_position): If N is not 1,
Richard M. Stallman <rms@gnu.org>
parents:
26372
diff
changeset
|
516 /* 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
|
517 int at_field_end = 0; |
30439
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
518 |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
519 if (NILP (pos)) |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
520 XSETFASTINT (pos, PT); |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
521 else |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
522 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
|
523 |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
524 after_field |
48094
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
525 = get_char_property_and_overlay (pos, Qfield, Qnil, NULL); |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
526 before_field |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
527 = (XFASTINT (pos) > BEGV |
32850 | 528 ? 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
|
529 Qfield, Qnil, NULL) |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
530 : Qnil); |
30439
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
531 |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
532 /* 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
|
533 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
|
534 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
|
535 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
|
536 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
|
537 specially. */ |
48094
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
538 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
|
539 { |
48094
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
540 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
|
541 if (!EQ (field, after_field)) |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
542 at_field_end = 1; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
543 if (!EQ (field, before_field)) |
30439
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
544 at_field_start = 1; |
48111
7103ad01172d
(find_field): Make an exception for nil fields.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48094
diff
changeset
|
545 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
|
546 /* 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
|
547 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
|
548 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
|
549 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
|
550 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
|
551 } |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
552 |
30439
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
553 /* Note about special `boundary' fields: |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
554 |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
555 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
|
556 |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
557 xxxx.yyyy |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
558 |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
559 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
|
560 `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
|
561 of the field is the end of `y'. |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
562 |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
563 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
|
564 (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
|
565 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
|
566 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
|
567 |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
568 xxx.BBBByyyy |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
569 |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
570 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
|
571 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
|
572 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
|
573 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
|
574 |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
575 if (beg) |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
576 { |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
577 if (at_field_start) |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
578 /* 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
|
579 the beginning of the following field. */ |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
580 *beg = XFASTINT (pos); |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
581 else |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
582 /* Find the previous field boundary. */ |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
583 { |
48094
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
584 Lisp_Object p = pos; |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
585 if (!NILP (merge_at_boundary) && EQ (before_field, Qboundary)) |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
586 /* Skip a `boundary' field. */ |
48094
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, |
41065
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
588 beg_limit); |
48094
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
589 |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
590 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
|
591 beg_limit); |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
592 *beg = NILP (p) ? BEGV : XFASTINT (p); |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
593 } |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
594 } |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
595 |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
596 if (end) |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
597 { |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
598 if (at_field_end) |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
599 /* 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
|
600 the end of the previous field. */ |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
601 *end = XFASTINT (pos); |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
602 else |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
603 /* Find the next field boundary. */ |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
604 { |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
605 if (!NILP (merge_at_boundary) && EQ (after_field, Qboundary)) |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
606 /* Skip a `boundary' field. */ |
41065
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); |
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
609 |
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
610 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
|
611 end_limit); |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
612 *end = NILP (pos) ? ZV : XFASTINT (pos); |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
613 } |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
614 } |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
615 } |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
616 |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
617 |
26629
05dcbc266797
(Fdelete_field): Make it noninteractive. Return nil.
Richard M. Stallman <rms@gnu.org>
parents:
26526
diff
changeset
|
618 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
|
619 doc: /* Delete the field surrounding POS. |
39966
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
620 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
|
621 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
|
622 (pos) |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
623 Lisp_Object pos; |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
624 { |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
625 int beg, end; |
41065
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
626 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
|
627 if (beg != end) |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
628 del_range (beg, end); |
26629
05dcbc266797
(Fdelete_field): Make it noninteractive. Return nil.
Richard M. Stallman <rms@gnu.org>
parents:
26526
diff
changeset
|
629 return Qnil; |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
630 } |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
631 |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
632 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
|
633 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
|
634 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
|
635 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
|
636 (pos) |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
637 Lisp_Object pos; |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
638 { |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
639 int beg, end; |
41065
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
640 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
|
641 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
|
642 } |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
643 |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
644 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
|
645 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
|
646 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
|
647 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
|
648 (pos) |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
649 Lisp_Object pos; |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
650 { |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
651 int beg, end; |
41065
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
652 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
|
653 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
|
654 } |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
655 |
41065
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
656 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
|
657 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
|
658 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
|
659 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
|
660 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
|
661 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
|
662 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
|
663 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
|
664 (pos, escape_from_edge, limit) |
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
665 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
|
666 { |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
667 int beg; |
41065
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
668 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
|
669 return make_number (beg); |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
670 } |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
671 |
41065
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
672 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
|
673 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
|
674 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
|
675 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
|
676 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
|
677 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
|
678 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
|
679 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
|
680 (pos, escape_from_edge, limit) |
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
681 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
|
682 { |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
683 int end; |
41065
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
684 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
|
685 return make_number (end); |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
686 } |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
687 |
30439
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
688 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
|
689 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
|
690 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
691 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
|
692 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
|
693 constrained position if that is different. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
694 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
695 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
|
696 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
|
697 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
|
698 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
|
699 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
|
700 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
|
701 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
|
702 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
|
703 also considered to be `on the boundary'. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
704 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
705 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
|
706 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
|
707 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
|
708 \\[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
|
709 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
|
710 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
711 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
|
712 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
|
713 |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
714 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
|
715 (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
|
716 Lisp_Object new_pos, old_pos; |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
717 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
|
718 { |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
719 /* 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
|
720 int orig_point = 0; |
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 if (NILP (new_pos)) |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
723 /* 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
|
724 { |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
725 orig_point = PT; |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
726 XSETFASTINT (new_pos, PT); |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
727 } |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
728 |
27081
f068649f1c28
(Fconstrain_to_field): Don't constrain if
Gerd Moellmann <gerd@gnu.org>
parents:
27077
diff
changeset
|
729 if (NILP (Vinhibit_field_text_motion) |
f068649f1c28
(Fconstrain_to_field): Don't constrain if
Gerd Moellmann <gerd@gnu.org>
parents:
27077
diff
changeset
|
730 && !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
|
731 && (!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
|
732 || !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
|
733 && (NILP (inhibit_capture_property) |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
734 || 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
|
735 /* 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
|
736 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
|
737 { |
30439
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
738 int fwd, shortage; |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
739 Lisp_Object field_bound; |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
740 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
741 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
|
742 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
|
743 |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
744 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
|
745 |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
746 if (fwd) |
41065
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
747 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
|
748 else |
41065
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
749 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
|
750 |
30550
73040724e653
(Fconstrain_to_field): Fix the conditions for deciding when to constrain
Miles Bader <miles@gnu.org>
parents:
30503
diff
changeset
|
751 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
|
752 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
|
753 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
|
754 to FIELD_BOUND. */ |
73040724e653
(Fconstrain_to_field): Fix the conditions for deciding when to constrain
Miles Bader <miles@gnu.org>
parents:
30503
diff
changeset
|
755 ((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
|
756 /* 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
|
757 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
|
758 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
|
759 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
|
760 && (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
|
761 /* 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
|
762 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
|
763 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
|
764 || (scan_buffer ('\n', |
73040724e653
(Fconstrain_to_field): Fix the conditions for deciding when to constrain
Miles Bader <miles@gnu.org>
parents:
30503
diff
changeset
|
765 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
|
766 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
|
767 shortage != 0))) |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
768 /* 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
|
769 new_pos = field_bound; |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
770 |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
771 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
|
772 /* 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
|
773 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
|
774 } |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
775 |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
776 return new_pos; |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
777 } |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
778 |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
779 |
40042
c9ad5da1f79d
(Fline_beginning_position, Fline_end_position): Clarify documentation.
Miles Bader <miles@gnu.org>
parents:
39988
diff
changeset
|
780 DEFUN ("line-beginning-position", |
c9ad5da1f79d
(Fline_beginning_position, Fline_end_position): Clarify documentation.
Miles Bader <miles@gnu.org>
parents:
39988
diff
changeset
|
781 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
|
782 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
|
783 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
|
784 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
|
785 |
c9ad5da1f79d
(Fline_beginning_position, Fline_end_position): Clarify documentation.
Miles Bader <miles@gnu.org>
parents:
39988
diff
changeset
|
786 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
|
787 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
|
788 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
|
789 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
|
790 |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
791 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
|
792 (n) |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
793 Lisp_Object n; |
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
794 { |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
795 int orig, orig_byte, end; |
305 | 796 |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
797 if (NILP (n)) |
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
798 XSETFASTINT (n, 1); |
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
799 else |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
800 CHECK_NUMBER (n); |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
801 |
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
802 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
|
803 orig_byte = PT_BYTE; |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
804 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
|
805 end = PT; |
25647
947cb0e32a1d
(Fline_beginning_position): Handle minibuffer prompt here.
Richard M. Stallman <rms@gnu.org>
parents:
25609
diff
changeset
|
806 |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
807 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
|
808 |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
809 /* 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
|
810 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
|
811 XINT (n) != 1 ? Qt : Qnil, |
30439
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
812 Qt, Qnil); |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
813 } |
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
814 |
40042
c9ad5da1f79d
(Fline_beginning_position, Fline_end_position): Clarify documentation.
Miles Bader <miles@gnu.org>
parents:
39988
diff
changeset
|
815 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
|
816 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
|
817 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
|
818 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
|
819 |
c9ad5da1f79d
(Fline_beginning_position, Fline_end_position): Clarify documentation.
Miles Bader <miles@gnu.org>
parents:
39988
diff
changeset
|
820 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
|
821 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
|
822 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
|
823 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
|
824 |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
825 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
|
826 (n) |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
827 Lisp_Object n; |
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
828 { |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
829 int end_pos; |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
830 int orig = PT; |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
831 |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
832 if (NILP (n)) |
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
833 XSETFASTINT (n, 1); |
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
834 else |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
835 CHECK_NUMBER (n); |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
836 |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
837 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
|
838 |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
839 /* 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
|
840 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
|
841 Qnil, Qt, Qnil); |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
842 } |
40042
c9ad5da1f79d
(Fline_beginning_position, Fline_end_position): Clarify documentation.
Miles Bader <miles@gnu.org>
parents:
39988
diff
changeset
|
843 |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
844 |
305 | 845 Lisp_Object |
846 save_excursion_save () | |
847 { | |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
848 int visible = (XBUFFER (XWINDOW (selected_window)->buffer) |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
849 == current_buffer); |
305 | 850 |
851 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
|
852 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
|
853 Fcons (visible ? Qt : Qnil, |
32420
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
854 Fcons (current_buffer->mark_active, |
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
855 selected_window)))); |
305 | 856 } |
857 | |
858 Lisp_Object | |
859 save_excursion_restore (info) | |
15075
e8613675066c
(save_excursion_restore): Add gcpros.
Richard M. Stallman <rms@gnu.org>
parents:
15015
diff
changeset
|
860 Lisp_Object info; |
305 | 861 { |
15075
e8613675066c
(save_excursion_restore): Add gcpros.
Richard M. Stallman <rms@gnu.org>
parents:
15015
diff
changeset
|
862 Lisp_Object tem, tem1, omark, nmark; |
e8613675066c
(save_excursion_restore): Add gcpros.
Richard M. Stallman <rms@gnu.org>
parents:
15015
diff
changeset
|
863 struct gcpro gcpro1, gcpro2, gcpro3; |
32420
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
864 int visible_p; |
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
865 |
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
866 tem = Fmarker_buffer (XCAR (info)); |
305 | 867 /* If buffer being returned to is now deleted, avoid error */ |
868 /* Otherwise could get error here while unwinding to top level | |
869 and crash */ | |
870 /* In that case, Fmarker_buffer returns nil now. */ | |
488 | 871 if (NILP (tem)) |
305 | 872 return Qnil; |
15075
e8613675066c
(save_excursion_restore): Add gcpros.
Richard M. Stallman <rms@gnu.org>
parents:
15015
diff
changeset
|
873 |
e8613675066c
(save_excursion_restore): Add gcpros.
Richard M. Stallman <rms@gnu.org>
parents:
15015
diff
changeset
|
874 omark = nmark = Qnil; |
e8613675066c
(save_excursion_restore): Add gcpros.
Richard M. Stallman <rms@gnu.org>
parents:
15015
diff
changeset
|
875 GCPRO3 (info, omark, nmark); |
e8613675066c
(save_excursion_restore): Add gcpros.
Richard M. Stallman <rms@gnu.org>
parents:
15015
diff
changeset
|
876 |
305 | 877 Fset_buffer (tem); |
32420
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
878 |
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
879 /* Point marker. */ |
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
880 tem = XCAR (info); |
305 | 881 Fgoto_char (tem); |
51670
beceb827c1ce
(save_excursion_restore, transpose_markers): Update for new types.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
51042
diff
changeset
|
882 unchain_marker (XMARKER (tem)); |
32420
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
883 |
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
884 /* Mark marker. */ |
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
885 info = XCDR (info); |
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
886 tem = XCAR (info); |
7485
a1b7f72e0ea2
(save_excursion_restore): Don't run activate-mark-hook
Richard M. Stallman <rms@gnu.org>
parents:
7307
diff
changeset
|
887 omark = Fmarker_position (current_buffer->mark); |
305 | 888 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
|
889 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
|
890 unchain_marker (XMARKER (tem)); |
32420
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
891 |
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
892 /* visible */ |
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
893 info = XCDR (info); |
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
894 visible_p = !NILP (XCAR (info)); |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49472
diff
changeset
|
895 |
4420
8113d9ba472e
(save_excursion_restore): Never make the buffer visible.
Richard M. Stallman <rms@gnu.org>
parents:
4358
diff
changeset
|
896 #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
|
897 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
|
898 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
|
899 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
|
900 tem1 = Fcar (tem); |
a358c97a23e4
(save_excursion_save): Save mark_active of buffer.
Richard M. Stallman <rms@gnu.org>
parents:
1916
diff
changeset
|
901 if (!NILP (tem1) |
1254
c7e7e3438711
* editfns.c (save_excursion_save, save_excursion_restore):
Jim Blandy <jimb@redhat.com>
parents:
1117
diff
changeset
|
902 && current_buffer != XBUFFER (XWINDOW (selected_window)->buffer)) |
305 | 903 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
|
904 #endif /* 0 */ |
2049
a358c97a23e4
(save_excursion_save): Save mark_active of buffer.
Richard M. Stallman <rms@gnu.org>
parents:
1916
diff
changeset
|
905 |
32420
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
906 /* Mark active */ |
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
907 info = XCDR (info); |
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
908 tem = XCAR (info); |
2049
a358c97a23e4
(save_excursion_save): Save mark_active of buffer.
Richard M. Stallman <rms@gnu.org>
parents:
1916
diff
changeset
|
909 tem1 = current_buffer->mark_active; |
32420
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
910 current_buffer->mark_active = tem; |
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
911 |
6206
67c608b0e2f7
(save_excursion_restore): Don't call Vrun_hooks if nil.
Richard M. Stallman <rms@gnu.org>
parents:
5915
diff
changeset
|
912 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
|
913 { |
7485
a1b7f72e0ea2
(save_excursion_restore): Don't run activate-mark-hook
Richard M. Stallman <rms@gnu.org>
parents:
7307
diff
changeset
|
914 /* 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
|
915 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
|
916 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
|
917 { |
a1b7f72e0ea2
(save_excursion_restore): Don't run activate-mark-hook
Richard M. Stallman <rms@gnu.org>
parents:
7307
diff
changeset
|
918 if (! EQ (omark, nmark)) |
a1b7f72e0ea2
(save_excursion_restore): Don't run activate-mark-hook
Richard M. Stallman <rms@gnu.org>
parents:
7307
diff
changeset
|
919 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
|
920 } |
a1b7f72e0ea2
(save_excursion_restore): Don't run activate-mark-hook
Richard M. Stallman <rms@gnu.org>
parents:
7307
diff
changeset
|
921 /* 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
|
922 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
|
923 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
|
924 } |
32420
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
925 |
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
926 /* 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
|
927 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
|
928 buffer, restore point in that window. */ |
32420
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
929 tem = XCDR (info); |
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
930 if (visible_p |
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
931 && !EQ (tem, selected_window) |
37492
b9cea35cf91f
(save_excursion_restore): Don't use XBUFFER on
Gerd Moellmann <gerd@gnu.org>
parents:
37217
diff
changeset
|
932 && (tem1 = XWINDOW (tem)->buffer, |
b9cea35cf91f
(save_excursion_restore): Don't use XBUFFER on
Gerd Moellmann <gerd@gnu.org>
parents:
37217
diff
changeset
|
933 (/* Window is live... */ |
b9cea35cf91f
(save_excursion_restore): Don't use XBUFFER on
Gerd Moellmann <gerd@gnu.org>
parents:
37217
diff
changeset
|
934 BUFFERP (tem1) |
b9cea35cf91f
(save_excursion_restore): Don't use XBUFFER on
Gerd Moellmann <gerd@gnu.org>
parents:
37217
diff
changeset
|
935 /* ...and it shows the current buffer. */ |
b9cea35cf91f
(save_excursion_restore): Don't use XBUFFER on
Gerd Moellmann <gerd@gnu.org>
parents:
37217
diff
changeset
|
936 && XBUFFER (tem1) == current_buffer))) |
32420
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
937 Fset_window_point (tem, make_number (PT)); |
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
938 |
15075
e8613675066c
(save_excursion_restore): Add gcpros.
Richard M. Stallman <rms@gnu.org>
parents:
15015
diff
changeset
|
939 UNGCPRO; |
305 | 940 return Qnil; |
941 } | |
942 | |
943 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
|
944 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
|
945 Executes BODY just like `progn'. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
946 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
|
947 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
|
948 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
|
949 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
950 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
|
951 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
|
952 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
|
953 `deactivate-mark' with `let'. |
9bf80d5fff41
(Fsave_excursion, Fsave_current_buffer)
Miles Bader <miles@gnu.org>
parents:
40131
diff
changeset
|
954 |
9bf80d5fff41
(Fsave_excursion, Fsave_current_buffer)
Miles Bader <miles@gnu.org>
parents:
40131
diff
changeset
|
955 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
|
956 (args) |
305 | 957 Lisp_Object args; |
958 { | |
959 register Lisp_Object val; | |
46293
1fb8f75062c6
Use macro SPECPDL_INDEX.
Juanma Barranquero <lekktu@gmail.com>
parents:
45398
diff
changeset
|
960 int count = SPECPDL_INDEX (); |
305 | 961 |
962 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
|
963 |
17304eb73f97
(Fsave_current_buffer): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16269
diff
changeset
|
964 val = Fprogn (args); |
17304eb73f97
(Fsave_current_buffer): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16269
diff
changeset
|
965 return unbind_to (count, val); |
17304eb73f97
(Fsave_current_buffer): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16269
diff
changeset
|
966 } |
17304eb73f97
(Fsave_current_buffer): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16269
diff
changeset
|
967 |
17304eb73f97
(Fsave_current_buffer): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16269
diff
changeset
|
968 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
|
969 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
|
970 Executes BODY just like `progn'. |
9bf80d5fff41
(Fsave_excursion, Fsave_current_buffer)
Miles Bader <miles@gnu.org>
parents:
40131
diff
changeset
|
971 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
|
972 (args) |
16298
17304eb73f97
(Fsave_current_buffer): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16269
diff
changeset
|
973 Lisp_Object args; |
17304eb73f97
(Fsave_current_buffer): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16269
diff
changeset
|
974 { |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
975 Lisp_Object val; |
46293
1fb8f75062c6
Use macro SPECPDL_INDEX.
Juanma Barranquero <lekktu@gmail.com>
parents:
45398
diff
changeset
|
976 int count = SPECPDL_INDEX (); |
16298
17304eb73f97
(Fsave_current_buffer): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16269
diff
changeset
|
977 |
20696
cdbe4824e7f1
(Fsave_current_buffer): Use set_buffer_if_live.
Richard M. Stallman <rms@gnu.org>
parents:
20688
diff
changeset
|
978 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
|
979 |
305 | 980 val = Fprogn (args); |
981 return unbind_to (count, val); | |
982 } | |
983 | |
25608
1cdab17df2b3
(Fbufsize): Accept an extra BUFFER parameter.
Richard M. Stallman <rms@gnu.org>
parents:
25507
diff
changeset
|
984 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
|
985 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
|
986 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
|
987 (buffer) |
25608
1cdab17df2b3
(Fbufsize): Accept an extra BUFFER parameter.
Richard M. Stallman <rms@gnu.org>
parents:
25507
diff
changeset
|
988 Lisp_Object buffer; |
305 | 989 { |
25608
1cdab17df2b3
(Fbufsize): Accept an extra BUFFER parameter.
Richard M. Stallman <rms@gnu.org>
parents:
25507
diff
changeset
|
990 if (NILP (buffer)) |
1cdab17df2b3
(Fbufsize): Accept an extra BUFFER parameter.
Richard M. Stallman <rms@gnu.org>
parents:
25507
diff
changeset
|
991 return make_number (Z - BEG); |
25609
157f0e91232e
Clear up previous change.
Richard M. Stallman <rms@gnu.org>
parents:
25608
diff
changeset
|
992 else |
157f0e91232e
Clear up previous change.
Richard M. Stallman <rms@gnu.org>
parents:
25608
diff
changeset
|
993 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
994 CHECK_BUFFER (buffer); |
25609
157f0e91232e
Clear up previous change.
Richard M. Stallman <rms@gnu.org>
parents:
25608
diff
changeset
|
995 return make_number (BUF_Z (XBUFFER (buffer)) |
157f0e91232e
Clear up previous change.
Richard M. Stallman <rms@gnu.org>
parents:
25608
diff
changeset
|
996 - BUF_BEG (XBUFFER (buffer))); |
157f0e91232e
Clear up previous change.
Richard M. Stallman <rms@gnu.org>
parents:
25608
diff
changeset
|
997 } |
305 | 998 } |
999 | |
1000 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
|
1001 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
|
1002 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
|
1003 () |
305 | 1004 { |
1005 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
|
1006 XSETFASTINT (temp, BEGV); |
305 | 1007 return temp; |
1008 } | |
1009 | |
1010 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
|
1011 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
|
1012 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
|
1013 () |
305 | 1014 { |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
1015 return buildmark (BEGV, BEGV_BYTE); |
305 | 1016 } |
1017 | |
1018 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
|
1019 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
|
1020 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
|
1021 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
|
1022 () |
305 | 1023 { |
1024 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
|
1025 XSETFASTINT (temp, ZV); |
305 | 1026 return temp; |
1027 } | |
1028 | |
1029 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
|
1030 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
|
1031 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
|
1032 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
|
1033 () |
305 | 1034 { |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
1035 return buildmark (ZV, ZV_BYTE); |
305 | 1036 } |
1037 | |
21821
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
1038 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
|
1039 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
|
1040 See also `gap-size'. */) |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1041 () |
21821
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
1042 { |
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
1043 Lisp_Object temp; |
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
1044 XSETFASTINT (temp, GPT); |
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
1045 return temp; |
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
1046 } |
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
1047 |
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
1048 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
|
1049 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
|
1050 See also `gap-position'. */) |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1051 () |
21821
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
1052 { |
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
1053 Lisp_Object temp; |
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
1054 XSETFASTINT (temp, GAP_SIZE); |
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
1055 return temp; |
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
1056 } |
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
1057 |
20861
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
1058 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
|
1059 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
|
1060 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
|
1061 (position) |
20879
64d2baa47498
(Fposition_bytes): Declare arg POSITION as Lips_Object.
Kenichi Handa <handa@m17n.org>
parents:
20878
diff
changeset
|
1062 Lisp_Object position; |
20861
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
1063 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
1064 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
|
1065 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
|
1066 return Qnil; |
20878
34e0c8eb49eb
(Fposition_bytes): Allow marker as arg POSITION. Use
Kenichi Handa <handa@m17n.org>
parents:
20861
diff
changeset
|
1067 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
|
1068 } |
22645
e5b201634497
(Fbyte_to_position): New function.
Richard M. Stallman <rms@gnu.org>
parents:
22199
diff
changeset
|
1069 |
e5b201634497
(Fbyte_to_position): New function.
Richard M. Stallman <rms@gnu.org>
parents:
22199
diff
changeset
|
1070 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
|
1071 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
|
1072 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
|
1073 (bytepos) |
22645
e5b201634497
(Fbyte_to_position): New function.
Richard M. Stallman <rms@gnu.org>
parents:
22199
diff
changeset
|
1074 Lisp_Object bytepos; |
e5b201634497
(Fbyte_to_position): New function.
Richard M. Stallman <rms@gnu.org>
parents:
22199
diff
changeset
|
1075 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
1076 CHECK_NUMBER (bytepos); |
23132
1c8e0e09aea1
(Fposition_bytes): If the arg POSITION is out of
Kenichi Handa <handa@m17n.org>
parents:
23063
diff
changeset
|
1077 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
|
1078 return Qnil; |
22645
e5b201634497
(Fbyte_to_position): New function.
Richard M. Stallman <rms@gnu.org>
parents:
22199
diff
changeset
|
1079 return make_number (BYTE_TO_CHAR (XINT (bytepos))); |
e5b201634497
(Fbyte_to_position): New function.
Richard M. Stallman <rms@gnu.org>
parents:
22199
diff
changeset
|
1080 } |
20861
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
1081 |
512 | 1082 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
|
1083 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
|
1084 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
|
1085 () |
305 | 1086 { |
1087 Lisp_Object temp; | |
16039
855c8d8ba0f0
Change all references from point to PT.
Karl Heuer <kwzh@gnu.org>
parents:
15910
diff
changeset
|
1088 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
|
1089 XSETFASTINT (temp, 0); |
512 | 1090 else |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
1091 XSETFASTINT (temp, FETCH_CHAR (PT_BYTE)); |
305 | 1092 return temp; |
1093 } | |
1094 | |
512 | 1095 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
|
1096 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
|
1097 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
|
1098 () |
305 | 1099 { |
1100 Lisp_Object temp; | |
16039
855c8d8ba0f0
Change all references from point to PT.
Karl Heuer <kwzh@gnu.org>
parents:
15910
diff
changeset
|
1101 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
|
1102 XSETFASTINT (temp, 0); |
17031 | 1103 else if (!NILP (current_buffer->enable_multibyte_characters)) |
1104 { | |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
1105 int pos = PT_BYTE; |
17031 | 1106 DEC_POS (pos); |
1107 XSETFASTINT (temp, FETCH_CHAR (pos)); | |
1108 } | |
305 | 1109 else |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
1110 XSETFASTINT (temp, FETCH_BYTE (PT_BYTE - 1)); |
305 | 1111 return temp; |
1112 } | |
1113 | |
1114 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
|
1115 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
|
1116 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
|
1117 () |
305 | 1118 { |
16039
855c8d8ba0f0
Change all references from point to PT.
Karl Heuer <kwzh@gnu.org>
parents:
15910
diff
changeset
|
1119 if (PT == BEGV) |
305 | 1120 return Qt; |
1121 return Qnil; | |
1122 } | |
1123 | |
1124 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
|
1125 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
|
1126 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
|
1127 () |
305 | 1128 { |
16039
855c8d8ba0f0
Change all references from point to PT.
Karl Heuer <kwzh@gnu.org>
parents:
15910
diff
changeset
|
1129 if (PT == ZV) |
305 | 1130 return Qt; |
1131 return Qnil; | |
1132 } | |
1133 | |
1134 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
|
1135 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
|
1136 () |
305 | 1137 { |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
1138 if (PT == BEGV || FETCH_BYTE (PT_BYTE - 1) == '\n') |
305 | 1139 return Qt; |
1140 return Qnil; | |
1141 } | |
1142 | |
1143 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
|
1144 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
|
1145 `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
|
1146 () |
305 | 1147 { |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
1148 if (PT == ZV || FETCH_BYTE (PT_BYTE) == '\n') |
305 | 1149 return Qt; |
1150 return Qnil; | |
1151 } | |
1152 | |
18252
9c4fb902b6eb
(Fchar_after, Fchar_before): Make arg optional.
Richard M. Stallman <rms@gnu.org>
parents:
18240
diff
changeset
|
1153 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
|
1154 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
|
1155 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
|
1156 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
|
1157 (pos) |
305 | 1158 Lisp_Object pos; |
1159 { | |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
1160 register int pos_byte; |
305 | 1161 |
18252
9c4fb902b6eb
(Fchar_after, Fchar_before): Make arg optional.
Richard M. Stallman <rms@gnu.org>
parents:
18240
diff
changeset
|
1162 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
|
1163 { |
edca9002c740
(Fchar_after): Make nil fully equivalent to (point) as arg.
Richard M. Stallman <rms@gnu.org>
parents:
21914
diff
changeset
|
1164 pos_byte = PT_BYTE; |
23577
36cccf1ba0a9
(Fchar_after): Fix type clashes.
Andreas Schwab <schwab@suse.de>
parents:
23565
diff
changeset
|
1165 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
|
1166 } |
edca9002c740
(Fchar_after): Make nil fully equivalent to (point) as arg.
Richard M. Stallman <rms@gnu.org>
parents:
21914
diff
changeset
|
1167 |
edca9002c740
(Fchar_after): Make nil fully equivalent to (point) as arg.
Richard M. Stallman <rms@gnu.org>
parents:
21914
diff
changeset
|
1168 if (MARKERP (pos)) |
21200
ea520c42a342
(Fchar_after, Fchar_before): Properly check arg type
Richard M. Stallman <rms@gnu.org>
parents:
21064
diff
changeset
|
1169 { |
ea520c42a342
(Fchar_after, Fchar_before): Properly check arg type
Richard M. Stallman <rms@gnu.org>
parents:
21064
diff
changeset
|
1170 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
|
1171 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
|
1172 return Qnil; |
ea520c42a342
(Fchar_after, Fchar_before): Properly check arg type
Richard M. Stallman <rms@gnu.org>
parents:
21064
diff
changeset
|
1173 } |
18252
9c4fb902b6eb
(Fchar_after, Fchar_before): Make arg optional.
Richard M. Stallman <rms@gnu.org>
parents:
18240
diff
changeset
|
1174 else |
9c4fb902b6eb
(Fchar_after, Fchar_before): Make arg optional.
Richard M. Stallman <rms@gnu.org>
parents:
18240
diff
changeset
|
1175 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
1176 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
|
1177 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
|
1178 return Qnil; |
30480 | 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 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
|
1181 } |
305 | 1182 |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
1183 return make_number (FETCH_CHAR (pos_byte)); |
305 | 1184 } |
17031 | 1185 |
18252
9c4fb902b6eb
(Fchar_after, Fchar_before): Make arg optional.
Richard M. Stallman <rms@gnu.org>
parents:
18240
diff
changeset
|
1186 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
|
1187 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
|
1188 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
|
1189 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
|
1190 (pos) |
17031 | 1191 Lisp_Object pos; |
1192 { | |
1193 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
|
1194 register int pos_byte; |
17031 | 1195 |
18252
9c4fb902b6eb
(Fchar_after, Fchar_before): Make arg optional.
Richard M. Stallman <rms@gnu.org>
parents:
18240
diff
changeset
|
1196 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
|
1197 { |
edca9002c740
(Fchar_after): Make nil fully equivalent to (point) as arg.
Richard M. Stallman <rms@gnu.org>
parents:
21914
diff
changeset
|
1198 pos_byte = PT_BYTE; |
23577
36cccf1ba0a9
(Fchar_after): Fix type clashes.
Andreas Schwab <schwab@suse.de>
parents:
23565
diff
changeset
|
1199 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
|
1200 } |
edca9002c740
(Fchar_after): Make nil fully equivalent to (point) as arg.
Richard M. Stallman <rms@gnu.org>
parents:
21914
diff
changeset
|
1201 |
edca9002c740
(Fchar_after): Make nil fully equivalent to (point) as arg.
Richard M. Stallman <rms@gnu.org>
parents:
21914
diff
changeset
|
1202 if (MARKERP (pos)) |
21200
ea520c42a342
(Fchar_after, Fchar_before): Properly check arg type
Richard M. Stallman <rms@gnu.org>
parents:
21064
diff
changeset
|
1203 { |
ea520c42a342
(Fchar_after, Fchar_before): Properly check arg type
Richard M. Stallman <rms@gnu.org>
parents:
21064
diff
changeset
|
1204 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
|
1205 |
ea520c42a342
(Fchar_after, Fchar_before): Properly check arg type
Richard M. Stallman <rms@gnu.org>
parents:
21064
diff
changeset
|
1206 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
|
1207 return Qnil; |
ea520c42a342
(Fchar_after, Fchar_before): Properly check arg type
Richard M. Stallman <rms@gnu.org>
parents:
21064
diff
changeset
|
1208 } |
18252
9c4fb902b6eb
(Fchar_after, Fchar_before): Make arg optional.
Richard M. Stallman <rms@gnu.org>
parents:
18240
diff
changeset
|
1209 else |
9c4fb902b6eb
(Fchar_after, Fchar_before): Make arg optional.
Richard M. Stallman <rms@gnu.org>
parents:
18240
diff
changeset
|
1210 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
1211 CHECK_NUMBER_COERCE_MARKER (pos); |
17031 | 1212 |
21521
354a7085f1d7
(Fchar_after, Fchar_before): Fix mixing of Lisp_Object
Andreas Schwab <schwab@suse.de>
parents:
21514
diff
changeset
|
1213 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
|
1214 return Qnil; |
ea520c42a342
(Fchar_after, Fchar_before): Properly check arg type
Richard M. Stallman <rms@gnu.org>
parents:
21064
diff
changeset
|
1215 |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
1216 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
|
1217 } |
17031 | 1218 |
1219 if (!NILP (current_buffer->enable_multibyte_characters)) | |
1220 { | |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
1221 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
|
1222 XSETFASTINT (val, FETCH_CHAR (pos_byte)); |
17031 | 1223 } |
1224 else | |
1225 { | |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
1226 pos_byte--; |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
1227 XSETFASTINT (val, FETCH_BYTE (pos_byte)); |
17031 | 1228 } |
1229 return val; | |
1230 } | |
305 | 1231 |
9572 | 1232 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
|
1233 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
|
1234 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
|
1235 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
|
1236 that determines the value of this function. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1237 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1238 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
|
1239 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
|
1240 (uid) |
9572 | 1241 Lisp_Object uid; |
305 | 1242 { |
9572 | 1243 struct passwd *pw; |
1244 | |
9520
5187a4159d16
(Fuser_login_name, Fuser_real_login_name):
Richard M. Stallman <rms@gnu.org>
parents:
9305
diff
changeset
|
1245 /* 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
|
1246 (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
|
1247 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
|
1248 if (INTEGERP (Vuser_login_name)) |
9520
5187a4159d16
(Fuser_login_name, Fuser_real_login_name):
Richard M. Stallman <rms@gnu.org>
parents:
9305
diff
changeset
|
1249 init_editfns (); |
9572 | 1250 |
1251 if (NILP (uid)) | |
12026
505a894d943e
(syms_of_editfns): user-login-name renamed from user-name.
Karl Heuer <kwzh@gnu.org>
parents:
11912
diff
changeset
|
1252 return Vuser_login_name; |
9572 | 1253 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
1254 CHECK_NUMBER (uid); |
9572 | 1255 pw = (struct passwd *) getpwuid (XINT (uid)); |
1256 return (pw ? build_string (pw->pw_name) : Qnil); | |
305 | 1257 } |
1258 | |
1259 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
|
1260 0, 0, 0, |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1261 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
|
1262 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
|
1263 `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
|
1264 () |
305 | 1265 { |
9520
5187a4159d16
(Fuser_login_name, Fuser_real_login_name):
Richard M. Stallman <rms@gnu.org>
parents:
9305
diff
changeset
|
1266 /* 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
|
1267 (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
|
1268 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
|
1269 if (INTEGERP (Vuser_login_name)) |
9520
5187a4159d16
(Fuser_login_name, Fuser_real_login_name):
Richard M. Stallman <rms@gnu.org>
parents:
9305
diff
changeset
|
1270 init_editfns (); |
12026
505a894d943e
(syms_of_editfns): user-login-name renamed from user-name.
Karl Heuer <kwzh@gnu.org>
parents:
11912
diff
changeset
|
1271 return Vuser_real_login_name; |
305 | 1272 } |
1273 | |
1274 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
|
1275 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
|
1276 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
|
1277 () |
305 | 1278 { |
39774
b34a792f4234
(Fuser_uid, Fuser_real_uid): Use make_fixnum_or_float.
Gerd Moellmann <gerd@gnu.org>
parents:
39720
diff
changeset
|
1279 return make_fixnum_or_float (geteuid ()); |
305 | 1280 } |
1281 | |
1282 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
|
1283 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
|
1284 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
|
1285 () |
305 | 1286 { |
39774
b34a792f4234
(Fuser_uid, Fuser_real_uid): Use make_fixnum_or_float.
Gerd Moellmann <gerd@gnu.org>
parents:
39720
diff
changeset
|
1287 return make_fixnum_or_float (getuid ()); |
305 | 1288 } |
1289 | |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
1290 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
|
1291 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
|
1292 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
|
1293 return "unknown". |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1294 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1295 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
|
1296 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
|
1297 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
|
1298 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
|
1299 (uid) |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
1300 Lisp_Object uid; |
305 | 1301 { |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
1302 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
|
1303 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
|
1304 Lisp_Object full; |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
1305 |
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
1306 if (NILP (uid)) |
30480 | 1307 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
|
1308 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
|
1309 pw = (struct passwd *) getpwuid ((uid_t) XFLOATINT (uid)); |
30480 | 1310 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
|
1311 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
|
1312 else |
2103a88cc61f
(Fuser_full_name): Accept a string (the login name) as
Richard M. Stallman <rms@gnu.org>
parents:
16639
diff
changeset
|
1313 error ("Invalid UID specification"); |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
1314 |
16641
2103a88cc61f
(Fuser_full_name): Accept a string (the login name) as
Richard M. Stallman <rms@gnu.org>
parents:
16639
diff
changeset
|
1315 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
|
1316 return Qnil; |
30480 | 1317 |
16641
2103a88cc61f
(Fuser_full_name): Accept a string (the login name) as
Richard M. Stallman <rms@gnu.org>
parents:
16639
diff
changeset
|
1318 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
|
1319 /* 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
|
1320 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
|
1321 full = make_string (p, q ? q - p : strlen (p)); |
30480 | 1322 |
16641
2103a88cc61f
(Fuser_full_name): Accept a string (the login name) as
Richard M. Stallman <rms@gnu.org>
parents:
16639
diff
changeset
|
1323 #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
|
1324 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
|
1325 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
|
1326 /* 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
|
1327 if (q) |
2103a88cc61f
(Fuser_full_name): Accept a string (the login name) as
Richard M. Stallman <rms@gnu.org>
parents:
16639
diff
changeset
|
1328 { |
18661
537522d5e6d8
(Fuser_full_name): Declare p, q and r as unsigned char *.
Richard M. Stallman <rms@gnu.org>
parents:
18613
diff
changeset
|
1329 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
|
1330 Lisp_Object login; |
2103a88cc61f
(Fuser_full_name): Accept a string (the login name) as
Richard M. Stallman <rms@gnu.org>
parents:
16639
diff
changeset
|
1331 |
2103a88cc61f
(Fuser_full_name): Accept a string (the login name) as
Richard M. Stallman <rms@gnu.org>
parents:
16639
diff
changeset
|
1332 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
|
1333 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
|
1334 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
|
1335 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
|
1336 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
|
1337 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
|
1338 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
|
1339 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
|
1340 } |
2103a88cc61f
(Fuser_full_name): Accept a string (the login name) as
Richard M. Stallman <rms@gnu.org>
parents:
16639
diff
changeset
|
1341 #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
|
1342 |
2103a88cc61f
(Fuser_full_name): Accept a string (the login name) as
Richard M. Stallman <rms@gnu.org>
parents:
16639
diff
changeset
|
1343 return full; |
305 | 1344 } |
1345 | |
1346 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
|
1347 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
|
1348 () |
305 | 1349 { |
1350 return Vsystem_name; | |
1351 } | |
1352 | |
7907
148ad20d6774
(init_editfns): Call init_system_name instead of get_system_name.
Karl Heuer <kwzh@gnu.org>
parents:
7862
diff
changeset
|
1353 /* 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
|
1354 |
7907
148ad20d6774
(init_editfns): Call init_system_name instead of get_system_name.
Karl Heuer <kwzh@gnu.org>
parents:
7862
diff
changeset
|
1355 char * |
148ad20d6774
(init_editfns): Call init_system_name instead of get_system_name.
Karl Heuer <kwzh@gnu.org>
parents:
7862
diff
changeset
|
1356 get_system_name () |
148ad20d6774
(init_editfns): Call init_system_name instead of get_system_name.
Karl Heuer <kwzh@gnu.org>
parents:
7862
diff
changeset
|
1357 { |
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
|
1358 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
|
1359 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
|
1360 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
|
1361 return ""; |
7907
148ad20d6774
(init_editfns): Call init_system_name instead of get_system_name.
Karl Heuer <kwzh@gnu.org>
parents:
7862
diff
changeset
|
1362 } |
148ad20d6774
(init_editfns): Call init_system_name instead of get_system_name.
Karl Heuer <kwzh@gnu.org>
parents:
7862
diff
changeset
|
1363 |
59658
45074d913d23
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
59644
diff
changeset
|
1364 char * |
45074d913d23
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
59644
diff
changeset
|
1365 get_operating_system_release() |
45074d913d23
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
59644
diff
changeset
|
1366 { |
45074d913d23
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
59644
diff
changeset
|
1367 if (STRINGP (Voperating_system_release)) |
45074d913d23
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
59644
diff
changeset
|
1368 return (char *) SDATA (Voperating_system_release); |
45074d913d23
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
59644
diff
changeset
|
1369 else |
45074d913d23
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
59644
diff
changeset
|
1370 return ""; |
45074d913d23
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
59644
diff
changeset
|
1371 } |
45074d913d23
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
59644
diff
changeset
|
1372 |
5373
a70b89d2d6bb
(Femacs_pid): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5242
diff
changeset
|
1373 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
|
1374 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
|
1375 () |
5373
a70b89d2d6bb
(Femacs_pid): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5242
diff
changeset
|
1376 { |
a70b89d2d6bb
(Femacs_pid): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5242
diff
changeset
|
1377 return make_number (getpid ()); |
a70b89d2d6bb
(Femacs_pid): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5242
diff
changeset
|
1378 } |
a70b89d2d6bb
(Femacs_pid): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5242
diff
changeset
|
1379 |
448 | 1380 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
|
1381 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
|
1382 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
|
1383 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
|
1384 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
|
1385 count. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1386 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1387 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
|
1388 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
|
1389 () |
448 | 1390 { |
577 | 1391 EMACS_TIME t; |
1392 Lisp_Object result[3]; | |
1393 | |
1394 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
|
1395 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
|
1396 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
|
1397 XSETINT (result[2], EMACS_USECS (t)); |
577 | 1398 |
1399 return Flist (3, result); | |
448 | 1400 } |
57987
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1401 |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1402 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
|
1403 0, 0, 0, |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1404 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
|
1405 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
|
1406 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
|
1407 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
|
1408 count. |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1409 |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1410 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
|
1411 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
|
1412 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
|
1413 () |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1414 { |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1415 #ifdef HAVE_GETRUSAGE |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1416 struct rusage usage; |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1417 Lisp_Object result[3]; |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1418 int secs, usecs; |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1419 |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1420 if (getrusage (RUSAGE_SELF, &usage) < 0) |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1421 /* This shouldn't happen. What action is appropriate? */ |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1422 Fsignal (Qerror, Qnil); |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1423 |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1424 /* Sum up user time and system time. */ |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1425 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
|
1426 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
|
1427 if (usecs >= 1000000) |
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 usecs -= 1000000; |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1430 secs++; |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1431 } |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1432 |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1433 XSETINT (result[0], (secs >> 16) & 0xffff); |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1434 XSETINT (result[1], (secs >> 0) & 0xffff); |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1435 XSETINT (result[2], usecs); |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1436 |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1437 return Flist (3, result); |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1438 #else |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1439 return Fcurrent_time (); |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1440 #endif |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1441 } |
448 | 1442 |
1443 | |
55193
1b09eb24ab02
(lisp_time_argument): Provide externally.
Eli Zaretskii <eliz@gnu.org>
parents:
54846
diff
changeset
|
1444 int |
30480 | 1445 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
|
1446 Lisp_Object specified_time; |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1447 time_t *result; |
30480 | 1448 int *usec; |
2921
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1449 { |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1450 if (NILP (specified_time)) |
30480 | 1451 { |
1452 if (usec) | |
1453 { | |
1454 EMACS_TIME t; | |
1455 | |
30503
fef49230e1aa
(lisp_time_argument): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents:
30480
diff
changeset
|
1456 EMACS_GET_TIME (t); |
30480 | 1457 *usec = EMACS_USECS (t); |
1458 *result = EMACS_SECS (t); | |
1459 return 1; | |
1460 } | |
1461 else | |
1462 return time (result) != -1; | |
1463 } | |
2921
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1464 else |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1465 { |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1466 Lisp_Object high, low; |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1467 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
|
1468 CHECK_NUMBER (high); |
2921
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1469 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
|
1470 if (CONSP (low)) |
30480 | 1471 { |
1472 if (usec) | |
1473 { | |
1474 Lisp_Object usec_l = Fcdr (low); | |
1475 if (CONSP (usec_l)) | |
1476 usec_l = Fcar (usec_l); | |
1477 if (NILP (usec_l)) | |
1478 *usec = 0; | |
1479 else | |
1480 { | |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
1481 CHECK_NUMBER (usec_l); |
30480 | 1482 *usec = XINT (usec_l); |
1483 } | |
1484 } | |
1485 low = Fcar (low); | |
1486 } | |
1487 else if (usec) | |
1488 *usec = 0; | |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
1489 CHECK_NUMBER (low); |
2921
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1490 *result = (XINT (high) << 16) + (XINT (low) & 0xffff); |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1491 return *result >> 16 == XINT (high); |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1492 } |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1493 } |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1494 |
30480 | 1495 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
|
1496 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
|
1497 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
|
1498 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
|
1499 (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
|
1500 `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
|
1501 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
|
1502 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1503 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
|
1504 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
|
1505 (specified_time) |
30480 | 1506 Lisp_Object specified_time; |
1507 { | |
1508 time_t sec; | |
1509 int usec; | |
1510 | |
1511 if (! lisp_time_argument (specified_time, &sec, &usec)) | |
1512 error ("Invalid time specification"); | |
1513 | |
37046
a9b2639dd045
(Ffloat_time): Fix off-by-factor-of-10 bug in the
Gerd Moellmann <gerd@gnu.org>
parents:
36479
diff
changeset
|
1514 return make_float ((sec * 1e6 + usec) / 1e6); |
30480 | 1515 } |
1516 | |
23213
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1517 /* 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
|
1518 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
|
1519 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
|
1520 Return the number of bytes written, not including the terminating |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1521 '\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
|
1522 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
|
1523 ((size_t) -1) for MAXSIZE. |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1524 |
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
parents:
26058
diff
changeset
|
1525 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
|
1526 bytes in FORMAT. */ |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1527 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
|
1528 emacs_memftimeu (s, maxsize, format, format_len, tp, ut) |
23213
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1529 char *s; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1530 size_t maxsize; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1531 const char *format; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1532 size_t format_len; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1533 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
|
1534 int ut; |
23213
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1535 { |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1536 size_t total = 0; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1537 |
23218
90e5d916ebd9
Add a comment to emacs_memftime, explaining why it needs to loop.
Paul Eggert <eggert@twinsun.com>
parents:
23213
diff
changeset
|
1538 /* 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
|
1539 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
|
1540 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
|
1541 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
|
1542 '\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
|
1543 for (;;) |
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 size_t len; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1546 size_t result; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1547 |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1548 if (s) |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1549 s[0] = '\1'; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1550 |
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
parents:
26058
diff
changeset
|
1551 result = emacs_strftimeu (s, maxsize, format, tp, ut); |
23213
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1552 |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1553 if (s) |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1554 { |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1555 if (result == 0 && s[0] != '\0') |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1556 return 0; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1557 s += result + 1; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1558 } |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1559 |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1560 maxsize -= result + 1; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1561 total += result; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1562 len = strlen (format); |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1563 if (len == format_len) |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1564 return total; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1565 total++; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1566 format += len + 1; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1567 format_len -= len + 1; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1568 } |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1569 } |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1570 |
17907
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1571 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
|
1572 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
|
1573 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
|
1574 `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
|
1575 is also still accepted. |
39966
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1576 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
|
1577 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
|
1578 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
|
1579 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
|
1580 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1581 %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
|
1582 %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
|
1583 %m is the numeric month. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1584 %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
|
1585 %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
|
1586 %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
|
1587 %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
|
1588 %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
|
1589 %V according to ISO 8601. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1590 %j is the day of the year. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1591 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1592 %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
|
1593 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
|
1594 %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
|
1595 %M is the minute. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1596 %S is the second. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1597 %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
|
1598 %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
|
1599 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1600 %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
|
1601 %x is the locale's "preferred" date format. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1602 %D is like "%m/%d/%y". |
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 %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
|
1605 %X is the locale's "preferred" time format. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1606 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1607 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
|
1608 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1609 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
|
1610 The flags are `_', `-', `^' and `#'. For certain characters X, |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1611 %_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
|
1612 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
|
1613 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
|
1614 all textual characters reversed. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1615 %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
|
1616 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
|
1617 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
|
1618 %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
|
1619 %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
|
1620 |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1621 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
|
1622 (format_string, time, universal) |
17907
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1623 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
|
1624 { |
b4739bcefc44
(Fformat_time_string): Mostly rewritten, to handle
Richard M. Stallman <rms@gnu.org>
parents:
8981
diff
changeset
|
1625 time_t value; |
b4739bcefc44
(Fformat_time_string): Mostly rewritten, to handle
Richard M. Stallman <rms@gnu.org>
parents:
8981
diff
changeset
|
1626 int size; |
23198
dddce768cf7a
(Fformat_time_string, Fdecode_time, Fcurrent_time_zone):
Paul Eggert <eggert@twinsun.com>
parents:
23197
diff
changeset
|
1627 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
|
1628 int ut = ! NILP (universal); |
9154
b4739bcefc44
(Fformat_time_string): Mostly rewritten, to handle
Richard M. Stallman <rms@gnu.org>
parents:
8981
diff
changeset
|
1629 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
1630 CHECK_STRING (format_string); |
9154
b4739bcefc44
(Fformat_time_string): Mostly rewritten, to handle
Richard M. Stallman <rms@gnu.org>
parents:
8981
diff
changeset
|
1631 |
30480 | 1632 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
|
1633 error ("Invalid time specification"); |
b4739bcefc44
(Fformat_time_string): Mostly rewritten, to handle
Richard M. Stallman <rms@gnu.org>
parents:
8981
diff
changeset
|
1634 |
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
parents:
26058
diff
changeset
|
1635 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
|
1636 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
|
1637 |
9154
b4739bcefc44
(Fformat_time_string): Mostly rewritten, to handle
Richard M. Stallman <rms@gnu.org>
parents:
8981
diff
changeset
|
1638 /* 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
|
1639 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
|
1640 |
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
parents:
26058
diff
changeset
|
1641 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
|
1642 if (! tm) |
dddce768cf7a
(Fformat_time_string, Fdecode_time, Fcurrent_time_zone):
Paul Eggert <eggert@twinsun.com>
parents:
23197
diff
changeset
|
1643 error ("Specified time is not representable"); |
dddce768cf7a
(Fformat_time_string, Fdecode_time, Fcurrent_time_zone):
Paul Eggert <eggert@twinsun.com>
parents:
23197
diff
changeset
|
1644 |
26526
b7438760079b
* callproc.c (strerror): Remove decl.
Paul Eggert <eggert@twinsun.com>
parents:
26415
diff
changeset
|
1645 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
|
1646 |
9154
b4739bcefc44
(Fformat_time_string): Mostly rewritten, to handle
Richard M. Stallman <rms@gnu.org>
parents:
8981
diff
changeset
|
1647 while (1) |
b4739bcefc44
(Fformat_time_string): Mostly rewritten, to handle
Richard M. Stallman <rms@gnu.org>
parents:
8981
diff
changeset
|
1648 { |
17907
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1649 char *buf = (char *) alloca (size + 1); |
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1650 int result; |
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1651 |
19032
84ae0a03a643
(Fformat_time_string): Don't hang if strftime produces
Richard M. Stallman <rms@gnu.org>
parents:
18937
diff
changeset
|
1652 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
|
1653 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
|
1654 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
|
1655 tm, ut); |
19032
84ae0a03a643
(Fformat_time_string): Don't hang if strftime produces
Richard M. Stallman <rms@gnu.org>
parents:
18937
diff
changeset
|
1656 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
|
1657 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
|
1658 Vlocale_coding_system, 0); |
17907
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1659 |
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1660 /* 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
|
1661 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
|
1662 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
|
1663 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
|
1664 tm, ut); |
17907
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1665 size = result + 1; |
9154
b4739bcefc44
(Fformat_time_string): Mostly rewritten, to handle
Richard M. Stallman <rms@gnu.org>
parents:
8981
diff
changeset
|
1666 } |
b4739bcefc44
(Fformat_time_string): Mostly rewritten, to handle
Richard M. Stallman <rms@gnu.org>
parents:
8981
diff
changeset
|
1667 } |
b4739bcefc44
(Fformat_time_string): Mostly rewritten, to handle
Richard M. Stallman <rms@gnu.org>
parents:
8981
diff
changeset
|
1668 |
9801
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
1669 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
|
1670 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
|
1671 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
|
1672 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
|
1673 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
|
1674 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
|
1675 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
|
1676 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
|
1677 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
|
1678 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
|
1679 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
|
1680 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
|
1681 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
|
1682 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
|
1683 DOW and ZONE.) */) |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1684 (specified_time) |
9801
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
1685 Lisp_Object specified_time; |
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
1686 { |
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
1687 time_t time_spec; |
9812
bc352c8f079c
(Fdecode_time): Fix Lisp_Object vs. integer problems.
Karl Heuer <kwzh@gnu.org>
parents:
9809
diff
changeset
|
1688 struct tm save_tm; |
9801
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
1689 struct tm *decoded_time; |
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
1690 Lisp_Object list_args[9]; |
30480 | 1691 |
1692 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
|
1693 error ("Invalid time specification"); |
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
1694 |
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
1695 decoded_time = localtime (&time_spec); |
23198
dddce768cf7a
(Fformat_time_string, Fdecode_time, Fcurrent_time_zone):
Paul Eggert <eggert@twinsun.com>
parents:
23197
diff
changeset
|
1696 if (! decoded_time) |
dddce768cf7a
(Fformat_time_string, Fdecode_time, Fcurrent_time_zone):
Paul Eggert <eggert@twinsun.com>
parents:
23197
diff
changeset
|
1697 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
|
1698 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
|
1699 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
|
1700 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
|
1701 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
|
1702 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
|
1703 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
|
1704 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
|
1705 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
|
1706 |
bc352c8f079c
(Fdecode_time): Fix Lisp_Object vs. integer problems.
Karl Heuer <kwzh@gnu.org>
parents:
9809
diff
changeset
|
1707 /* 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
|
1708 save_tm = *decoded_time; |
bc352c8f079c
(Fdecode_time): Fix Lisp_Object vs. integer problems.
Karl Heuer <kwzh@gnu.org>
parents:
9809
diff
changeset
|
1709 decoded_time = gmtime (&time_spec); |
bc352c8f079c
(Fdecode_time): Fix Lisp_Object vs. integer problems.
Karl Heuer <kwzh@gnu.org>
parents:
9809
diff
changeset
|
1710 if (decoded_time == 0) |
bc352c8f079c
(Fdecode_time): Fix Lisp_Object vs. integer problems.
Karl Heuer <kwzh@gnu.org>
parents:
9809
diff
changeset
|
1711 list_args[8] = Qnil; |
bc352c8f079c
(Fdecode_time): Fix Lisp_Object vs. integer problems.
Karl Heuer <kwzh@gnu.org>
parents:
9809
diff
changeset
|
1712 else |
16269
79e6c47054c5
(tm_diff): Renamed from difftm. Yield int, not long.
Paul Eggert <eggert@twinsun.com>
parents:
16134
diff
changeset
|
1713 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
|
1714 return Flist (9, list_args); |
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
1715 } |
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
1716 |
15180
9a22c72359c1
(Fencode_time): Accept MANY args, so as to cope
Richard M. Stallman <rms@gnu.org>
parents:
15075
diff
changeset
|
1717 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
|
1718 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
|
1719 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
|
1720 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
|
1721 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
|
1722 \(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
|
1723 applied without consideration for daylight savings time. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1724 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1725 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
|
1726 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
|
1727 The intervening arguments are ignored. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1728 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
|
1729 |
55972
db2480202623
(Fuser_login_name, Ffloat_time, Fencode_time, Fcurrent_time_string)
Juanma Barranquero <lekktu@gmail.com>
parents:
55424
diff
changeset
|
1730 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
|
1731 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
|
1732 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
|
1733 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
|
1734 |
52211
a057bd074729
(Fencode_time): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
51841
diff
changeset
|
1735 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
|
1736 year values as low as 1901 do work. |
a057bd074729
(Fencode_time): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
51841
diff
changeset
|
1737 |
40131
de086e415fa2
(Finsert, Finsert_and_inherit, Finsert_before_markers, Fmessage)
Miles Bader <miles@gnu.org>
parents:
40046
diff
changeset
|
1738 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
|
1739 (nargs, args) |
15180
9a22c72359c1
(Fencode_time): Accept MANY args, so as to cope
Richard M. Stallman <rms@gnu.org>
parents:
15075
diff
changeset
|
1740 int nargs; |
9a22c72359c1
(Fencode_time): Accept MANY args, so as to cope
Richard M. Stallman <rms@gnu.org>
parents:
15075
diff
changeset
|
1741 register Lisp_Object *args; |
11402
66d935214d8e
(Fencode_time): Use XINT to examine `zone'.
Richard M. Stallman <rms@gnu.org>
parents:
11263
diff
changeset
|
1742 { |
11468
772f49d1969d
(Fencode_time): Rewrite by Naggum.
Richard M. Stallman <rms@gnu.org>
parents:
11451
diff
changeset
|
1743 time_t time; |
13025
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1744 struct tm tm; |
16874 | 1745 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
|
1746 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
1747 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
|
1748 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
|
1749 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
|
1750 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
|
1751 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
|
1752 CHECK_NUMBER (args[5]); /* year */ |
11468
772f49d1969d
(Fencode_time): Rewrite by Naggum.
Richard M. Stallman <rms@gnu.org>
parents:
11451
diff
changeset
|
1753 |
15180
9a22c72359c1
(Fencode_time): Accept MANY args, so as to cope
Richard M. Stallman <rms@gnu.org>
parents:
15075
diff
changeset
|
1754 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
|
1755 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
|
1756 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
|
1757 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
|
1758 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
|
1759 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
|
1760 tm.tm_isdst = -1; |
11468
772f49d1969d
(Fencode_time): Rewrite by Naggum.
Richard M. Stallman <rms@gnu.org>
parents:
11451
diff
changeset
|
1761 |
13025
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1762 if (CONSP (zone)) |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1763 zone = Fcar (zone); |
11468
772f49d1969d
(Fencode_time): Rewrite by Naggum.
Richard M. Stallman <rms@gnu.org>
parents:
11451
diff
changeset
|
1764 if (NILP (zone)) |
13025
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1765 time = mktime (&tm); |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1766 else |
11468
772f49d1969d
(Fencode_time): Rewrite by Naggum.
Richard M. Stallman <rms@gnu.org>
parents:
11451
diff
changeset
|
1767 { |
13025
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1768 char tzbuf[100]; |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1769 char *tzstring; |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1770 char **oldenv = environ, **newenv; |
30480 | 1771 |
18613
614b916ff5bf
Fix bugs with inappropriate mixing of Lisp_Object with int.
Richard M. Stallman <rms@gnu.org>
parents:
18605
diff
changeset
|
1772 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
|
1773 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
|
1774 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
|
1775 tzstring = (char *) SDATA (zone); |
13025
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1776 else if (INTEGERP (zone)) |
11468
772f49d1969d
(Fencode_time): Rewrite by Naggum.
Richard M. Stallman <rms@gnu.org>
parents:
11451
diff
changeset
|
1777 { |
13025
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1778 int abszone = abs (XINT (zone)); |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1779 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
|
1780 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
|
1781 tzstring = tzbuf; |
11468
772f49d1969d
(Fencode_time): Rewrite by Naggum.
Richard M. Stallman <rms@gnu.org>
parents:
11451
diff
changeset
|
1782 } |
13025
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1783 else |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1784 error ("Invalid time zone specification"); |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1785 |
30480 | 1786 /* 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
|
1787 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
|
1788 set_time_zone_rule (tzstring); |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1789 |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1790 time = mktime (&tm); |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1791 |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1792 /* Restore TZ to previous value. */ |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1793 newenv = environ; |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1794 environ = oldenv; |
16521
fe9cc0d392dd
(Fencode_time): Use xfree, not free.
Richard M. Stallman <rms@gnu.org>
parents:
16485
diff
changeset
|
1795 xfree (newenv); |
13025
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1796 #ifdef LOCALTIME_CACHE |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1797 tzset (); |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1798 #endif |
11468
772f49d1969d
(Fencode_time): Rewrite by Naggum.
Richard M. Stallman <rms@gnu.org>
parents:
11451
diff
changeset
|
1799 } |
11402
66d935214d8e
(Fencode_time): Use XINT to examine `zone'.
Richard M. Stallman <rms@gnu.org>
parents:
11263
diff
changeset
|
1800 |
13025
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1801 if (time == (time_t) -1) |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1802 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
|
1803 |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1804 return make_time (time); |
11402
66d935214d8e
(Fencode_time): Use XINT to examine `zone'.
Richard M. Stallman <rms@gnu.org>
parents:
11263
diff
changeset
|
1805 } |
66d935214d8e
(Fencode_time): Use XINT to examine `zone'.
Richard M. Stallman <rms@gnu.org>
parents:
11263
diff
changeset
|
1806 |
2154
69c58e548ca5
(Fcurrent_time_string): Optional arg specifies time.
Richard M. Stallman <rms@gnu.org>
parents:
2049
diff
changeset
|
1807 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
|
1808 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
|
1809 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
|
1810 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
|
1811 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
|
1812 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
|
1813 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
|
1814 |
56386
4f00fbfe3c1e
(Ffloat_time, Fformat_time_string, Fdecode_time)
Luc Teirlinck <teirllm@auburn.edu>
parents:
56194
diff
changeset
|
1815 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
|
1816 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
|
1817 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
|
1818 `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
|
1819 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
|
1820 (specified_time) |
2154
69c58e548ca5
(Fcurrent_time_string): Optional arg specifies time.
Richard M. Stallman <rms@gnu.org>
parents:
2049
diff
changeset
|
1821 Lisp_Object specified_time; |
305 | 1822 { |
2921
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1823 time_t value; |
305 | 1824 char buf[30]; |
2154
69c58e548ca5
(Fcurrent_time_string): Optional arg specifies time.
Richard M. Stallman <rms@gnu.org>
parents:
2049
diff
changeset
|
1825 register char *tem; |
69c58e548ca5
(Fcurrent_time_string): Optional arg specifies time.
Richard M. Stallman <rms@gnu.org>
parents:
2049
diff
changeset
|
1826 |
30480 | 1827 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
|
1828 value = -1; |
2154
69c58e548ca5
(Fcurrent_time_string): Optional arg specifies time.
Richard M. Stallman <rms@gnu.org>
parents:
2049
diff
changeset
|
1829 tem = (char *) ctime (&value); |
305 | 1830 |
1831 strncpy (buf, tem, 24); | |
1832 buf[24] = 0; | |
1833 | |
1834 return build_string (buf); | |
1835 } | |
962
3533821d6edc
* editfns.c (Fcurrent_time_zone): Doc fix.
Jim Blandy <jimb@redhat.com>
parents:
690
diff
changeset
|
1836 |
16269
79e6c47054c5
(tm_diff): Renamed from difftm. Yield int, not long.
Paul Eggert <eggert@twinsun.com>
parents:
16134
diff
changeset
|
1837 #define TM_YEAR_BASE 1900 |
2921
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1838 |
16269
79e6c47054c5
(tm_diff): Renamed from difftm. Yield int, not long.
Paul Eggert <eggert@twinsun.com>
parents:
16134
diff
changeset
|
1839 /* 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
|
1840 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
|
1841 static int |
79e6c47054c5
(tm_diff): Renamed from difftm. Yield int, not long.
Paul Eggert <eggert@twinsun.com>
parents:
16134
diff
changeset
|
1842 tm_diff (a, b) |
2921
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1843 struct tm *a, *b; |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1844 { |
16269
79e6c47054c5
(tm_diff): Renamed from difftm. Yield int, not long.
Paul Eggert <eggert@twinsun.com>
parents:
16134
diff
changeset
|
1845 /* 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
|
1846 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
|
1847 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
|
1848 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
|
1849 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
|
1850 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
|
1851 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
|
1852 int a400 = a100 >> 2; |
79e6c47054c5
(tm_diff): Renamed from difftm. Yield int, not long.
Paul Eggert <eggert@twinsun.com>
parents:
16134
diff
changeset
|
1853 int b400 = b100 >> 2; |
79e6c47054c5
(tm_diff): Renamed from difftm. Yield int, not long.
Paul Eggert <eggert@twinsun.com>
parents:
16134
diff
changeset
|
1854 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
|
1855 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
|
1856 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
|
1857 + (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
|
1858 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
|
1859 + (a->tm_min - b->tm_min)) |
5882 | 1860 + (a->tm_sec - b->tm_sec)); |
2921
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1861 } |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1862 |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1863 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
|
1864 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
|
1865 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
|
1866 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
|
1867 A negative value means west of Greenwich. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1868 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
|
1869 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
|
1870 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
|
1871 (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
|
1872 `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
|
1873 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
|
1874 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1875 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
|
1876 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
|
1877 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
|
1878 (specified_time) |
2921
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1879 Lisp_Object specified_time; |
962
3533821d6edc
* editfns.c (Fcurrent_time_zone): Doc fix.
Jim Blandy <jimb@redhat.com>
parents:
690
diff
changeset
|
1880 { |
2921
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1881 time_t value; |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1882 struct tm *t; |
23198
dddce768cf7a
(Fformat_time_string, Fdecode_time, Fcurrent_time_zone):
Paul Eggert <eggert@twinsun.com>
parents:
23197
diff
changeset
|
1883 struct tm gmt; |
962
3533821d6edc
* editfns.c (Fcurrent_time_zone): Doc fix.
Jim Blandy <jimb@redhat.com>
parents:
690
diff
changeset
|
1884 |
30480 | 1885 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
|
1886 && (t = gmtime (&value)) != 0 |
dddce768cf7a
(Fformat_time_string, Fdecode_time, Fcurrent_time_zone):
Paul Eggert <eggert@twinsun.com>
parents:
23197
diff
changeset
|
1887 && (gmt = *t, t = localtime (&value)) != 0) |
2921
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1888 { |
23198
dddce768cf7a
(Fformat_time_string, Fdecode_time, Fcurrent_time_zone):
Paul Eggert <eggert@twinsun.com>
parents:
23197
diff
changeset
|
1889 int offset = tm_diff (t, &gmt); |
dddce768cf7a
(Fformat_time_string, Fdecode_time, Fcurrent_time_zone):
Paul Eggert <eggert@twinsun.com>
parents:
23197
diff
changeset
|
1890 char *s = 0; |
dddce768cf7a
(Fformat_time_string, Fdecode_time, Fcurrent_time_zone):
Paul Eggert <eggert@twinsun.com>
parents:
23197
diff
changeset
|
1891 char buf[6]; |
2921
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1892 #ifdef HAVE_TM_ZONE |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1893 if (t->tm_zone) |
7506
9fa47d36798a
(Fcurrent_time_zone): Add cast.
Richard M. Stallman <rms@gnu.org>
parents:
7485
diff
changeset
|
1894 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
|
1895 #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
|
1896 #ifdef HAVE_TZNAME |
dc9f7a107e28
(Fcurrent_time_zone): Add alternative for !HAVE_TM_ZONE.
Richard M. Stallman <rms@gnu.org>
parents:
2994
diff
changeset
|
1897 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
|
1898 s = tzname[t->tm_isdst]; |
962
3533821d6edc
* editfns.c (Fcurrent_time_zone): Doc fix.
Jim Blandy <jimb@redhat.com>
parents:
690
diff
changeset
|
1899 #endif |
3522
dc9f7a107e28
(Fcurrent_time_zone): Add alternative for !HAVE_TM_ZONE.
Richard M. Stallman <rms@gnu.org>
parents:
2994
diff
changeset
|
1900 #endif /* not HAVE_TM_ZONE */ |
36479
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 #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
|
1903 if (s) |
ac3ee681e8f9
(Fcurrent_time_zone) [HAVE_TM_ZONE || HAVE_TZNAME]:
Gerd Moellmann <gerd@gnu.org>
parents:
35998
diff
changeset
|
1904 { |
ac3ee681e8f9
(Fcurrent_time_zone) [HAVE_TM_ZONE || HAVE_TZNAME]:
Gerd Moellmann <gerd@gnu.org>
parents:
35998
diff
changeset
|
1905 /* 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
|
1906 zone name. Don't accept that. */ |
ac3ee681e8f9
(Fcurrent_time_zone) [HAVE_TM_ZONE || HAVE_TZNAME]:
Gerd Moellmann <gerd@gnu.org>
parents:
35998
diff
changeset
|
1907 char *p; |
39720
e7c5b465528a
(Fcurrent_time_zone): Cast isalnum() argument to
Gerd Moellmann <gerd@gnu.org>
parents:
39682
diff
changeset
|
1908 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
|
1909 ; |
ac3ee681e8f9
(Fcurrent_time_zone) [HAVE_TM_ZONE || HAVE_TZNAME]:
Gerd Moellmann <gerd@gnu.org>
parents:
35998
diff
changeset
|
1910 if (p == s || *p) |
ac3ee681e8f9
(Fcurrent_time_zone) [HAVE_TM_ZONE || HAVE_TZNAME]:
Gerd Moellmann <gerd@gnu.org>
parents:
35998
diff
changeset
|
1911 s = NULL; |
ac3ee681e8f9
(Fcurrent_time_zone) [HAVE_TM_ZONE || HAVE_TZNAME]:
Gerd Moellmann <gerd@gnu.org>
parents:
35998
diff
changeset
|
1912 } |
ac3ee681e8f9
(Fcurrent_time_zone) [HAVE_TM_ZONE || HAVE_TZNAME]:
Gerd Moellmann <gerd@gnu.org>
parents:
35998
diff
changeset
|
1913 #endif |
ac3ee681e8f9
(Fcurrent_time_zone) [HAVE_TM_ZONE || HAVE_TZNAME]:
Gerd Moellmann <gerd@gnu.org>
parents:
35998
diff
changeset
|
1914 |
2921
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1915 if (!s) |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1916 { |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1917 /* 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
|
1918 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
|
1919 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
|
1920 s = buf; |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1921 } |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1922 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
|
1923 } |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1924 else |
18745
192b3ebd108e
(Fcurrent_time_zone): Convert Fmake_list argument to Lisp_Integer.
Richard M. Stallman <rms@gnu.org>
parents:
18661
diff
changeset
|
1925 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
|
1926 } |
3533821d6edc
* editfns.c (Fcurrent_time_zone): Doc fix.
Jim Blandy <jimb@redhat.com>
parents:
690
diff
changeset
|
1927 |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
1928 /* 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
|
1929 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
|
1930 has never been called. */ |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
1931 static char **environbuf; |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
1932 |
13019
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1933 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
|
1934 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
|
1935 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
|
1936 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
|
1937 (tz) |
13019
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1938 Lisp_Object tz; |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1939 { |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1940 char *tzstring; |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1941 |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1942 if (NILP (tz)) |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1943 tzstring = 0; |
18613
614b916ff5bf
Fix bugs with inappropriate mixing of Lisp_Object with int.
Richard M. Stallman <rms@gnu.org>
parents:
18605
diff
changeset
|
1944 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
|
1945 tzstring = "UTC0"; |
13019
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1946 else |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1947 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
1948 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
|
1949 tzstring = (char *) SDATA (tz); |
13019
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1950 } |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1951 |
13025
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1952 set_time_zone_rule (tzstring); |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1953 if (environbuf) |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1954 free (environbuf); |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1955 environbuf = environ; |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1956 |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1957 return Qnil; |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1958 } |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1959 |
16918
ab49512bcdff
(set_time_zone_rule_tz1, set_time_zone_rule_tz2):
Paul Eggert <eggert@twinsun.com>
parents:
16874
diff
changeset
|
1960 #ifdef LOCALTIME_CACHE |
ab49512bcdff
(set_time_zone_rule_tz1, set_time_zone_rule_tz2):
Paul Eggert <eggert@twinsun.com>
parents:
16874
diff
changeset
|
1961 |
ab49512bcdff
(set_time_zone_rule_tz1, set_time_zone_rule_tz2):
Paul Eggert <eggert@twinsun.com>
parents:
16874
diff
changeset
|
1962 /* 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
|
1963 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
|
1964 Their values shouldn't matter in non-buggy implementations. |
30480 | 1965 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
|
1966 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
|
1967 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
|
1968 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
|
1969 improperly modify environment''. */ |
80a852988718
(set_time_zone_rule): Don't put a string literal
Richard M. Stallman <rms@gnu.org>
parents:
15779
diff
changeset
|
1970 |
16918
ab49512bcdff
(set_time_zone_rule_tz1, set_time_zone_rule_tz2):
Paul Eggert <eggert@twinsun.com>
parents:
16874
diff
changeset
|
1971 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
|
1972 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
|
1973 |
ab49512bcdff
(set_time_zone_rule_tz1, set_time_zone_rule_tz2):
Paul Eggert <eggert@twinsun.com>
parents:
16874
diff
changeset
|
1974 #endif |
15841
80a852988718
(set_time_zone_rule): Don't put a string literal
Richard M. Stallman <rms@gnu.org>
parents:
15779
diff
changeset
|
1975 |
13025
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1976 /* 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
|
1977 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
|
1978 responsibility to free. */ |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
1979 |
14201
ff372902386d
(set_time_zone_rule): No longer static.
Richard M. Stallman <rms@gnu.org>
parents:
14126
diff
changeset
|
1980 void |
13025
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1981 set_time_zone_rule (tzstring) |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1982 char *tzstring; |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1983 { |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1984 int envptrs; |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1985 char **from, **to, **newenv; |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1986 |
15334 | 1987 /* 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
|
1988 for (from = environ; *from; from++) |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1989 continue; |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1990 envptrs = from - environ + 2; |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1991 newenv = to = (char **) xmalloc (envptrs * sizeof (char *) |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1992 + (tzstring ? strlen (tzstring) + 4 : 0)); |
15334 | 1993 |
1994 /* 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
|
1995 if (tzstring) |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1996 { |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1997 char *t = (char *) (to + envptrs); |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1998 strcpy (t, "TZ="); |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1999 strcat (t, tzstring); |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
2000 *to++ = t; |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
2001 } |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
2002 |
15334 | 2003 /* Copy the old environ vector elements into NEWENV, |
2004 but don't copy the TZ variable. | |
2005 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
|
2006 for (from = environ; *from; from++) |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
2007 if (strncmp (*from, "TZ=", 3) != 0) |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
2008 *to++ = *from; |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
2009 *to = 0; |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
2010 |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
2011 environ = newenv; |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
2012 |
15334 | 2013 /* If we do have a TZSTRING, NEWENV points to the vector slot where |
2014 the TZ variable is stored. If we do not have a TZSTRING, | |
2015 TO points to the vector slot which has the terminating null. */ | |
2016 | |
13019
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
2017 #ifdef LOCALTIME_CACHE |
15334 | 2018 { |
2019 /* In SunOS 4.1.3_U1 and 4.1.4, if TZ has a value like | |
2020 "US/Pacific" that loads a tz file, then changes to a value like | |
2021 "XXX0" that does not load a tz file, and then changes back to | |
2022 its original value, the last change is (incorrectly) ignored. | |
2023 Also, if TZ changes twice in succession to values that do | |
2024 not load a tz file, tzset can dump core (see Sun bug#1225179). | |
2025 The following code works around these bugs. */ | |
2026 | |
2027 if (tzstring) | |
2028 { | |
2029 /* Temporarily set TZ to a value that loads a tz file | |
2030 and that differs from tzstring. */ | |
2031 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
|
2032 *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
|
2033 ? set_time_zone_rule_tz2 : set_time_zone_rule_tz1); |
15334 | 2034 tzset (); |
2035 *newenv = tz; | |
2036 } | |
2037 else | |
2038 { | |
2039 /* The implied tzstring is unknown, so temporarily set TZ to | |
2040 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
|
2041 *to = set_time_zone_rule_tz1; |
15334 | 2042 to[1] = 0; |
2043 tzset (); | |
15841
80a852988718
(set_time_zone_rule): Don't put a string literal
Richard M. Stallman <rms@gnu.org>
parents:
15779
diff
changeset
|
2044 *to = set_time_zone_rule_tz2; |
15334 | 2045 tzset (); |
2046 *to = 0; | |
2047 } | |
2048 | |
2049 /* Now TZ has the desired value, and tzset can be invoked safely. */ | |
2050 } | |
2051 | |
13019
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
2052 tzset (); |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
2053 #endif |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
2054 } |
305 | 2055 |
17031 | 2056 /* Insert NARGS Lisp objects in the array ARGS by calling INSERT_FUNC |
2057 (if a type of object is Lisp_Int) or INSERT_FROM_STRING_FUNC (if a | |
2058 type of object is Lisp_String). INHERIT is passed to | |
2059 INSERT_FROM_STRING_FUNC as the last argument. */ | |
2060 | |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
2061 static void |
17031 | 2062 general_insert_function (insert_func, insert_from_string_func, |
2063 inherit, nargs, args) | |
46464
e05dd5b81fc7
(general_insert_function): Insertion function now
Ken Raeburn <raeburn@raeburn.org>
parents:
46447
diff
changeset
|
2064 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
|
2065 void (*insert_from_string_func) P_ ((Lisp_Object, int, int, int, int, int)); |
17031 | 2066 int inherit, nargs; |
2067 register Lisp_Object *args; | |
2068 { | |
2069 register int argnum; | |
2070 register Lisp_Object val; | |
2071 | |
2072 for (argnum = 0; argnum < nargs; argnum++) | |
2073 { | |
2074 val = args[argnum]; | |
2075 retry: | |
2076 if (INTEGERP (val)) | |
2077 { | |
26853
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2078 unsigned char str[MAX_MULTIBYTE_LENGTH]; |
17031 | 2079 int len; |
2080 | |
2081 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
|
2082 len = CHAR_STRING (XFASTINT (val), str); |
17031 | 2083 else |
22929
6dda0a4b882f
(general_insert_function): If enable-multibyte-characters is
Kenichi Handa <handa@m17n.org>
parents:
22895
diff
changeset
|
2084 { |
26853
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2085 str[0] = (SINGLE_BYTE_CHAR_P (XINT (val)) |
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2086 ? XINT (val) |
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2087 : 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
|
2088 len = 1; |
6dda0a4b882f
(general_insert_function): If enable-multibyte-characters is
Kenichi Handa <handa@m17n.org>
parents:
22895
diff
changeset
|
2089 } |
17031 | 2090 (*insert_func) (str, len); |
2091 } | |
2092 else if (STRINGP (val)) | |
2093 { | |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
2094 (*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
|
2095 SCHARS (val), |
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
2096 SBYTES (val), |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
2097 inherit); |
17031 | 2098 } |
2099 else | |
2100 { | |
2101 val = wrong_type_argument (Qchar_or_string_p, val); | |
2102 goto retry; | |
2103 } | |
2104 } | |
2105 } | |
2106 | |
305 | 2107 void |
2108 insert1 (arg) | |
2109 Lisp_Object arg; | |
2110 { | |
2111 Finsert (1, &arg); | |
2112 } | |
2113 | |
330 | 2114 |
2115 /* Callers passing one argument to Finsert need not gcpro the | |
2116 argument "array", since the only element of the array will | |
2117 not be used after calling insert or insert_from_string, so | |
2118 we don't care if it gets trashed. */ | |
2119 | |
305 | 2120 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
|
2121 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
|
2122 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
|
2123 after the inserted text. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2124 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
|
2125 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2126 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
|
2127 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
|
2128 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
|
2129 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
|
2130 |
41213ea7b9d6
(Finsert): Mention `string-make-multibyte' and
Kim F. Storm <storm@cua.dk>
parents:
49285
diff
changeset
|
2131 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
|
2132 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
|
2133 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
|
2134 and insert the result. |
40131
de086e415fa2
(Finsert, Finsert_and_inherit, Finsert_before_markers, Fmessage)
Miles Bader <miles@gnu.org>
parents:
40046
diff
changeset
|
2135 |
de086e415fa2
(Finsert, Finsert_and_inherit, Finsert_before_markers, Fmessage)
Miles Bader <miles@gnu.org>
parents:
40046
diff
changeset
|
2136 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
|
2137 (nargs, args) |
305 | 2138 int nargs; |
2139 register Lisp_Object *args; | |
2140 { | |
17031 | 2141 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
|
2142 return Qnil; |
350231e38e68
(Finsert_and_inherit): New function.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2143 } |
350231e38e68
(Finsert_and_inherit): New function.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2144 |
350231e38e68
(Finsert_and_inherit): New function.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2145 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
|
2146 0, MANY, 0, |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
2147 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
|
2148 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
|
2149 after the inserted text. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2150 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
|
2151 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2152 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
|
2153 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
|
2154 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
|
2155 to unibyte for insertion. |
de086e415fa2
(Finsert, Finsert_and_inherit, Finsert_before_markers, Fmessage)
Miles Bader <miles@gnu.org>
parents:
40046
diff
changeset
|
2156 |
de086e415fa2
(Finsert, Finsert_and_inherit, Finsert_before_markers, Fmessage)
Miles Bader <miles@gnu.org>
parents:
40046
diff
changeset
|
2157 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
|
2158 (nargs, args) |
4714
350231e38e68
(Finsert_and_inherit): New function.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2159 int nargs; |
350231e38e68
(Finsert_and_inherit): New function.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2160 register Lisp_Object *args; |
350231e38e68
(Finsert_and_inherit): New function.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2161 { |
17031 | 2162 general_insert_function (insert_and_inherit, insert_from_string, 1, |
2163 nargs, args); | |
305 | 2164 return Qnil; |
2165 } | |
2166 | |
2167 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
|
2168 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
|
2169 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
|
2170 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2171 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
|
2172 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
|
2173 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
|
2174 to unibyte for insertion. |
de086e415fa2
(Finsert, Finsert_and_inherit, Finsert_before_markers, Fmessage)
Miles Bader <miles@gnu.org>
parents:
40046
diff
changeset
|
2175 |
de086e415fa2
(Finsert, Finsert_and_inherit, Finsert_before_markers, Fmessage)
Miles Bader <miles@gnu.org>
parents:
40046
diff
changeset
|
2176 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
|
2177 (nargs, args) |
305 | 2178 int nargs; |
2179 register Lisp_Object *args; | |
2180 { | |
17031 | 2181 general_insert_function (insert_before_markers, |
2182 insert_from_string_before_markers, 0, | |
2183 nargs, args); | |
4714
350231e38e68
(Finsert_and_inherit): New function.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2184 return Qnil; |
350231e38e68
(Finsert_and_inherit): New function.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2185 } |
350231e38e68
(Finsert_and_inherit): New function.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2186 |
16485
9b919c5464a4
Reorganize function definitions so etags finds them.
Erik Naggum <erik@naggum.no>
parents:
16298
diff
changeset
|
2187 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
|
2188 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
|
2189 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
|
2190 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
|
2191 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2192 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
|
2193 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
|
2194 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
|
2195 to unibyte for insertion. |
de086e415fa2
(Finsert, Finsert_and_inherit, Finsert_before_markers, Fmessage)
Miles Bader <miles@gnu.org>
parents:
40046
diff
changeset
|
2196 |
de086e415fa2
(Finsert, Finsert_and_inherit, Finsert_before_markers, Fmessage)
Miles Bader <miles@gnu.org>
parents:
40046
diff
changeset
|
2197 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
|
2198 (nargs, args) |
4714
350231e38e68
(Finsert_and_inherit): New function.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2199 int nargs; |
350231e38e68
(Finsert_and_inherit): New function.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2200 register Lisp_Object *args; |
350231e38e68
(Finsert_and_inherit): New function.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2201 { |
17031 | 2202 general_insert_function (insert_before_markers_and_inherit, |
2203 insert_from_string_before_markers, 1, | |
2204 nargs, args); | |
305 | 2205 return Qnil; |
2206 } | |
2207 | |
8646
0f05e3e89f87
(Finsert_char): New arg INHERIT.
Richard M. Stallman <rms@gnu.org>
parents:
8333
diff
changeset
|
2208 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
|
2209 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
|
2210 Both arguments are required. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2211 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
|
2212 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
|
2213 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
|
2214 (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
|
2215 Lisp_Object character, count, inherit; |
305 | 2216 { |
2217 register unsigned char *string; | |
2218 register int strlen; | |
2219 register int i, n; | |
17031 | 2220 int len; |
26853
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2221 unsigned char str[MAX_MULTIBYTE_LENGTH]; |
305 | 2222 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
2223 CHECK_NUMBER (character); |
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
2224 CHECK_NUMBER (count); |
305 | 2225 |
17031 | 2226 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
|
2227 len = CHAR_STRING (XFASTINT (character), str); |
17031 | 2228 else |
26853
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2229 str[0] = XFASTINT (character), len = 1; |
17031 | 2230 n = XINT (count) * len; |
305 | 2231 if (n <= 0) |
2232 return Qnil; | |
17031 | 2233 strlen = min (n, 256 * len); |
305 | 2234 string = (unsigned char *) alloca (strlen); |
2235 for (i = 0; i < strlen; i++) | |
17031 | 2236 string[i] = str[i % len]; |
305 | 2237 while (n >= strlen) |
2238 { | |
18194
c291aa915b85
(Finsert_char): Check QUIT.
Richard M. Stallman <rms@gnu.org>
parents:
18106
diff
changeset
|
2239 QUIT; |
8646
0f05e3e89f87
(Finsert_char): New arg INHERIT.
Richard M. Stallman <rms@gnu.org>
parents:
8333
diff
changeset
|
2240 if (!NILP (inherit)) |
0f05e3e89f87
(Finsert_char): New arg INHERIT.
Richard M. Stallman <rms@gnu.org>
parents:
8333
diff
changeset
|
2241 insert_and_inherit (string, strlen); |
0f05e3e89f87
(Finsert_char): New arg INHERIT.
Richard M. Stallman <rms@gnu.org>
parents:
8333
diff
changeset
|
2242 else |
0f05e3e89f87
(Finsert_char): New arg INHERIT.
Richard M. Stallman <rms@gnu.org>
parents:
8333
diff
changeset
|
2243 insert (string, strlen); |
305 | 2244 n -= strlen; |
2245 } | |
2246 if (n > 0) | |
10382
9738aad59697
(Finsert_char): Check inherit flag for long strings too.
Karl Heuer <kwzh@gnu.org>
parents:
10308
diff
changeset
|
2247 { |
9738aad59697
(Finsert_char): Check inherit flag for long strings too.
Karl Heuer <kwzh@gnu.org>
parents:
10308
diff
changeset
|
2248 if (!NILP (inherit)) |
9738aad59697
(Finsert_char): Check inherit flag for long strings too.
Karl Heuer <kwzh@gnu.org>
parents:
10308
diff
changeset
|
2249 insert_and_inherit (string, n); |
9738aad59697
(Finsert_char): Check inherit flag for long strings too.
Karl Heuer <kwzh@gnu.org>
parents:
10308
diff
changeset
|
2250 else |
9738aad59697
(Finsert_char): Check inherit flag for long strings too.
Karl Heuer <kwzh@gnu.org>
parents:
10308
diff
changeset
|
2251 insert (string, n); |
9738aad59697
(Finsert_char): Check inherit flag for long strings too.
Karl Heuer <kwzh@gnu.org>
parents:
10308
diff
changeset
|
2252 } |
305 | 2253 return Qnil; |
2254 } | |
2255 | |
2256 | |
648 | 2257 /* Making strings from buffer contents. */ |
2258 | |
2259 /* 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
|
2260 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
|
2261 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
|
2262 have them, if PROPS is nonzero. |
648 | 2263 |
2264 We don't want to use plain old make_string here, because it calls | |
2265 make_uninit_string, which can cause the buffer arena to be | |
2266 compacted. make_string has no way of knowing that the data has | |
2267 been moved, and thus copies the wrong data into the string. This | |
2268 doesn't effect most of the other users of make_string, so it should | |
2269 be left as is. But we should use this function when conjuring | |
2270 buffer substrings. */ | |
1285
d50533e23dff
* editfns.c (make_buffer_string): Call copy_intervals_to_string().
Joseph Arceneaux <jla@gnu.org>
parents:
1254
diff
changeset
|
2271 |
648 | 2272 Lisp_Object |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2273 make_buffer_string (start, end, props) |
648 | 2274 int start, end; |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2275 int props; |
648 | 2276 { |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
2277 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
|
2278 int end_byte = CHAR_TO_BYTE (end); |
648 | 2279 |
21235
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2280 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
|
2281 } |
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2282 |
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2283 /* 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
|
2284 START / START_BYTE to END / END_BYTE. |
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2285 |
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2286 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
|
2287 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
|
2288 have them, if PROPS is nonzero. |
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2289 |
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2290 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
|
2291 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
|
2292 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
|
2293 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
|
2294 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
|
2295 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
|
2296 buffer substrings. */ |
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2297 |
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2298 Lisp_Object |
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2299 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
|
2300 int start, start_byte, end, end_byte; |
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2301 int props; |
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 Lisp_Object result, tem, tem1; |
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2304 |
648 | 2305 if (start < GPT && GPT < end) |
2306 move_gap (start); | |
2307 | |
21257
205a5aa4aa2f
(Fchar_to_string): Use make_string_from_bytes.
Richard M. Stallman <rms@gnu.org>
parents:
21245
diff
changeset
|
2308 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
|
2309 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
|
2310 else |
205a5aa4aa2f
(Fchar_to_string): Use make_string_from_bytes.
Richard M. Stallman <rms@gnu.org>
parents:
21245
diff
changeset
|
2311 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
|
2312 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
|
2313 end_byte - start_byte); |
648 | 2314 |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2315 /* 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
|
2316 if (props) |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2317 { |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2318 update_buffer_properties (start, end); |
5130
ddee29e260d2
(make_buffer_string): Don't copy intervals
Richard M. Stallman <rms@gnu.org>
parents:
4943
diff
changeset
|
2319 |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2320 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
|
2321 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
|
2322 |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2323 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
|
2324 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
|
2325 end - start); |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2326 } |
1285
d50533e23dff
* editfns.c (make_buffer_string): Call copy_intervals_to_string().
Joseph Arceneaux <jla@gnu.org>
parents:
1254
diff
changeset
|
2327 |
648 | 2328 return result; |
2329 } | |
305 | 2330 |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2331 /* 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
|
2332 in the current buffer, if necessary. */ |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2333 |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2334 static void |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2335 update_buffer_properties (start, end) |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2336 int start, end; |
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 /* 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
|
2339 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
|
2340 if (!NILP (Vbuffer_access_fontify_functions)) |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2341 { |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2342 Lisp_Object args[3]; |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2343 Lisp_Object tem; |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2344 |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2345 args[0] = Qbuffer_access_fontify_functions; |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2346 XSETINT (args[1], start); |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2347 XSETINT (args[2], end); |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2348 |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2349 /* 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
|
2350 has already been done. */ |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2351 if (!NILP (Vbuffer_access_fontified_property)) |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2352 { |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2353 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
|
2354 Vbuffer_access_fontified_property, |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2355 Qnil, Qnil); |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2356 if (! NILP (tem)) |
14126
edc94b82c3b3
(update_buffer_properties): Delete superfluous &'s.
Karl Heuer <kwzh@gnu.org>
parents:
14071
diff
changeset
|
2357 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
|
2358 } |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2359 else |
14126
edc94b82c3b3
(update_buffer_properties): Delete superfluous &'s.
Karl Heuer <kwzh@gnu.org>
parents:
14071
diff
changeset
|
2360 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
|
2361 } |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2362 } |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2363 |
305 | 2364 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
|
2365 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
|
2366 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
|
2367 they can be in either order. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2368 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
|
2369 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2370 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
|
2371 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
|
2372 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
|
2373 (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
|
2374 Lisp_Object start, end; |
305 | 2375 { |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2376 register int b, e; |
305 | 2377 |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2378 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
|
2379 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
|
2380 e = XINT (end); |
305 | 2381 |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2382 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
|
2383 } |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2384 |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2385 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
|
2386 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
|
2387 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
|
2388 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
|
2389 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
|
2390 (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
|
2391 Lisp_Object start, end; |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2392 { |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2393 register int b, e; |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2394 |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2395 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
|
2396 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
|
2397 e = XINT (end); |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2398 |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2399 return make_buffer_string (b, e, 0); |
305 | 2400 } |
2401 | |
2402 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
|
2403 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
|
2404 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
|
2405 of the buffer. */) |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
2406 () |
305 | 2407 { |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
2408 return make_buffer_string (BEGV, ZV, 1); |
305 | 2409 } |
2410 | |
2411 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
|
2412 1, 3, 0, |
55424
04990cada43d
(Finsert_buffer_substring): Make argument names match their use in
Juanma Barranquero <lekktu@gmail.com>
parents:
55193
diff
changeset
|
2413 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
|
2414 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
|
2415 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
|
2416 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
|
2417 (buffer, start, end) |
04990cada43d
(Finsert_buffer_substring): Make argument names match their use in
Juanma Barranquero <lekktu@gmail.com>
parents:
55193
diff
changeset
|
2418 Lisp_Object buffer, start, end; |
305 | 2419 { |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2420 register int b, e, temp; |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2421 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
|
2422 Lisp_Object buf; |
04990cada43d
(Finsert_buffer_substring): Make argument names match their use in
Juanma Barranquero <lekktu@gmail.com>
parents:
55193
diff
changeset
|
2423 |
04990cada43d
(Finsert_buffer_substring): Make argument names match their use in
Juanma Barranquero <lekktu@gmail.com>
parents:
55193
diff
changeset
|
2424 buf = Fget_buffer (buffer); |
04990cada43d
(Finsert_buffer_substring): Make argument names match their use in
Juanma Barranquero <lekktu@gmail.com>
parents:
55193
diff
changeset
|
2425 if (NILP (buf)) |
04990cada43d
(Finsert_buffer_substring): Make argument names match their use in
Juanma Barranquero <lekktu@gmail.com>
parents:
55193
diff
changeset
|
2426 nsberror (buffer); |
04990cada43d
(Finsert_buffer_substring): Make argument names match their use in
Juanma Barranquero <lekktu@gmail.com>
parents:
55193
diff
changeset
|
2427 bp = XBUFFER (buf); |
16134
7558d82368f9
(Finsert_buffer_substring): Check for deleted buffer.
Karl Heuer <kwzh@gnu.org>
parents:
16097
diff
changeset
|
2428 if (NILP (bp->name)) |
7558d82368f9
(Finsert_buffer_substring): Check for deleted buffer.
Karl Heuer <kwzh@gnu.org>
parents:
16097
diff
changeset
|
2429 error ("Selecting deleted buffer"); |
305 | 2430 |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2431 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
|
2432 b = BUF_BEGV (bp); |
305 | 2433 else |
2434 { | |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
2435 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
|
2436 b = XINT (start); |
305 | 2437 } |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2438 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
|
2439 e = BUF_ZV (bp); |
305 | 2440 else |
2441 { | |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
2442 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
|
2443 e = XINT (end); |
305 | 2444 } |
2445 | |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2446 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
|
2447 temp = b, b = e, e = temp; |
305 | 2448 |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2449 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
|
2450 args_out_of_range (start, end); |
305 | 2451 |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2452 obuf = current_buffer; |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2453 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
|
2454 update_buffer_properties (b, e); |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2455 set_buffer_internal_1 (obuf); |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2456 |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2457 insert_from_buffer (bp, b, e - b, 0); |
305 | 2458 return Qnil; |
2459 } | |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2460 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2461 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
|
2462 6, 6, 0, |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
2463 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
|
2464 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
|
2465 +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
|
2466 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
|
2467 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
|
2468 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2469 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
|
2470 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
|
2471 (buffer1, start1, end1, buffer2, start2, end2) |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2472 Lisp_Object buffer1, start1, end1, buffer2, start2, end2; |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2473 { |
21837
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2474 register int begp1, endp1, begp2, endp2, temp; |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2475 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
|
2476 register Lisp_Object *trt |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2477 = (!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
|
2478 ? 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
|
2479 int chars = 0; |
21837
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2480 int i1, i2, i1_byte, i2_byte; |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2481 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2482 /* Find the first buffer and its substring. */ |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2483 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2484 if (NILP (buffer1)) |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2485 bp1 = current_buffer; |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2486 else |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2487 { |
1854
5a18c36181fa
(Finsert_buffer_substring): Proper error for non-ex buffer.
Richard M. Stallman <rms@gnu.org>
parents:
1853
diff
changeset
|
2488 Lisp_Object buf1; |
5a18c36181fa
(Finsert_buffer_substring): Proper error for non-ex buffer.
Richard M. Stallman <rms@gnu.org>
parents:
1853
diff
changeset
|
2489 buf1 = Fget_buffer (buffer1); |
5a18c36181fa
(Finsert_buffer_substring): Proper error for non-ex buffer.
Richard M. Stallman <rms@gnu.org>
parents:
1853
diff
changeset
|
2490 if (NILP (buf1)) |
5a18c36181fa
(Finsert_buffer_substring): Proper error for non-ex buffer.
Richard M. Stallman <rms@gnu.org>
parents:
1853
diff
changeset
|
2491 nsberror (buffer1); |
5a18c36181fa
(Finsert_buffer_substring): Proper error for non-ex buffer.
Richard M. Stallman <rms@gnu.org>
parents:
1853
diff
changeset
|
2492 bp1 = XBUFFER (buf1); |
16134
7558d82368f9
(Finsert_buffer_substring): Check for deleted buffer.
Karl Heuer <kwzh@gnu.org>
parents:
16097
diff
changeset
|
2493 if (NILP (bp1->name)) |
7558d82368f9
(Finsert_buffer_substring): Check for deleted buffer.
Karl Heuer <kwzh@gnu.org>
parents:
16097
diff
changeset
|
2494 error ("Selecting deleted buffer"); |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2495 } |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2496 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2497 if (NILP (start1)) |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2498 begp1 = BUF_BEGV (bp1); |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2499 else |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2500 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
2501 CHECK_NUMBER_COERCE_MARKER (start1); |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2502 begp1 = XINT (start1); |
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 (end1)) |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2505 endp1 = BUF_ZV (bp1); |
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 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
2508 CHECK_NUMBER_COERCE_MARKER (end1); |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2509 endp1 = XINT (end1); |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2510 } |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2511 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2512 if (begp1 > endp1) |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2513 temp = begp1, begp1 = endp1, endp1 = temp; |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2514 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2515 if (!(BUF_BEGV (bp1) <= begp1 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2516 && begp1 <= endp1 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2517 && endp1 <= BUF_ZV (bp1))) |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2518 args_out_of_range (start1, end1); |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2519 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2520 /* Likewise for second substring. */ |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2521 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2522 if (NILP (buffer2)) |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2523 bp2 = current_buffer; |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2524 else |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2525 { |
1854
5a18c36181fa
(Finsert_buffer_substring): Proper error for non-ex buffer.
Richard M. Stallman <rms@gnu.org>
parents:
1853
diff
changeset
|
2526 Lisp_Object buf2; |
5a18c36181fa
(Finsert_buffer_substring): Proper error for non-ex buffer.
Richard M. Stallman <rms@gnu.org>
parents:
1853
diff
changeset
|
2527 buf2 = Fget_buffer (buffer2); |
5a18c36181fa
(Finsert_buffer_substring): Proper error for non-ex buffer.
Richard M. Stallman <rms@gnu.org>
parents:
1853
diff
changeset
|
2528 if (NILP (buf2)) |
5a18c36181fa
(Finsert_buffer_substring): Proper error for non-ex buffer.
Richard M. Stallman <rms@gnu.org>
parents:
1853
diff
changeset
|
2529 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
|
2530 bp2 = XBUFFER (buf2); |
16134
7558d82368f9
(Finsert_buffer_substring): Check for deleted buffer.
Karl Heuer <kwzh@gnu.org>
parents:
16097
diff
changeset
|
2531 if (NILP (bp2->name)) |
7558d82368f9
(Finsert_buffer_substring): Check for deleted buffer.
Karl Heuer <kwzh@gnu.org>
parents:
16097
diff
changeset
|
2532 error ("Selecting deleted buffer"); |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2533 } |
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 (NILP (start2)) |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2536 begp2 = BUF_BEGV (bp2); |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2537 else |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2538 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
2539 CHECK_NUMBER_COERCE_MARKER (start2); |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2540 begp2 = XINT (start2); |
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 (end2)) |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2543 endp2 = BUF_ZV (bp2); |
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 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
2546 CHECK_NUMBER_COERCE_MARKER (end2); |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2547 endp2 = XINT (end2); |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2548 } |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2549 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2550 if (begp2 > endp2) |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2551 temp = begp2, begp2 = endp2, endp2 = temp; |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2552 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2553 if (!(BUF_BEGV (bp2) <= begp2 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2554 && begp2 <= endp2 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2555 && endp2 <= BUF_ZV (bp2))) |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2556 args_out_of_range (start2, end2); |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2557 |
21837
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2558 i1 = begp1; |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2559 i2 = begp2; |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2560 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
|
2561 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
|
2562 |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2563 while (i1 < endp1 && i2 < endp2) |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2564 { |
21837
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2565 /* 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
|
2566 characters, not just the bytes. */ |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2567 int c1, c2; |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2568 |
42116
37b724c77b98
(Fcompare_buffer_substrings): Add QUIT to main loop.
Richard M. Stallman <rms@gnu.org>
parents:
41065
diff
changeset
|
2569 QUIT; |
37b724c77b98
(Fcompare_buffer_substrings): Add QUIT to main loop.
Richard M. Stallman <rms@gnu.org>
parents:
41065
diff
changeset
|
2570 |
21837
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2571 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
|
2572 { |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2573 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
|
2574 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
|
2575 i1++; |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2576 } |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2577 else |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2578 { |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2579 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
|
2580 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
|
2581 i1++; |
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 |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2584 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
|
2585 { |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2586 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
|
2587 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
|
2588 i2++; |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2589 } |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2590 else |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2591 { |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2592 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
|
2593 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
|
2594 i2++; |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2595 } |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
2596 |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2597 if (trt) |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2598 { |
18106
b129c5fd7925
(Fcompare_buffer_substrings): trt contains Lisp_Objects.
Richard M. Stallman <rms@gnu.org>
parents:
18031
diff
changeset
|
2599 c1 = XINT (trt[c1]); |
b129c5fd7925
(Fcompare_buffer_substrings): trt contains Lisp_Objects.
Richard M. Stallman <rms@gnu.org>
parents:
18031
diff
changeset
|
2600 c2 = XINT (trt[c2]); |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2601 } |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2602 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
|
2603 return make_number (- 1 - chars); |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2604 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
|
2605 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
|
2606 |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2607 chars++; |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2608 } |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2609 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2610 /* The strings match as far as they go. |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2611 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
|
2612 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
|
2613 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
|
2614 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
|
2615 return make_number (- chars - 1); |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2616 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2617 /* Same length too => they are equal. */ |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2618 return make_number (0); |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2619 } |
305 | 2620 |
10480
fbb254882b9f
(subst_char_in_region_unwind): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10383
diff
changeset
|
2621 static Lisp_Object |
fbb254882b9f
(subst_char_in_region_unwind): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10383
diff
changeset
|
2622 subst_char_in_region_unwind (arg) |
fbb254882b9f
(subst_char_in_region_unwind): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10383
diff
changeset
|
2623 Lisp_Object arg; |
fbb254882b9f
(subst_char_in_region_unwind): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10383
diff
changeset
|
2624 { |
fbb254882b9f
(subst_char_in_region_unwind): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10383
diff
changeset
|
2625 return current_buffer->undo_list = arg; |
fbb254882b9f
(subst_char_in_region_unwind): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10383
diff
changeset
|
2626 } |
fbb254882b9f
(subst_char_in_region_unwind): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10383
diff
changeset
|
2627 |
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
|
2628 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
|
2629 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
|
2630 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
|
2631 { |
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
|
2632 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
|
2633 } |
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
|
2634 |
305 | 2635 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
|
2636 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
|
2637 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
|
2638 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
|
2639 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
|
2640 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
|
2641 (start, end, fromchar, tochar, noundo) |
305 | 2642 Lisp_Object start, end, fromchar, tochar, noundo; |
2643 { | |
20834
95a80c1e06c3
(Fsubst_char_in_region): Handle character-base
Kenichi Handa <handa@m17n.org>
parents:
20826
diff
changeset
|
2644 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
|
2645 int changed = 0; |
26853
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2646 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
|
2647 unsigned char *p; |
46293
1fb8f75062c6
Use macro SPECPDL_INDEX.
Juanma Barranquero <lekktu@gmail.com>
parents:
45398
diff
changeset
|
2648 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
|
2649 #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
|
2650 #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
|
2651 #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
|
2652 #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
|
2653 int maybe_byte_combining = COMBINING_NO; |
32420
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
2654 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
|
2655 int multibyte_p = !NILP (current_buffer->enable_multibyte_characters); |
305 | 2656 |
2657 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
|
2658 CHECK_NUMBER (fromchar); |
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
2659 CHECK_NUMBER (tochar); |
305 | 2660 |
28358
7ae3851c0a19
(Fsubst_char_in_region): Don't use INC_POS in unibyte
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2661 if (multibyte_p) |
17031 | 2662 { |
26853
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2663 len = CHAR_STRING (XFASTINT (fromchar), fromstr); |
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2664 if (CHAR_STRING (XFASTINT (tochar), tostr) != len) |
17031 | 2665 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
|
2666 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
|
2667 { |
b9b4581adf36
(Fsubst_char_in_region): Adjust the way to check byte-combining
Kenichi Handa <handa@m17n.org>
parents:
25346
diff
changeset
|
2668 /* 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
|
2669 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
|
2670 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
|
2671 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
|
2672 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
|
2673 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
|
2674 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
|
2675 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
|
2676 } |
17031 | 2677 } |
2678 else | |
2679 { | |
2680 len = 1; | |
26853
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2681 fromstr[0] = XFASTINT (fromchar); |
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2682 tostr[0] = XFASTINT (tochar); |
17031 | 2683 } |
2684 | |
20834
95a80c1e06c3
(Fsubst_char_in_region): Handle character-base
Kenichi Handa <handa@m17n.org>
parents:
20826
diff
changeset
|
2685 pos = XINT (start); |
95a80c1e06c3
(Fsubst_char_in_region): Handle character-base
Kenichi Handa <handa@m17n.org>
parents:
20826
diff
changeset
|
2686 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
|
2687 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
|
2688 end_byte = stop; |
305 | 2689 |
10480
fbb254882b9f
(subst_char_in_region_unwind): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10383
diff
changeset
|
2690 /* 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
|
2691 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
|
2692 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
|
2693 Also inhibit locking the file. */ |
10480
fbb254882b9f
(subst_char_in_region_unwind): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10383
diff
changeset
|
2694 if (!NILP (noundo)) |
fbb254882b9f
(subst_char_in_region_unwind): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10383
diff
changeset
|
2695 { |
fbb254882b9f
(subst_char_in_region_unwind): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10383
diff
changeset
|
2696 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
|
2697 current_buffer->undo_list); |
fbb254882b9f
(subst_char_in_region_unwind): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10383
diff
changeset
|
2698 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
|
2699 /* 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
|
2700 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
|
2701 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
|
2702 current_buffer->filename = Qnil; |
10480
fbb254882b9f
(subst_char_in_region_unwind): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10383
diff
changeset
|
2703 } |
fbb254882b9f
(subst_char_in_region_unwind): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10383
diff
changeset
|
2704 |
20834
95a80c1e06c3
(Fsubst_char_in_region): Handle character-base
Kenichi Handa <handa@m17n.org>
parents:
20826
diff
changeset
|
2705 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
|
2706 stop = min (stop, GPT_BYTE); |
17031 | 2707 while (1) |
305 | 2708 { |
23554
e06e84c477fa
(Fsubst_char_in_region): Correctly handle the case
Kenichi Handa <handa@m17n.org>
parents:
23553
diff
changeset
|
2709 int pos_byte_next = pos_byte; |
e06e84c477fa
(Fsubst_char_in_region): Correctly handle the case
Kenichi Handa <handa@m17n.org>
parents:
23553
diff
changeset
|
2710 |
20834
95a80c1e06c3
(Fsubst_char_in_region): Handle character-base
Kenichi Handa <handa@m17n.org>
parents:
20826
diff
changeset
|
2711 if (pos_byte >= stop) |
17031 | 2712 { |
20834
95a80c1e06c3
(Fsubst_char_in_region): Handle character-base
Kenichi Handa <handa@m17n.org>
parents:
20826
diff
changeset
|
2713 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
|
2714 stop = end_byte; |
17031 | 2715 } |
20834
95a80c1e06c3
(Fsubst_char_in_region): Handle character-base
Kenichi Handa <handa@m17n.org>
parents:
20826
diff
changeset
|
2716 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
|
2717 if (multibyte_p) |
7ae3851c0a19
(Fsubst_char_in_region): Don't use INC_POS in unibyte
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2718 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
|
2719 else |
7ae3851c0a19
(Fsubst_char_in_region): Don't use INC_POS in unibyte
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2720 ++pos_byte_next; |
23554
e06e84c477fa
(Fsubst_char_in_region): Correctly handle the case
Kenichi Handa <handa@m17n.org>
parents:
23553
diff
changeset
|
2721 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
|
2722 && p[0] == fromstr[0] |
17031 | 2723 && (len == 1 |
2724 || (p[1] == fromstr[1] | |
2725 && (len == 2 || (p[2] == fromstr[2] | |
2726 && (len == 3 || p[3] == fromstr[3])))))) | |
305 | 2727 { |
5130
ddee29e260d2
(make_buffer_string): Don't copy intervals
Richard M. Stallman <rms@gnu.org>
parents:
4943
diff
changeset
|
2728 if (! changed) |
ddee29e260d2
(make_buffer_string): Don't copy intervals
Richard M. Stallman <rms@gnu.org>
parents:
4943
diff
changeset
|
2729 { |
26853
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2730 changed = pos; |
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2731 modify_region (current_buffer, changed, XINT (end)); |
5242
0e99ea9941e2
(Fmessage): Use message2.
Richard M. Stallman <rms@gnu.org>
parents:
5130
diff
changeset
|
2732 |
0e99ea9941e2
(Fmessage): Use message2.
Richard M. Stallman <rms@gnu.org>
parents:
5130
diff
changeset
|
2733 if (! NILP (noundo)) |
0e99ea9941e2
(Fmessage): Use message2.
Richard M. Stallman <rms@gnu.org>
parents:
5130
diff
changeset
|
2734 { |
10308
90784ed0416f
Use SAVE_MODIFF and BUF_SAVE_MODIFF
Richard M. Stallman <rms@gnu.org>
parents:
9812
diff
changeset
|
2735 if (MODIFF - 1 == SAVE_MODIFF) |
90784ed0416f
Use SAVE_MODIFF and BUF_SAVE_MODIFF
Richard M. Stallman <rms@gnu.org>
parents:
9812
diff
changeset
|
2736 SAVE_MODIFF++; |
5242
0e99ea9941e2
(Fmessage): Use message2.
Richard M. Stallman <rms@gnu.org>
parents:
5130
diff
changeset
|
2737 if (MODIFF - 1 == current_buffer->auto_save_modified) |
0e99ea9941e2
(Fmessage): Use message2.
Richard M. Stallman <rms@gnu.org>
parents:
5130
diff
changeset
|
2738 current_buffer->auto_save_modified++; |
0e99ea9941e2
(Fmessage): Use message2.
Richard M. Stallman <rms@gnu.org>
parents:
5130
diff
changeset
|
2739 } |
5130
ddee29e260d2
(make_buffer_string): Don't copy intervals
Richard M. Stallman <rms@gnu.org>
parents:
4943
diff
changeset
|
2740 } |
ddee29e260d2
(make_buffer_string): Don't copy intervals
Richard M. Stallman <rms@gnu.org>
parents:
4943
diff
changeset
|
2741 |
22895
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2742 /* Take care of the case where the new character |
30480 | 2743 combines with neighboring bytes. */ |
23554
e06e84c477fa
(Fsubst_char_in_region): Correctly handle the case
Kenichi Handa <handa@m17n.org>
parents:
23553
diff
changeset
|
2744 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
|
2745 && (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
|
2746 ? (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
|
2747 && ! 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
|
2748 : ((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
|
2749 && ! 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
|
2750 || (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
|
2751 && ! 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
|
2752 { |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2753 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
|
2754 |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2755 struct gcpro gcpro1; |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2756 |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2757 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
|
2758 GCPRO1 (tem); |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2759 |
25507
b9b4581adf36
(Fsubst_char_in_region): Adjust the way to check byte-combining
Kenichi Handa <handa@m17n.org>
parents:
25346
diff
changeset
|
2760 /* 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
|
2761 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
|
2762 /* 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
|
2763 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
|
2764 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
|
2765 0, 0, 1); |
23554
e06e84c477fa
(Fsubst_char_in_region): Correctly handle the case
Kenichi Handa <handa@m17n.org>
parents:
23553
diff
changeset
|
2766 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
|
2767 if (pos_byte_next > pos_byte) |
e06e84c477fa
(Fsubst_char_in_region): Correctly handle the case
Kenichi Handa <handa@m17n.org>
parents:
23553
diff
changeset
|
2768 /* 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
|
2769 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
|
2770 decrease it now. */ |
077655e1e014
(Fsubst_char_in_region): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23554
diff
changeset
|
2771 pos--; |
23554
e06e84c477fa
(Fsubst_char_in_region): Correctly handle the case
Kenichi Handa <handa@m17n.org>
parents:
23553
diff
changeset
|
2772 else |
23565
077655e1e014
(Fsubst_char_in_region): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23554
diff
changeset
|
2773 INC_POS (pos_byte_next); |
30480 | 2774 |
22895
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2775 if (! NILP (noundo)) |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2776 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
|
2777 |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2778 UNGCPRO; |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2779 } |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2780 else |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2781 { |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2782 if (NILP (noundo)) |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2783 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
|
2784 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
|
2785 } |
26853
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2786 last_changed = pos + 1; |
305 | 2787 } |
23565
077655e1e014
(Fsubst_char_in_region): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23554
diff
changeset
|
2788 pos_byte = pos_byte_next; |
077655e1e014
(Fsubst_char_in_region): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23554
diff
changeset
|
2789 pos++; |
305 | 2790 } |
2791 | |
5130
ddee29e260d2
(make_buffer_string): Don't copy intervals
Richard M. Stallman <rms@gnu.org>
parents:
4943
diff
changeset
|
2792 if (changed) |
26853
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2793 { |
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2794 signal_after_change (changed, |
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2795 last_changed - changed, last_changed - changed); |
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2796 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
|
2797 } |
5130
ddee29e260d2
(make_buffer_string): Don't copy intervals
Richard M. Stallman <rms@gnu.org>
parents:
4943
diff
changeset
|
2798 |
10480
fbb254882b9f
(subst_char_in_region_unwind): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10383
diff
changeset
|
2799 unbind_to (count, Qnil); |
305 | 2800 return Qnil; |
2801 } | |
2802 | |
57644
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2803 DEFUN ("translate-region-internal", Ftranslate_region_internal, |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2804 Stranslate_region_internal, 3, 3, 0, |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2805 doc: /* Internal use only. |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2806 From START to END, translate characters according to TABLE. |
39966
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2807 TABLE is a string; the Nth character in it is the mapping |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2808 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
|
2809 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
|
2810 (start, end, table) |
305 | 2811 Lisp_Object start; |
2812 Lisp_Object end; | |
2813 register Lisp_Object table; | |
2814 { | |
2815 register unsigned char *tt; /* Trans table. */ | |
2816 register int nc; /* New character. */ | |
2817 int cnt; /* Number of changes made. */ | |
2818 int size; /* Size of translate table. */ | |
57644
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2819 int pos, pos_byte, end_pos; |
26415
bda6a3a2bf96
(Ftranslate_region): Check the buffer multibyteness.
Kenichi Handa <handa@m17n.org>
parents:
26389
diff
changeset
|
2820 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
|
2821 int string_multibyte; |
305 | 2822 |
2823 validate_region (&start, &end); | |
57644
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2824 if (CHAR_TABLE_P (table)) |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2825 { |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2826 size = MAX_CHAR; |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2827 tt = NULL; |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2828 } |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2829 else |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2830 { |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2831 CHECK_STRING (table); |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2832 |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2833 if (! multibyte && (SCHARS (table) < SBYTES (table))) |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2834 table = string_make_unibyte (table); |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2835 string_multibyte = SCHARS (table) < SBYTES (table); |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2836 size = SCHARS (table); |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2837 tt = SDATA (table); |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2838 } |
305 | 2839 |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
2840 pos = XINT (start); |
54214
a2f5ab3b6d1b
(Ftranslate_region): Fix previous change
Kenichi Handa <handa@m17n.org>
parents:
54213
diff
changeset
|
2841 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
|
2842 end_pos = XINT (end); |
54214
a2f5ab3b6d1b
(Ftranslate_region): Fix previous change
Kenichi Handa <handa@m17n.org>
parents:
54213
diff
changeset
|
2843 modify_region (current_buffer, pos, XINT (end)); |
305 | 2844 |
2845 cnt = 0; | |
57644
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2846 for (; pos < end_pos; ) |
305 | 2847 { |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
2848 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
|
2849 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
|
2850 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
|
2851 int oc; |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
2852 |
26415
bda6a3a2bf96
(Ftranslate_region): Check the buffer multibyteness.
Kenichi Handa <handa@m17n.org>
parents:
26389
diff
changeset
|
2853 if (multibyte) |
54214
a2f5ab3b6d1b
(Ftranslate_region): Fix previous change
Kenichi Handa <handa@m17n.org>
parents:
54213
diff
changeset
|
2854 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
|
2855 else |
bda6a3a2bf96
(Ftranslate_region): Check the buffer multibyteness.
Kenichi Handa <handa@m17n.org>
parents:
26389
diff
changeset
|
2856 oc = *p, len = 1; |
54213
29d4d158e5eb
(Ftranslate_region): Handle multibyte chars in the arg
Kenichi Handa <handa@m17n.org>
parents:
53819
diff
changeset
|
2857 if (oc < size) |
305 | 2858 { |
57644
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2859 if (tt) |
54213
29d4d158e5eb
(Ftranslate_region): Handle multibyte chars in the arg
Kenichi Handa <handa@m17n.org>
parents:
53819
diff
changeset
|
2860 { |
57644
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2861 if (string_multibyte) |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2862 { |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2863 str = tt + string_char_to_byte (table, oc); |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2864 nc = STRING_CHAR_AND_LENGTH (str, MAX_MULTIBYTE_LENGTH, |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2865 str_len); |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2866 } |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2867 else |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2868 { |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2869 nc = tt[oc]; |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2870 if (! ASCII_BYTE_P (nc) && multibyte) |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2871 { |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2872 str_len = CHAR_STRING (nc, buf); |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2873 str = buf; |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2874 } |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2875 else |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2876 { |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2877 str_len = 1; |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2878 str = tt + oc; |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2879 } |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2880 } |
54213
29d4d158e5eb
(Ftranslate_region): Handle multibyte chars in the arg
Kenichi Handa <handa@m17n.org>
parents:
53819
diff
changeset
|
2881 } |
29d4d158e5eb
(Ftranslate_region): Handle multibyte chars in the arg
Kenichi Handa <handa@m17n.org>
parents:
53819
diff
changeset
|
2882 else |
29d4d158e5eb
(Ftranslate_region): Handle multibyte chars in the arg
Kenichi Handa <handa@m17n.org>
parents:
53819
diff
changeset
|
2883 { |
57644
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2884 Lisp_Object val; |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2885 int c; |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2886 |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2887 nc = oc; |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2888 val = CHAR_TABLE_REF (table, oc); |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2889 if (INTEGERP (val) |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2890 && (c = XINT (val), CHAR_VALID_P (c, 0))) |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2891 { |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2892 nc = c; |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2893 str_len = CHAR_STRING (nc, buf); |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2894 str = buf; |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2895 } |
54213
29d4d158e5eb
(Ftranslate_region): Handle multibyte chars in the arg
Kenichi Handa <handa@m17n.org>
parents:
53819
diff
changeset
|
2896 } |
57644
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2897 |
305 | 2898 if (nc != oc) |
2899 { | |
54214
a2f5ab3b6d1b
(Ftranslate_region): Fix previous change
Kenichi Handa <handa@m17n.org>
parents:
54213
diff
changeset
|
2900 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
|
2901 { |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2902 Lisp_Object string; |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2903 |
54214
a2f5ab3b6d1b
(Ftranslate_region): Fix previous change
Kenichi Handa <handa@m17n.org>
parents:
54213
diff
changeset
|
2904 /* This is less efficient, because it moves the gap, |
a2f5ab3b6d1b
(Ftranslate_region): Fix previous change
Kenichi Handa <handa@m17n.org>
parents:
54213
diff
changeset
|
2905 but it should multibyte characters correctly. */ |
54213
29d4d158e5eb
(Ftranslate_region): Handle multibyte chars in the arg
Kenichi Handa <handa@m17n.org>
parents:
53819
diff
changeset
|
2906 string = make_multibyte_string (str, 1, str_len); |
54214
a2f5ab3b6d1b
(Ftranslate_region): Fix previous change
Kenichi Handa <handa@m17n.org>
parents:
54213
diff
changeset
|
2907 replace_range (pos, pos + 1, string, 1, 0, 1); |
a2f5ab3b6d1b
(Ftranslate_region): Fix previous change
Kenichi Handa <handa@m17n.org>
parents:
54213
diff
changeset
|
2908 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
|
2909 } |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2910 else |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2911 { |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2912 record_change (pos, 1); |
54213
29d4d158e5eb
(Ftranslate_region): Handle multibyte chars in the arg
Kenichi Handa <handa@m17n.org>
parents:
53819
diff
changeset
|
2913 while (str_len-- > 0) |
29d4d158e5eb
(Ftranslate_region): Handle multibyte chars in the arg
Kenichi Handa <handa@m17n.org>
parents:
53819
diff
changeset
|
2914 *p++ = *str++; |
22895
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2915 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
|
2916 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
|
2917 } |
305 | 2918 ++cnt; |
2919 } | |
2920 } | |
54214
a2f5ab3b6d1b
(Ftranslate_region): Fix previous change
Kenichi Handa <handa@m17n.org>
parents:
54213
diff
changeset
|
2921 pos_byte += len; |
23565
077655e1e014
(Fsubst_char_in_region): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23554
diff
changeset
|
2922 pos++; |
305 | 2923 } |
2924 | |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
2925 return make_number (cnt); |
305 | 2926 } |
2927 | |
2928 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
|
2929 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
|
2930 |
39966
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2931 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
|
2932 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
|
2933 (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
|
2934 Lisp_Object start, end; |
305 | 2935 { |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2936 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
|
2937 del_range (XINT (start), XINT (end)); |
305 | 2938 return Qnil; |
2939 } | |
26742
936b39bd05b4
* editfns.c (Fdelete_and_extract_region): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
26699
diff
changeset
|
2940 |
936b39bd05b4
* editfns.c (Fdelete_and_extract_region): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
26699
diff
changeset
|
2941 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
|
2942 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
|
2943 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
|
2944 (start, end) |
26742
936b39bd05b4
* editfns.c (Fdelete_and_extract_region): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
26699
diff
changeset
|
2945 Lisp_Object start, end; |
936b39bd05b4
* editfns.c (Fdelete_and_extract_region): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
26699
diff
changeset
|
2946 { |
936b39bd05b4
* editfns.c (Fdelete_and_extract_region): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
26699
diff
changeset
|
2947 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
|
2948 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
|
2949 return build_string (""); |
26742
936b39bd05b4
* editfns.c (Fdelete_and_extract_region): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
26699
diff
changeset
|
2950 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
|
2951 } |
305 | 2952 |
2953 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
|
2954 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
|
2955 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
|
2956 () |
305 | 2957 { |
19207
be370e94fb42
(Fwiden, Fnarrow_to_region, save_restriction_restore):
Richard M. Stallman <rms@gnu.org>
parents:
19032
diff
changeset
|
2958 if (BEG != BEGV || Z != ZV) |
be370e94fb42
(Fwiden, Fnarrow_to_region, save_restriction_restore):
Richard M. Stallman <rms@gnu.org>
parents:
19032
diff
changeset
|
2959 current_buffer->clip_changed = 1; |
305 | 2960 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
|
2961 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
|
2962 SET_BUF_ZV_BOTH (current_buffer, Z, Z_BYTE); |
330 | 2963 /* Changing the buffer bounds invalidates any recorded current column. */ |
2964 invalidate_current_column (); | |
305 | 2965 return Qnil; |
2966 } | |
2967 | |
2968 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
|
2969 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
|
2970 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
|
2971 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
|
2972 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
|
2973 See also `save-restriction'. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2974 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2975 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
|
2976 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
|
2977 (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
|
2978 register Lisp_Object start, end; |
305 | 2979 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
2980 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
|
2981 CHECK_NUMBER_COERCE_MARKER (end); |
305 | 2982 |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2983 if (XINT (start) > XINT (end)) |
305 | 2984 { |
10383
a7fe0fb11314
(Fnarrow_to_region): Swap using temp Lisp_Object, not int.
Karl Heuer <kwzh@gnu.org>
parents:
10382
diff
changeset
|
2985 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
|
2986 tem = start; start = end; end = tem; |
305 | 2987 } |
2988 | |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2989 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
|
2990 args_out_of_range (start, end); |
305 | 2991 |
19207
be370e94fb42
(Fwiden, Fnarrow_to_region, save_restriction_restore):
Richard M. Stallman <rms@gnu.org>
parents:
19032
diff
changeset
|
2992 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
|
2993 current_buffer->clip_changed = 1; |
be370e94fb42
(Fwiden, Fnarrow_to_region, save_restriction_restore):
Richard M. Stallman <rms@gnu.org>
parents:
19032
diff
changeset
|
2994 |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
2995 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
|
2996 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
|
2997 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
|
2998 SET_PT (XFASTINT (start)); |
16039
855c8d8ba0f0
Change all references from point to PT.
Karl Heuer <kwzh@gnu.org>
parents:
15910
diff
changeset
|
2999 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
|
3000 SET_PT (XFASTINT (end)); |
330 | 3001 /* Changing the buffer bounds invalidates any recorded current column. */ |
3002 invalidate_current_column (); | |
305 | 3003 return Qnil; |
3004 } | |
3005 | |
3006 Lisp_Object | |
3007 save_restriction_save () | |
3008 { | |
30931
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3009 if (BEGV == BEG && ZV == Z) |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3010 /* 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
|
3011 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
|
3012 recognizes as meaning `no restriction'. */ |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3013 return Fcurrent_buffer (); |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3014 else |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3015 /* 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
|
3016 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
|
3017 { |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3018 Lisp_Object beg, end; |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3019 |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3020 beg = buildmark (BEGV, BEGV_BYTE); |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3021 end = buildmark (ZV, ZV_BYTE); |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3022 |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3023 /* 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
|
3024 XMARKER(end)->insertion_type = 1; |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3025 |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3026 return Fcons (beg, end); |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3027 } |
305 | 3028 } |
3029 | |
3030 Lisp_Object | |
3031 save_restriction_restore (data) | |
3032 Lisp_Object data; | |
3033 { | |
30931
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3034 if (CONSP (data)) |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3035 /* A pair of marks bounding a saved restriction. */ |
305 | 3036 { |
30931
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3037 struct Lisp_Marker *beg = XMARKER (XCAR (data)); |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3038 struct Lisp_Marker *end = XMARKER (XCDR (data)); |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3039 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
|
3040 |
46921
40c8bb63c063
(save_restriction_restore): Defend from unchained marker.
Richard M. Stallman <rms@gnu.org>
parents:
46639
diff
changeset
|
3041 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
|
3042 && (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
|
3043 /* 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
|
3044 the saved restriction. */ |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3045 { |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3046 int pt = BUF_PT (buf); |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3047 |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3048 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
|
3049 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
|
3050 |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3051 if (pt < beg->charpos || pt > end->charpos) |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3052 /* 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
|
3053 SET_BUF_PT_BOTH (buf, |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3054 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
|
3055 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
|
3056 end->bytepos)); |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49472
diff
changeset
|
3057 |
30931
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3058 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
|
3059 } |
305 | 3060 } |
30931
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3061 else |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3062 /* 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
|
3063 { |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3064 struct buffer *buf = XBUFFER (data); |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3065 |
46921
40c8bb63c063
(save_restriction_restore): Defend from unchained marker.
Richard M. Stallman <rms@gnu.org>
parents:
46639
diff
changeset
|
3066 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
|
3067 && (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
|
3068 /* 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
|
3069 { |
46921
40c8bb63c063
(save_restriction_restore): Defend from unchained marker.
Richard M. Stallman <rms@gnu.org>
parents:
46639
diff
changeset
|
3070 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
|
3071 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
|
3072 |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3073 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
|
3074 } |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3075 } |
305 | 3076 |
3077 return Qnil; | |
3078 } | |
3079 | |
3080 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
|
3081 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
|
3082 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
|
3083 (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
|
3084 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
|
3085 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
|
3086 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
|
3087 The old restrictions settings are restored |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3088 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
|
3089 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3090 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
|
3091 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3092 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
|
3093 use `save-excursion' outermost: |
40140
9bf80d5fff41
(Fsave_excursion, Fsave_current_buffer)
Miles Bader <miles@gnu.org>
parents:
40131
diff
changeset
|
3094 (save-excursion (save-restriction ...)) |
9bf80d5fff41
(Fsave_excursion, Fsave_current_buffer)
Miles Bader <miles@gnu.org>
parents:
40131
diff
changeset
|
3095 |
9bf80d5fff41
(Fsave_excursion, Fsave_current_buffer)
Miles Bader <miles@gnu.org>
parents:
40131
diff
changeset
|
3096 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
|
3097 (body) |
305 | 3098 Lisp_Object body; |
3099 { | |
3100 register Lisp_Object val; | |
46293
1fb8f75062c6
Use macro SPECPDL_INDEX.
Juanma Barranquero <lekktu@gmail.com>
parents:
45398
diff
changeset
|
3101 int count = SPECPDL_INDEX (); |
305 | 3102 |
3103 record_unwind_protect (save_restriction_restore, save_restriction_save ()); | |
3104 val = Fprogn (body); | |
3105 return unbind_to (count, val); | |
3106 } | |
3107 | |
38059
0b34b024286d
(Fmessage_box): If the frame is not under a window
Eli Zaretskii <eliz@gnu.org>
parents:
37916
diff
changeset
|
3108 /* 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
|
3109 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
|
3110 |
d02095ea13a5
(Fmessage): Copy the text to be displayed into a malloc'd buffer.
Karl Heuer <kwzh@gnu.org>
parents:
5882
diff
changeset
|
3111 /* 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
|
3112 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
|
3113 |
305 | 3114 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
|
3115 doc: /* Print a one-line message at the bottom of the screen. |
57736 | 3116 The message also goes into the `*Messages*' buffer. |
3117 \(In keyboard macros, that's all it does.) | |
3118 | |
39966
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3119 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
|
3120 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
|
3121 |
57736 | 3122 If the first argument is nil, the function clears any existing message; |
3123 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
|
3124 |
de086e415fa2
(Finsert, Finsert_and_inherit, Finsert_before_markers, Fmessage)
Miles Bader <miles@gnu.org>
parents:
40046
diff
changeset
|
3125 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
|
3126 (nargs, args) |
305 | 3127 int nargs; |
3128 Lisp_Object *args; | |
3129 { | |
46639
8587dd21917c
(Fmessage): Treat "" like nil.
Richard M. Stallman <rms@gnu.org>
parents:
46464
diff
changeset
|
3130 if (NILP (args[0]) |
8587dd21917c
(Fmessage): Treat "" like nil.
Richard M. Stallman <rms@gnu.org>
parents:
46464
diff
changeset
|
3131 || (STRINGP (args[0]) |
8587dd21917c
(Fmessage): Treat "" like nil.
Richard M. Stallman <rms@gnu.org>
parents:
46464
diff
changeset
|
3132 && 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
|
3133 { |
e21c1f3e37cb
* editfns.c (Fmessage): Don't forget to return a value when
Jim Blandy <jimb@redhat.com>
parents:
1854
diff
changeset
|
3134 message (0); |
59662
c140948a6044
(Fmessage): If arg is "", return "" (as before).
Richard M. Stallman <rms@gnu.org>
parents:
59658
diff
changeset
|
3135 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
|
3136 } |
1426
67fd35416ba3
* * editfns.c (Fmessage): With no arguments, clear any active
Jim Blandy <jimb@redhat.com>
parents:
1285
diff
changeset
|
3137 else |
67fd35416ba3
* * editfns.c (Fmessage): With no arguments, clear any active
Jim Blandy <jimb@redhat.com>
parents:
1285
diff
changeset
|
3138 { |
67fd35416ba3
* * editfns.c (Fmessage): With no arguments, clear any active
Jim Blandy <jimb@redhat.com>
parents:
1285
diff
changeset
|
3139 register Lisp_Object val; |
48115
72f8d789f551
(Fmessage): Revert last change to properly handle %% format.
Andreas Schwab <schwab@suse.de>
parents:
48111
diff
changeset
|
3140 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
|
3141 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
|
3142 return val; |
67fd35416ba3
* * editfns.c (Fmessage): With no arguments, clear any active
Jim Blandy <jimb@redhat.com>
parents:
1285
diff
changeset
|
3143 } |
305 | 3144 } |
3145 | |
8975
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3146 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
|
3147 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
|
3148 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
|
3149 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
|
3150 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
|
3151 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3152 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
|
3153 minibuffer contents show. |
de086e415fa2
(Finsert, Finsert_and_inherit, Finsert_before_markers, Fmessage)
Miles Bader <miles@gnu.org>
parents:
40046
diff
changeset
|
3154 |
de086e415fa2
(Finsert, Finsert_and_inherit, Finsert_before_markers, Fmessage)
Miles Bader <miles@gnu.org>
parents:
40046
diff
changeset
|
3155 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
|
3156 (nargs, args) |
8975
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3157 int nargs; |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3158 Lisp_Object *args; |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3159 { |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3160 if (NILP (args[0])) |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3161 { |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3162 message (0); |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3163 return Qnil; |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3164 } |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3165 else |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3166 { |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3167 register Lisp_Object val; |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3168 val = Fformat (nargs, args); |
13878
2a71500dfb93
(Fmessage_box, Fmessage_or_box):
Richard M. Stallman <rms@gnu.org>
parents:
13767
diff
changeset
|
3169 #ifdef HAVE_MENUS |
38059
0b34b024286d
(Fmessage_box): If the frame is not under a window
Eli Zaretskii <eliz@gnu.org>
parents:
37916
diff
changeset
|
3170 /* 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
|
3171 not FRAME_WINDOW_P. */ |
0b34b024286d
(Fmessage_box): If the frame is not under a window
Eli Zaretskii <eliz@gnu.org>
parents:
37916
diff
changeset
|
3172 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
|
3173 || FRAME_MSDOS_P (XFRAME (selected_frame))) |
8975
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3174 { |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3175 Lisp_Object pane, menu, obj; |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3176 struct gcpro gcpro1; |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3177 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
|
3178 GCPRO1 (pane); |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3179 menu = Fcons (val, pane); |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3180 obj = Fx_popup_dialog (Qt, menu); |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3181 UNGCPRO; |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3182 return val; |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3183 } |
38059
0b34b024286d
(Fmessage_box): If the frame is not under a window
Eli Zaretskii <eliz@gnu.org>
parents:
37916
diff
changeset
|
3184 #endif /* HAVE_MENUS */ |
8975
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3185 /* 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
|
3186 if (! message_text) |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3187 { |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3188 message_text = (char *)xmalloc (80); |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3189 message_length = 80; |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3190 } |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
3191 if (SBYTES (val) > message_length) |
8975
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3192 { |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
3193 message_length = SBYTES (val); |
8975
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3194 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
|
3195 } |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
3196 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
|
3197 message2 (message_text, SBYTES (val), |
21358
e9f7d8708bae
(Fmessage_box): Pass the missing third argument
Richard M. Stallman <rms@gnu.org>
parents:
21257
diff
changeset
|
3198 STRING_MULTIBYTE (val)); |
8975
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3199 return val; |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3200 } |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3201 } |
13878
2a71500dfb93
(Fmessage_box, Fmessage_or_box):
Richard M. Stallman <rms@gnu.org>
parents:
13767
diff
changeset
|
3202 #ifdef HAVE_MENUS |
8975
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3203 extern Lisp_Object last_nonmenu_event; |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3204 #endif |
13878
2a71500dfb93
(Fmessage_box, Fmessage_or_box):
Richard M. Stallman <rms@gnu.org>
parents:
13767
diff
changeset
|
3205 |
8975
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3206 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
|
3207 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
|
3208 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
|
3209 `use-dialog-box' is non-nil. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3210 Otherwise, use the echo area. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3211 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
|
3212 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
|
3213 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3214 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
|
3215 minibuffer contents show. |
de086e415fa2
(Finsert, Finsert_and_inherit, Finsert_before_markers, Fmessage)
Miles Bader <miles@gnu.org>
parents:
40046
diff
changeset
|
3216 |
de086e415fa2
(Finsert, Finsert_and_inherit, Finsert_before_markers, Fmessage)
Miles Bader <miles@gnu.org>
parents:
40046
diff
changeset
|
3217 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
|
3218 (nargs, args) |
8975
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3219 int nargs; |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3220 Lisp_Object *args; |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3221 { |
13878
2a71500dfb93
(Fmessage_box, Fmessage_or_box):
Richard M. Stallman <rms@gnu.org>
parents:
13767
diff
changeset
|
3222 #ifdef HAVE_MENUS |
26699
ed4ab9d24450
(Fmessage_or_box): Use use_dialog_box.
Dave Love <fx@gnu.org>
parents:
26629
diff
changeset
|
3223 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
|
3224 && use_dialog_box) |
8981
6e1a5ff3d795
(Fmessage_or_box): Use Fmessage_box with new name.
Richard M. Stallman <rms@gnu.org>
parents:
8975
diff
changeset
|
3225 return Fmessage_box (nargs, args); |
8975
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3226 #endif |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3227 return Fmessage (nargs, args); |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3228 } |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3229 |
18937
ddb91108a9d2
(Fcurrent_message): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18756
diff
changeset
|
3230 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
|
3231 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
|
3232 () |
18937
ddb91108a9d2
(Fcurrent_message): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18756
diff
changeset
|
3233 { |
25346
15ec35852b48
Remove conditional compilation on NO_PROMPT_IN_BUFFER.
Gerd Moellmann <gerd@gnu.org>
parents:
25018
diff
changeset
|
3234 return current_message (); |
18937
ddb91108a9d2
(Fcurrent_message): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18756
diff
changeset
|
3235 } |
ddb91108a9d2
(Fcurrent_message): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18756
diff
changeset
|
3236 |
25815 | 3237 |
41062
07a4ff5f0909
(Fpropertize): Allow call with 1 arg.
Richard M. Stallman <rms@gnu.org>
parents:
40981
diff
changeset
|
3238 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
|
3239 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
|
3240 First argument is the string to copy. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3241 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
|
3242 properties to add to the result. |
de086e415fa2
(Finsert, Finsert_and_inherit, Finsert_before_markers, Fmessage)
Miles Bader <miles@gnu.org>
parents:
40046
diff
changeset
|
3243 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
|
3244 (nargs, args) |
25815 | 3245 int nargs; |
3246 Lisp_Object *args; | |
3247 { | |
3248 Lisp_Object properties, string; | |
3249 struct gcpro gcpro1, gcpro2; | |
3250 int i; | |
3251 | |
3252 /* Number of args must be odd. */ | |
41062
07a4ff5f0909
(Fpropertize): Allow call with 1 arg.
Richard M. Stallman <rms@gnu.org>
parents:
40981
diff
changeset
|
3253 if ((nargs & 1) == 0 || nargs < 1) |
25815 | 3254 error ("Wrong number of arguments"); |
3255 | |
3256 properties = string = Qnil; | |
3257 GCPRO2 (properties, string); | |
30480 | 3258 |
25815 | 3259 /* 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
|
3260 CHECK_STRING (args[0]); |
25815 | 3261 string = Fcopy_sequence (args[0]); |
3262 | |
3263 for (i = 1; i < nargs; i += 2) | |
3264 { | |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
3265 CHECK_SYMBOL (args[i]); |
25815 | 3266 properties = Fcons (args[i], Fcons (args[i + 1], properties)); |
3267 } | |
3268 | |
3269 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
|
3270 make_number (SCHARS (string)), |
25815 | 3271 properties, string); |
3272 RETURN_UNGCPRO (string); | |
3273 } | |
3274 | |
3275 | |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3276 /* 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
|
3277 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
|
3278 |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3279 #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
|
3280 (((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
|
3281 ? 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
|
3282 : SBYTES (STRING)) |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3283 |
305 | 3284 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
|
3285 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
|
3286 The first argument is a control string. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3287 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
|
3288 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
|
3289 %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
|
3290 %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
|
3291 %X is like %x, but uses upper case. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3292 %e means print a number in exponential notation. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3293 %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
|
3294 %g means print a number in exponential notation |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3295 or decimal-point notation, whichever uses fewer characters. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3296 %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
|
3297 %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
|
3298 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
|
3299 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
|
3300 |
53687
4f06a8a0e7a6
For `format', make source and documentation match.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53541
diff
changeset
|
3301 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
|
3302 % <flags> <width> <precision> character |
4f06a8a0e7a6
For `format', make source and documentation match.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53541
diff
changeset
|
3303 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
|
3304 |
40131
de086e415fa2
(Finsert, Finsert_and_inherit, Finsert_before_markers, Fmessage)
Miles Bader <miles@gnu.org>
parents:
40046
diff
changeset
|
3305 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
|
3306 (nargs, args) |
305 | 3307 int nargs; |
3308 register Lisp_Object *args; | |
3309 { | |
3310 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
|
3311 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
|
3312 char *buf, *p; |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3313 register unsigned char *format, *end, *format_start; |
25782
8f59abd3a02b
(init_editfns): Remove unused variables.
Gerd Moellmann <gerd@gnu.org>
parents:
25662
diff
changeset
|
3314 int nchars; |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3315 /* 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
|
3316 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
|
3317 int multibyte = 0; |
22698
ea6ef56295b4
(Fformat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents:
22669
diff
changeset
|
3318 /* 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
|
3319 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
|
3320 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
|
3321 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
|
3322 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
|
3323 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
|
3324 /* 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
|
3325 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
|
3326 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
|
3327 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
|
3328 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
|
3329 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
|
3330 int longest_format; |
20804
14fa73136e64
(CONVERTED_BYTE_SIZE): Fix the logic.
Kenichi Handa <handa@m17n.org>
parents:
20706
diff
changeset
|
3331 Lisp_Object val; |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3332 int arg_intervals = 0; |
56194
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
3333 USE_SAFE_ALLOCA; |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3334 |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3335 /* 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
|
3336 string was not copied into the output. |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3337 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
|
3338 char *discarded = 0; |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3339 |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3340 /* Each element records, for one argument, |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3341 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
|
3342 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
|
3343 info[0] is unused. Unused elements have -1 for start. */ |
25018 | 3344 struct info |
3345 { | |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3346 int start, end, intervals; |
25018 | 3347 } *info = 0; |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3348 |
305 | 3349 /* It should not be necessary to GCPRO ARGS, because |
3350 the caller in the interpreter should take care of that. */ | |
3351 | |
20826
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3352 /* 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
|
3353 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
|
3354 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
|
3355 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
|
3356 for (n = 0; n < nargs; n++) |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3357 { |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3358 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
|
3359 multibyte = 1; |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3360 /* 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
|
3361 precision[n] = -1; |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3362 } |
56560
1a84eb100ef3
(Fformat): Allocated extra (dummy) element in info.
Kim F. Storm <storm@cua.dk>
parents:
56386
diff
changeset
|
3363 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
|
3364 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
3365 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
|
3366 /* 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
|
3367 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
|
3368 |
50746
2a57a6e6b390
(Fformat): Set abort_on_gc during first scan of format.
Richard M. Stallman <rms@gnu.org>
parents:
50555
diff
changeset
|
3369 /* 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
|
3370 abort_on_gc++; |
2a57a6e6b390
(Fformat): Set abort_on_gc during first scan of format.
Richard M. Stallman <rms@gnu.org>
parents:
50555
diff
changeset
|
3371 |
20826
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3372 /* 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
|
3373 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
|
3374 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
|
3375 retry: |
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3376 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
3377 format = SDATA (args[0]); |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3378 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
|
3379 end = format + SBYTES (args[0]); |
20826
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3380 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
|
3381 |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3382 /* 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
|
3383 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
|
3384 |
54846
e8865bfda38b
(Fformat): Fix allocation size of precision array.
Kim F. Storm <storm@cua.dk>
parents:
54655
diff
changeset
|
3385 /* Allocate the info and discarded tables. */ |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3386 { |
56560
1a84eb100ef3
(Fformat): Allocated extra (dummy) element in info.
Kim F. Storm <storm@cua.dk>
parents:
56386
diff
changeset
|
3387 int nbytes = (nargs+1) * sizeof *info; |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3388 int i; |
57725
c0675c413aa3
(Fformat): Allocate discarded table with SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
57644
diff
changeset
|
3389 if (!info) |
c0675c413aa3
(Fformat): Allocate discarded table with SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
57644
diff
changeset
|
3390 info = (struct info *) alloca (nbytes); |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3391 bzero (info, nbytes); |
56560
1a84eb100ef3
(Fformat): Allocated extra (dummy) element in info.
Kim F. Storm <storm@cua.dk>
parents:
56386
diff
changeset
|
3392 for (i = 0; i <= nargs; i++) |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3393 info[i].start = -1; |
57725
c0675c413aa3
(Fformat): Allocate discarded table with SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
57644
diff
changeset
|
3394 if (!discarded) |
c0675c413aa3
(Fformat): Allocate discarded table with SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
57644
diff
changeset
|
3395 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
|
3396 bzero (discarded, SBYTES (args[0])); |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3397 } |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3398 |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3399 /* Add to TOTAL enough space to hold the converted arguments. */ |
305 | 3400 |
3401 n = 0; | |
3402 while (format != end) | |
3403 if (*format++ == '%') | |
3404 { | |
34566
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3405 int thissize = 0; |
42484
717eee813b2c
(Fformat): Update thissize from field_width
Richard M. Stallman <rms@gnu.org>
parents:
42116
diff
changeset
|
3406 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
|
3407 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
|
3408 int field_width = 0; |
34566
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3409 |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3410 /* General format specifications look like |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3411 |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3412 '%' [flags] [field-width] [precision] format |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3413 |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3414 where |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3415 |
53687
4f06a8a0e7a6
For `format', make source and documentation match.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53541
diff
changeset
|
3416 flags ::= [- #0]+ |
34566
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3417 field-width ::= [0-9]+ |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3418 precision ::= '.' [0-9]* |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3419 |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3420 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
|
3421 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
|
3422 string is shorter than field-width. |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3423 |
48764
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3424 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
|
3425 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
|
3426 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
|
3427 |
53687
4f06a8a0e7a6
For `format', make source and documentation match.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53541
diff
changeset
|
3428 while (index ("-0# ", *format)) |
34566
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3429 ++format; |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3430 |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3431 if (*format >= '0' && *format <= '9') |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3432 { |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3433 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
|
3434 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
|
3435 } |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3436 |
48764
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3437 /* 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
|
3438 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
|
3439 if (*format == '.') |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3440 { |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3441 ++format; |
48764
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3442 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
|
3443 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
|
3444 } |
305 | 3445 |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3446 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
|
3447 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
|
3448 |
23197
0d3baa5514b7
(Fformat): Detect incomplete format spec at string's end.
Karl Heuer <kwzh@gnu.org>
parents:
23166
diff
changeset
|
3449 if (format == end) |
0d3baa5514b7
(Fformat): Detect incomplete format spec at string's end.
Karl Heuer <kwzh@gnu.org>
parents:
23166
diff
changeset
|
3450 error ("Format string ends in middle of format specifier"); |
305 | 3451 if (*format == '%') |
3452 format++; | |
3453 else if (++n >= nargs) | |
12831
3917c5d131d3
(Fformat): Limit minlen to avoid stack overflow.
Richard M. Stallman <rms@gnu.org>
parents:
12623
diff
changeset
|
3454 error ("Not enough arguments for format string"); |
305 | 3455 else if (*format == 'S') |
3456 { | |
3457 /* For `S', prin1 the argument and then treat like a string. */ | |
3458 register Lisp_Object tem; | |
3459 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
|
3460 if (STRING_MULTIBYTE (tem) && ! multibyte) |
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3461 { |
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3462 multibyte = 1; |
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3463 goto retry; |
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3464 } |
305 | 3465 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
|
3466 /* 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
|
3467 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
|
3468 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
|
3469 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
|
3470 *format = 's'; |
305 | 3471 goto string; |
3472 } | |
9163
41fe5f636879
(lisp_time_argument, Finsert, Finsert_and_inherit, Finsert_before_markers,
Karl Heuer <kwzh@gnu.org>
parents:
9154
diff
changeset
|
3473 else if (SYMBOLP (args[n])) |
305 | 3474 { |
46447
8e01c92219ab
(Fstring_to_char): Don't use XSTRING/XSETSTRING to copy a lisp value.
Ken Raeburn <raeburn@raeburn.org>
parents:
46443
diff
changeset
|
3475 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
|
3476 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
|
3477 { |
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
3478 multibyte = 1; |
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
3479 goto retry; |
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
3480 } |
305 | 3481 goto string; |
3482 } | |
9163
41fe5f636879
(lisp_time_argument, Finsert, Finsert_and_inherit, Finsert_before_markers,
Karl Heuer <kwzh@gnu.org>
parents:
9154
diff
changeset
|
3483 else if (STRINGP (args[n])) |
305 | 3484 { |
3485 string: | |
6528
d0f6a386b7cb
(Fformat): Validate number and type of arguments.
Karl Heuer <kwzh@gnu.org>
parents:
6206
diff
changeset
|
3486 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
|
3487 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
|
3488 /* 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
|
3489 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
|
3490 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
|
3491 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
|
3492 actual_width = lisp_string_width (args[n], -1, NULL, NULL); |
305 | 3493 } |
3494 /* 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
|
3495 else if (INTEGERP (args[n]) && *format != 's') |
305 | 3496 { |
3591
507f64624555
Apply typo patches from Paul Eggert.
Jim Blandy <jimb@redhat.com>
parents:
3522
diff
changeset
|
3497 /* The following loop assumes the Lisp type indicates |
305 | 3498 the proper way to pass the argument. |
3499 So make sure we have a flonum if the argument should | |
3500 be a double. */ | |
3501 if (*format == 'e' || *format == 'f' || *format == 'g') | |
3502 args[n] = Ffloat (args[n]); | |
23326
df3f641c9ca1
(Fformat): Check format control characters.
Kenichi Handa <handa@m17n.org>
parents:
23292
diff
changeset
|
3503 else |
df3f641c9ca1
(Fformat): Check format control characters.
Kenichi Handa <handa@m17n.org>
parents:
23292
diff
changeset
|
3504 if (*format != 'd' && *format != 'o' && *format != 'x' |
24505 | 3505 && *format != 'i' && *format != 'X' && *format != 'c') |
23326
df3f641c9ca1
(Fformat): Check format control characters.
Kenichi Handa <handa@m17n.org>
parents:
23292
diff
changeset
|
3506 error ("Invalid format operation %%%c", *format); |
df3f641c9ca1
(Fformat): Check format control characters.
Kenichi Handa <handa@m17n.org>
parents:
23292
diff
changeset
|
3507 |
30480 | 3508 thissize = 30; |
49285
7ec1335b6d36
(Fformat): Convert an unibyte char argument that is
Kenichi Handa <handa@m17n.org>
parents:
48908
diff
changeset
|
3509 if (*format == 'c') |
21064
90bdbe2754c8
(Fformat): Format multibyte characters by "%c"
Kenichi Handa <handa@m17n.org>
parents:
21052
diff
changeset
|
3510 { |
49285
7ec1335b6d36
(Fformat): Convert an unibyte char argument that is
Kenichi Handa <handa@m17n.org>
parents:
48908
diff
changeset
|
3511 if (! SINGLE_BYTE_CHAR_P (XINT (args[n])) |
53687
4f06a8a0e7a6
For `format', make source and documentation match.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53541
diff
changeset
|
3512 /* Note: No one can remember why we have to treat |
49472
3fd3c5521557
(Fformat): Add comment about the treatment of 0 as a multibyte
Kenichi Handa <handa@m17n.org>
parents:
49443
diff
changeset
|
3513 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
|
3514 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
|
3515 don't change it. */ |
49285
7ec1335b6d36
(Fformat): Convert an unibyte char argument that is
Kenichi Handa <handa@m17n.org>
parents:
48908
diff
changeset
|
3516 || XINT (args[n]) == 0) |
21064
90bdbe2754c8
(Fformat): Format multibyte characters by "%c"
Kenichi Handa <handa@m17n.org>
parents:
21052
diff
changeset
|
3517 { |
49285
7ec1335b6d36
(Fformat): Convert an unibyte char argument that is
Kenichi Handa <handa@m17n.org>
parents:
48908
diff
changeset
|
3518 if (! multibyte) |
7ec1335b6d36
(Fformat): Convert an unibyte char argument that is
Kenichi Handa <handa@m17n.org>
parents:
48908
diff
changeset
|
3519 { |
7ec1335b6d36
(Fformat): Convert an unibyte char argument that is
Kenichi Handa <handa@m17n.org>
parents:
48908
diff
changeset
|
3520 multibyte = 1; |
7ec1335b6d36
(Fformat): Convert an unibyte char argument that is
Kenichi Handa <handa@m17n.org>
parents:
48908
diff
changeset
|
3521 goto retry; |
7ec1335b6d36
(Fformat): Convert an unibyte char argument that is
Kenichi Handa <handa@m17n.org>
parents:
48908
diff
changeset
|
3522 } |
7ec1335b6d36
(Fformat): Convert an unibyte char argument that is
Kenichi Handa <handa@m17n.org>
parents:
48908
diff
changeset
|
3523 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
|
3524 thissize = SBYTES (args[n]); |
21064
90bdbe2754c8
(Fformat): Format multibyte characters by "%c"
Kenichi Handa <handa@m17n.org>
parents:
21052
diff
changeset
|
3525 } |
49285
7ec1335b6d36
(Fformat): Convert an unibyte char argument that is
Kenichi Handa <handa@m17n.org>
parents:
48908
diff
changeset
|
3526 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
|
3527 { |
7ec1335b6d36
(Fformat): Convert an unibyte char argument that is
Kenichi Handa <handa@m17n.org>
parents:
48908
diff
changeset
|
3528 args[n] |
7ec1335b6d36
(Fformat): Convert an unibyte char argument that is
Kenichi Handa <handa@m17n.org>
parents:
48908
diff
changeset
|
3529 = 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
|
3530 thissize = SBYTES (args[n]); |
7ec1335b6d36
(Fformat): Convert an unibyte char argument that is
Kenichi Handa <handa@m17n.org>
parents:
48908
diff
changeset
|
3531 } |
21064
90bdbe2754c8
(Fformat): Format multibyte characters by "%c"
Kenichi Handa <handa@m17n.org>
parents:
21052
diff
changeset
|
3532 } |
305 | 3533 } |
9163
41fe5f636879
(lisp_time_argument, Finsert, Finsert_and_inherit, Finsert_before_markers,
Karl Heuer <kwzh@gnu.org>
parents:
9154
diff
changeset
|
3534 else if (FLOATP (args[n]) && *format != 's') |
305 | 3535 { |
3536 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
|
3537 { |
7ac7ca5ac550
(Fformat): Detect invalid format letters for floats.
Richard M. Stallman <rms@gnu.org>
parents:
47763
diff
changeset
|
3538 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
|
3539 && *format != 'i' && *format != 'X' && *format != 'c') |
7ac7ca5ac550
(Fformat): Detect invalid format letters for floats.
Richard M. Stallman <rms@gnu.org>
parents:
47763
diff
changeset
|
3540 error ("Invalid format operation %%%c", *format); |
7ac7ca5ac550
(Fformat): Detect invalid format letters for floats.
Richard M. Stallman <rms@gnu.org>
parents:
47763
diff
changeset
|
3541 args[n] = Ftruncate (args[n], Qnil); |
7ac7ca5ac550
(Fformat): Detect invalid format letters for floats.
Richard M. Stallman <rms@gnu.org>
parents:
47763
diff
changeset
|
3542 } |
34566
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3543 |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3544 /* 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
|
3545 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
|
3546 prints. */ |
48782
b02bdb795a5c
(Fformat): Use alloca, not _alloca.
Juanma Barranquero <lekktu@gmail.com>
parents:
48781
diff
changeset
|
3547 /* Filter out flag value of -1. */ |
48908 | 3548 thissize = (MAX_10_EXP + 100 |
3549 + (precision[n] > 0 ? precision[n] : 0)); | |
305 | 3550 } |
3551 else | |
3552 { | |
3553 /* Anything but a string, convert to a string using princ. */ | |
3554 register Lisp_Object tem; | |
3555 tem = Fprin1_to_string (args[n], Qt); | |
53541
41ceb9298a4e
(Fformat): Fix '&' to '&&'.
Kenichi Handa <handa@m17n.org>
parents:
52451
diff
changeset
|
3556 if (STRING_MULTIBYTE (tem) && ! multibyte) |
20826
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3557 { |
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3558 multibyte = 1; |
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3559 goto retry; |
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3560 } |
305 | 3561 args[n] = tem; |
3562 goto string; | |
3563 } | |
30480 | 3564 |
42484
717eee813b2c
(Fformat): Update thissize from field_width
Richard M. Stallman <rms@gnu.org>
parents:
42116
diff
changeset
|
3565 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
|
3566 total += thissize + 4; |
305 | 3567 } |
3568 | |
50746
2a57a6e6b390
(Fformat): Set abort_on_gc during first scan of format.
Richard M. Stallman <rms@gnu.org>
parents:
50555
diff
changeset
|
3569 abort_on_gc--; |
2a57a6e6b390
(Fformat): Set abort_on_gc during first scan of format.
Richard M. Stallman <rms@gnu.org>
parents:
50555
diff
changeset
|
3570 |
20826
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3571 /* 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
|
3572 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
|
3573 |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3574 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
|
3575 |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3576 /* 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
|
3577 Note that TOTAL is an overestimate. */ |
56194
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
3578 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
|
3579 |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3580 p = buf; |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3581 nchars = 0; |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3582 n = 0; |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3583 |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3584 /* 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
|
3585 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
|
3586 format_start = format; |
2a57a6e6b390
(Fformat): Set abort_on_gc during first scan of format.
Richard M. Stallman <rms@gnu.org>
parents:
50555
diff
changeset
|
3587 end = format + SBYTES (args[0]); |
22698
ea6ef56295b4
(Fformat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents:
22669
diff
changeset
|
3588 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
|
3589 while (format != end) |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3590 { |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3591 if (*format == '%') |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3592 { |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3593 int minlen; |
21225
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3594 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
|
3595 unsigned char *this_format_start = format; |
305 | 3596 |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3597 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
|
3598 format++; |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3599 |
53687
4f06a8a0e7a6
For `format', make source and documentation match.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53541
diff
changeset
|
3600 while (index("-0# ", *format)) |
4f06a8a0e7a6
For `format', make source and documentation match.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53541
diff
changeset
|
3601 { |
4f06a8a0e7a6
For `format', make source and documentation match.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53541
diff
changeset
|
3602 if (*format == '-') |
4f06a8a0e7a6
For `format', make source and documentation match.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53541
diff
changeset
|
3603 { |
4f06a8a0e7a6
For `format', make source and documentation match.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53541
diff
changeset
|
3604 negative = 1; |
4f06a8a0e7a6
For `format', make source and documentation match.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53541
diff
changeset
|
3605 } |
4f06a8a0e7a6
For `format', make source and documentation match.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53541
diff
changeset
|
3606 discarded[format - format_start] = 1; |
4f06a8a0e7a6
For `format', make source and documentation match.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53541
diff
changeset
|
3607 ++format; |
4f06a8a0e7a6
For `format', make source and documentation match.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53541
diff
changeset
|
3608 } |
4f06a8a0e7a6
For `format', make source and documentation match.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53541
diff
changeset
|
3609 |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3610 minlen = atoi (format); |
53687
4f06a8a0e7a6
For `format', make source and documentation match.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53541
diff
changeset
|
3611 |
4f06a8a0e7a6
For `format', make source and documentation match.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53541
diff
changeset
|
3612 while ((*format >= '0' && *format <= '9') || *format == '.') |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3613 { |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3614 discarded[format - format_start] = 1; |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3615 format++; |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3616 } |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3617 |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3618 if (*format++ == '%') |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3619 { |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3620 *p++ = '%'; |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3621 nchars++; |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3622 continue; |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3623 } |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3624 |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3625 ++n; |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3626 |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3627 discarded[format - format_start - 1] = 1; |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3628 info[n].start = nchars; |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3629 |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3630 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
|
3631 { |
48764
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3632 /* 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
|
3633 |
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3634 int width, padding; |
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3635 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
|
3636 int nchars_string; |
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3637 |
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3638 /* 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
|
3639 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
|
3640 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
|
3641 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
|
3642 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
|
3643 |
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3644 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
|
3645 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
|
3646 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
|
3647 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
|
3648 else |
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3649 { /* 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
|
3650 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
|
3651 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
|
3652 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
|
3653 } |
21225
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3654 |
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3655 /* 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
|
3656 padding = minlen - width; |
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3657 if (! negative) |
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3658 while (padding-- > 0) |
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3659 { |
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3660 *p++ = ' '; |
35461
f0f0e9179ed6
(Fformat): Don't extend text properties from arguments
Gerd Moellmann <gerd@gnu.org>
parents:
35440
diff
changeset
|
3661 ++nchars; |
21225
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3662 } |
305 | 3663 |
35461
f0f0e9179ed6
(Fformat): Don't extend text properties from arguments
Gerd Moellmann <gerd@gnu.org>
parents:
35440
diff
changeset
|
3664 start = nchars; |
48764
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3665 nchars += nchars_string; |
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3666 end = nchars; |
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3667 |
22698
ea6ef56295b4
(Fformat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents:
22669
diff
changeset
|
3668 if (p > buf |
ea6ef56295b4
(Fformat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents:
22669
diff
changeset
|
3669 && multibyte |
22712
6f129ed55108
(Fformat): Replace explicit numeric constants with proper macros.
Kenichi Handa <handa@m17n.org>
parents:
22698
diff
changeset
|
3670 && !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
|
3671 && 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
|
3672 && !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
|
3673 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
|
3674 |
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3675 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
|
3676 nbytes, |
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3677 STRING_MULTIBYTE (args[n]), multibyte); |
305 | 3678 |
21225
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3679 if (negative) |
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3680 while (padding-- > 0) |
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3681 { |
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3682 *p++ = ' '; |
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3683 nchars++; |
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3684 } |
25018 | 3685 |
3686 /* If this argument has text properties, record where | |
3687 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
|
3688 if (STRING_INTERVALS (args[n])) |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3689 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
|
3690 } |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3691 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
|
3692 { |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3693 int this_nchars; |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3694 |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3695 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
|
3696 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
|
3697 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
|
3698 |
21202
ef954087e7b9
(Fformat): Properly print floats.
Richard M. Stallman <rms@gnu.org>
parents:
21200
diff
changeset
|
3699 if (INTEGERP (args[n])) |
ef954087e7b9
(Fformat): Properly print floats.
Richard M. Stallman <rms@gnu.org>
parents:
21200
diff
changeset
|
3700 sprintf (p, this_format, XINT (args[n])); |
ef954087e7b9
(Fformat): Properly print floats.
Richard M. Stallman <rms@gnu.org>
parents:
21200
diff
changeset
|
3701 else |
25662
0a7261c1d487
Use XCAR, XCDR, and XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25656
diff
changeset
|
3702 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
|
3703 |
22698
ea6ef56295b4
(Fformat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents:
22669
diff
changeset
|
3704 if (p > buf |
ea6ef56295b4
(Fformat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents:
22669
diff
changeset
|
3705 && multibyte |
22712
6f129ed55108
(Fformat): Replace explicit numeric constants with proper macros.
Kenichi Handa <handa@m17n.org>
parents:
22698
diff
changeset
|
3706 && !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
|
3707 && !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
|
3708 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
|
3709 this_nchars = strlen (p); |
29008
939760ef7379
(Fformat): Be sure to convert 8-bit characters to
Kenichi Handa <handa@m17n.org>
parents:
28545
diff
changeset
|
3710 if (multibyte) |
56194
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
3711 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
|
3712 else |
939760ef7379
(Fformat): Be sure to convert 8-bit characters to
Kenichi Handa <handa@m17n.org>
parents:
28545
diff
changeset
|
3713 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
|
3714 nchars += this_nchars; |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3715 } |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3716 |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3717 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
|
3718 } |
20861
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
3719 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
|
3720 { |
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
3721 /* Copy a whole multibyte character. */ |
22698
ea6ef56295b4
(Fformat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents:
22669
diff
changeset
|
3722 if (p > buf |
ea6ef56295b4
(Fformat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents:
22669
diff
changeset
|
3723 && multibyte |
22712
6f129ed55108
(Fformat): Replace explicit numeric constants with proper macros.
Kenichi Handa <handa@m17n.org>
parents:
22698
diff
changeset
|
3724 && !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
|
3725 && !CHAR_HEAD_P (*format)) |
22698
ea6ef56295b4
(Fformat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents:
22669
diff
changeset
|
3726 maybe_combine_byte = 1; |
20861
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
3727 *p++ = *format++; |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3728 while (! CHAR_HEAD_P (*format)) |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3729 { |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3730 discarded[format - format_start] = 2; |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3731 *p++ = *format++; |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3732 } |
20861
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
3733 nchars++; |
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
3734 } |
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
3735 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
|
3736 { |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3737 /* 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
|
3738 int len = copy_text (format, p, 1, 0, 1); |
305 | 3739 |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3740 p += len; |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3741 format++; |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3742 nchars++; |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3743 } |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3744 else |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3745 *p++ = *format++, nchars++; |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3746 } |
305 | 3747 |
56194
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
3748 if (p > buf + total) |
34566
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3749 abort (); |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3750 |
22698
ea6ef56295b4
(Fformat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents:
22669
diff
changeset
|
3751 if (maybe_combine_byte) |
ea6ef56295b4
(Fformat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents:
22669
diff
changeset
|
3752 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
|
3753 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
|
3754 |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3755 /* 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
|
3756 SAFE_FREE (); |
305 | 3757 |
25018 | 3758 /* If the format string has text properties, or any of the string |
3759 arguments has text properties, set up text properties of the | |
3760 result string. */ | |
30480 | 3761 |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3762 if (STRING_INTERVALS (args[0]) || arg_intervals) |
25018 | 3763 { |
3764 Lisp_Object len, new_len, props; | |
3765 struct gcpro gcpro1; | |
30480 | 3766 |
25018 | 3767 /* 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
|
3768 len = make_number (SCHARS (args[0])); |
25018 | 3769 props = text_property_list (args[0], make_number (0), len, Qnil); |
3770 GCPRO1 (props); | |
30480 | 3771 |
25018 | 3772 if (CONSP (props)) |
3773 { | |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3774 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
|
3775 Lisp_Object list; |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3776 |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3777 /* Adjust the bounds of each text property |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3778 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
|
3779 |
d2baef38bbd7
(Fformat): Handle format strings with multiple text
Kim F. Storm <storm@cua.dk>
parents:
56560
diff
changeset
|
3780 /* 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
|
3781 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
|
3782 space of the format string. */ |
d2baef38bbd7
(Fformat): Handle format strings with multiple text
Kim F. Storm <storm@cua.dk>
parents:
56560
diff
changeset
|
3783 props = Fnreverse (props); |
d2baef38bbd7
(Fformat): Handle format strings with multiple text
Kim F. Storm <storm@cua.dk>
parents:
56560
diff
changeset
|
3784 |
d2baef38bbd7
(Fformat): Handle format strings with multiple text
Kim F. Storm <storm@cua.dk>
parents:
56560
diff
changeset
|
3785 /* 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
|
3786 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
|
3787 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
|
3788 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
|
3789 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
|
3790 { |
50555
37d227b879ad
(Fformat): Lisp_Object/int mixup.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50499
diff
changeset
|
3791 Lisp_Object item; |
37d227b879ad
(Fformat): Lisp_Object/int mixup.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50499
diff
changeset
|
3792 int pos; |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3793 |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3794 item = XCAR (list); |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3795 |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3796 /* First adjust the property start position. */ |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3797 pos = XINT (XCAR (item)); |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3798 |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3799 /* Advance BYTEPOS, POSITION, TRANSLATED and ARGN |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3800 up to this position. */ |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3801 for (; position < pos; bytepos++) |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3802 { |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3803 if (! discarded[bytepos]) |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3804 position++, translated++; |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3805 else if (discarded[bytepos] == 1) |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3806 { |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3807 position++; |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3808 if (translated == info[argn].start) |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3809 { |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3810 translated += info[argn].end - info[argn].start; |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3811 argn++; |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3812 } |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3813 } |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3814 } |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3815 |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3816 XSETCAR (item, make_number (translated)); |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3817 |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3818 /* Likewise adjust the property end position. */ |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3819 pos = XINT (XCAR (XCDR (item))); |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3820 |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3821 for (; bytepos < pos; bytepos++) |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3822 { |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3823 if (! discarded[bytepos]) |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3824 position++, translated++; |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3825 else if (discarded[bytepos] == 1) |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3826 { |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3827 position++; |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3828 if (translated == info[argn].start) |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3829 { |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3830 translated += info[argn].end - info[argn].start; |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3831 argn++; |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3832 } |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3833 } |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3834 } |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3835 |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3836 XSETCAR (XCDR (item), make_number (translated)); |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3837 } |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3838 |
25018 | 3839 add_text_properties_from_list (val, props, make_number (0)); |
3840 } | |
3841 | |
3842 /* Add text properties from arguments. */ | |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3843 if (arg_intervals) |
25018 | 3844 for (n = 1; n < nargs; ++n) |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3845 if (info[n].intervals) |
25018 | 3846 { |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
3847 len = make_number (SCHARS (args[n])); |
25018 | 3848 new_len = make_number (info[n].end - info[n].start); |
3849 props = text_property_list (args[n], make_number (0), len, Qnil); | |
3850 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
|
3851 /* 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
|
3852 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
|
3853 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
|
3854 make_composition_value_copy (props); |
25018 | 3855 add_text_properties_from_list (val, props, |
3856 make_number (info[n].start)); | |
3857 } | |
3858 | |
3859 UNGCPRO; | |
3860 } | |
3861 | |
20804
14fa73136e64
(CONVERTED_BYTE_SIZE): Fix the logic.
Kenichi Handa <handa@m17n.org>
parents:
20706
diff
changeset
|
3862 return val; |
305 | 3863 } |
3864 | |
3865 Lisp_Object | |
49443
f9f7612c767a
(format2): New function, replaces format1
Richard M. Stallman <rms@gnu.org>
parents:
49293
diff
changeset
|
3866 format2 (string1, arg0, arg1) |
305 | 3867 char *string1; |
49443
f9f7612c767a
(format2): New function, replaces format1
Richard M. Stallman <rms@gnu.org>
parents:
49293
diff
changeset
|
3868 Lisp_Object arg0, arg1; |
305 | 3869 { |
49443
f9f7612c767a
(format2): New function, replaces format1
Richard M. Stallman <rms@gnu.org>
parents:
49293
diff
changeset
|
3870 Lisp_Object args[3]; |
f9f7612c767a
(format2): New function, replaces format1
Richard M. Stallman <rms@gnu.org>
parents:
49293
diff
changeset
|
3871 args[0] = build_string (string1); |
f9f7612c767a
(format2): New function, replaces format1
Richard M. Stallman <rms@gnu.org>
parents:
49293
diff
changeset
|
3872 args[1] = arg0; |
f9f7612c767a
(format2): New function, replaces format1
Richard M. Stallman <rms@gnu.org>
parents:
49293
diff
changeset
|
3873 args[2] = arg1; |
f9f7612c767a
(format2): New function, replaces format1
Richard M. Stallman <rms@gnu.org>
parents:
49293
diff
changeset
|
3874 return Fformat (3, args); |
305 | 3875 } |
3876 | |
3877 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
|
3878 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
|
3879 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
|
3880 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
|
3881 (c1, c2) |
305 | 3882 register Lisp_Object c1, c2; |
3883 { | |
20688
16c458803c32
(Fchar_equal): Fix case-conversion code.
Richard M. Stallman <rms@gnu.org>
parents:
20606
diff
changeset
|
3884 int i1, i2; |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
3885 CHECK_NUMBER (c1); |
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
3886 CHECK_NUMBER (c2); |
305 | 3887 |
20688
16c458803c32
(Fchar_equal): Fix case-conversion code.
Richard M. Stallman <rms@gnu.org>
parents:
20606
diff
changeset
|
3888 if (XINT (c1) == XINT (c2)) |
305 | 3889 return Qt; |
20688
16c458803c32
(Fchar_equal): Fix case-conversion code.
Richard M. Stallman <rms@gnu.org>
parents:
20606
diff
changeset
|
3890 if (NILP (current_buffer->case_fold_search)) |
16c458803c32
(Fchar_equal): Fix case-conversion code.
Richard M. Stallman <rms@gnu.org>
parents:
20606
diff
changeset
|
3891 return Qnil; |
16c458803c32
(Fchar_equal): Fix case-conversion code.
Richard M. Stallman <rms@gnu.org>
parents:
20606
diff
changeset
|
3892 |
16c458803c32
(Fchar_equal): Fix case-conversion code.
Richard M. Stallman <rms@gnu.org>
parents:
20606
diff
changeset
|
3893 /* Do these in separate statements, |
16c458803c32
(Fchar_equal): Fix case-conversion code.
Richard M. Stallman <rms@gnu.org>
parents:
20606
diff
changeset
|
3894 then compare the variables. |
16c458803c32
(Fchar_equal): Fix case-conversion code.
Richard M. Stallman <rms@gnu.org>
parents:
20606
diff
changeset
|
3895 because of the way DOWNCASE uses temp variables. */ |
16c458803c32
(Fchar_equal): Fix case-conversion code.
Richard M. Stallman <rms@gnu.org>
parents:
20606
diff
changeset
|
3896 i1 = DOWNCASE (XFASTINT (c1)); |
16c458803c32
(Fchar_equal): Fix case-conversion code.
Richard M. Stallman <rms@gnu.org>
parents:
20606
diff
changeset
|
3897 i2 = DOWNCASE (XFASTINT (c2)); |
16c458803c32
(Fchar_equal): Fix case-conversion code.
Richard M. Stallman <rms@gnu.org>
parents:
20606
diff
changeset
|
3898 return (i1 == i2 ? Qt : Qnil); |
305 | 3899 } |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3900 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3901 /* 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
|
3902 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
|
3903 differ in size). |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3904 |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3905 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
|
3906 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
|
3907 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
|
3908 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
|
3909 |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3910 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
|
3911 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
|
3912 rest untouched. Most of this is copied from adjust_markers in insdel.c. |
30480 | 3913 |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3914 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
|
3915 |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
3916 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
|
3917 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
|
3918 start1_byte, end1_byte, start2_byte, end2_byte) |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3919 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
|
3920 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
|
3921 { |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3922 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
|
3923 register struct Lisp_Marker *marker; |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3924 |
7862
0b6f46029ea2
(transpose_markers): Allow for gap at start of region.
Karl Heuer <kwzh@gnu.org>
parents:
7710
diff
changeset
|
3925 /* 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
|
3926 if (PT < start1) |
987ab382275c
(Ftranspose_regions): Fix overlays after moving markers.
Karl Heuer <kwzh@gnu.org>
parents:
7506
diff
changeset
|
3927 ; |
987ab382275c
(Ftranspose_regions): Fix overlays after moving markers.
Karl Heuer <kwzh@gnu.org>
parents:
7506
diff
changeset
|
3928 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
|
3929 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
|
3930 PT_BYTE + (end2_byte - end1_byte)); |
7519
987ab382275c
(Ftranspose_regions): Fix overlays after moving markers.
Karl Heuer <kwzh@gnu.org>
parents:
7506
diff
changeset
|
3931 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
|
3932 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
|
3933 (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
|
3934 - (end1_byte - start1_byte))); |
7519
987ab382275c
(Ftranspose_regions): Fix overlays after moving markers.
Karl Heuer <kwzh@gnu.org>
parents:
7506
diff
changeset
|
3935 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
|
3936 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
|
3937 PT_BYTE - (start2_byte - start1_byte)); |
7519
987ab382275c
(Ftranspose_regions): Fix overlays after moving markers.
Karl Heuer <kwzh@gnu.org>
parents:
7506
diff
changeset
|
3938 |
7862
0b6f46029ea2
(transpose_markers): Allow for gap at start of region.
Karl Heuer <kwzh@gnu.org>
parents:
7710
diff
changeset
|
3939 /* 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
|
3940 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
|
3941 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
|
3942 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
|
3943 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
|
3944 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
|
3945 the dirty work to Fmarker_position, below. */ |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3946 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3947 /* The difference between the region's lengths */ |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3948 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
|
3949 diff_byte = (end2_byte - start2_byte) - (end1_byte - start1_byte); |
30480 | 3950 |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3951 /* 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
|
3952 region plus the distance between the regions. */ |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3953 amt1 = (end2 - start2) + (start2 - end1); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3954 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
|
3955 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
|
3956 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
|
3957 |
51670
beceb827c1ce
(save_excursion_restore, transpose_markers): Update for new types.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
51042
diff
changeset
|
3958 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
|
3959 { |
51670
beceb827c1ce
(save_excursion_restore, transpose_markers): Update for new types.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
51042
diff
changeset
|
3960 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
|
3961 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
|
3962 { |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3963 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
|
3964 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
|
3965 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
|
3966 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
|
3967 else |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3968 mpos -= amt2_byte; |
51670
beceb827c1ce
(save_excursion_restore, transpose_markers): Update for new types.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
51042
diff
changeset
|
3969 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
|
3970 } |
51670
beceb827c1ce
(save_excursion_restore, transpose_markers): Update for new types.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
51042
diff
changeset
|
3971 mpos = marker->charpos; |
7862
0b6f46029ea2
(transpose_markers): Allow for gap at start of region.
Karl Heuer <kwzh@gnu.org>
parents:
7710
diff
changeset
|
3972 if (mpos >= start1 && mpos < end2) |
0b6f46029ea2
(transpose_markers): Allow for gap at start of region.
Karl Heuer <kwzh@gnu.org>
parents:
7710
diff
changeset
|
3973 { |
0b6f46029ea2
(transpose_markers): Allow for gap at start of region.
Karl Heuer <kwzh@gnu.org>
parents:
7710
diff
changeset
|
3974 if (mpos < end1) |
0b6f46029ea2
(transpose_markers): Allow for gap at start of region.
Karl Heuer <kwzh@gnu.org>
parents:
7710
diff
changeset
|
3975 mpos += amt1; |
0b6f46029ea2
(transpose_markers): Allow for gap at start of region.
Karl Heuer <kwzh@gnu.org>
parents:
7710
diff
changeset
|
3976 else if (mpos < start2) |
0b6f46029ea2
(transpose_markers): Allow for gap at start of region.
Karl Heuer <kwzh@gnu.org>
parents:
7710
diff
changeset
|
3977 mpos += diff; |
0b6f46029ea2
(transpose_markers): Allow for gap at start of region.
Karl Heuer <kwzh@gnu.org>
parents:
7710
diff
changeset
|
3978 else |
0b6f46029ea2
(transpose_markers): Allow for gap at start of region.
Karl Heuer <kwzh@gnu.org>
parents:
7710
diff
changeset
|
3979 mpos -= amt2; |
0b6f46029ea2
(transpose_markers): Allow for gap at start of region.
Karl Heuer <kwzh@gnu.org>
parents:
7710
diff
changeset
|
3980 } |
51670
beceb827c1ce
(save_excursion_restore, transpose_markers): Update for new types.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
51042
diff
changeset
|
3981 marker->charpos = mpos; |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3982 } |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3983 } |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3984 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3985 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
|
3986 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
|
3987 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
|
3988 never changed in a transposition. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3989 |
55972
db2480202623
(Fuser_login_name, Ffloat_time, Fencode_time, Fcurrent_time_string)
Juanma Barranquero <lekktu@gmail.com>
parents:
55424
diff
changeset
|
3990 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
|
3991 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
|
3992 |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
3993 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
|
3994 (startr1, endr1, startr2, endr2, leave_markers) |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3995 Lisp_Object startr1, endr1, startr2, endr2, leave_markers; |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
3996 { |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3997 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
|
3998 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
|
3999 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
|
4000 unsigned char *start1_addr, *start2_addr, *temp; |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4001 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4002 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
|
4003 cur_intv = BUF_INTERVALS (current_buffer); |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4004 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4005 validate_region (&startr1, &endr1); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4006 validate_region (&startr2, &endr2); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4007 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4008 start1 = XFASTINT (startr1); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4009 end1 = XFASTINT (endr1); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4010 start2 = XFASTINT (startr2); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4011 end2 = XFASTINT (endr2); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4012 gap = GPT; |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4013 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4014 /* Swap the regions if they're reversed. */ |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4015 if (start2 < end1) |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4016 { |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4017 register int glumph = start1; |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4018 start1 = start2; |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4019 start2 = glumph; |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4020 glumph = end1; |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4021 end1 = end2; |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4022 end2 = glumph; |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4023 } |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4024 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4025 len1 = end1 - start1; |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4026 len2 = end2 - start2; |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4027 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4028 if (start2 < end1) |
21245
6cde55b7c9de
Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents:
21235
diff
changeset
|
4029 error ("Transposed regions overlap"); |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4030 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
|
4031 error ("Transposed region has length 0"); |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4032 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4033 /* The possibilities are: |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4034 1. Adjacent (contiguous) regions, or separate but equal regions |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4035 (no, really equal, in this case!), or |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4036 2. Separate regions of unequal size. |
30480 | 4037 |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4038 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
|
4039 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
|
4040 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
|
4041 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
|
4042 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4043 /* 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
|
4044 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
|
4045 around it if necessary. This would be extremely efficient, |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4046 especially considering that people are likely to do |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4047 transpositions near where they are working interactively, which |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4048 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
|
4049 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
|
4050 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
|
4051 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
|
4052 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
|
4053 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
|
4054 |
67bb3bb1b62d
(Ftranspose_regions): Take addresses only after move gap.
Richard M. Stallman <rms@gnu.org>
parents:
7207
diff
changeset
|
4055 /* 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
|
4056 we will operate on. */ |
67bb3bb1b62d
(Ftranspose_regions): Take addresses only after move gap.
Richard M. Stallman <rms@gnu.org>
parents:
7207
diff
changeset
|
4057 if (start1 < gap && gap < end2) |
67bb3bb1b62d
(Ftranspose_regions): Take addresses only after move gap.
Richard M. Stallman <rms@gnu.org>
parents:
7207
diff
changeset
|
4058 { |
67bb3bb1b62d
(Ftranspose_regions): Take addresses only after move gap.
Richard M. Stallman <rms@gnu.org>
parents:
7207
diff
changeset
|
4059 if (gap - start1 < end2 - gap) |
67bb3bb1b62d
(Ftranspose_regions): Take addresses only after move gap.
Richard M. Stallman <rms@gnu.org>
parents:
7207
diff
changeset
|
4060 move_gap (start1); |
67bb3bb1b62d
(Ftranspose_regions): Take addresses only after move gap.
Richard M. Stallman <rms@gnu.org>
parents:
7207
diff
changeset
|
4061 else |
67bb3bb1b62d
(Ftranspose_regions): Take addresses only after move gap.
Richard M. Stallman <rms@gnu.org>
parents:
7207
diff
changeset
|
4062 move_gap (end2); |
67bb3bb1b62d
(Ftranspose_regions): Take addresses only after move gap.
Richard M. Stallman <rms@gnu.org>
parents:
7207
diff
changeset
|
4063 } |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
4064 |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
4065 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
|
4066 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
|
4067 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
|
4068 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
|
4069 |
29008
939760ef7379
(Fformat): Be sure to convert 8-bit characters to
Kenichi Handa <handa@m17n.org>
parents:
28545
diff
changeset
|
4070 #ifdef BYTE_COMBINING_DEBUG |
21245
6cde55b7c9de
Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents:
21235
diff
changeset
|
4071 if (end1 == start2) |
6cde55b7c9de
Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents:
21235
diff
changeset
|
4072 { |
29008
939760ef7379
(Fformat): Be sure to convert 8-bit characters to
Kenichi Handa <handa@m17n.org>
parents:
28545
diff
changeset
|
4073 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
|
4074 len2_byte, start1, start1_byte) |
939760ef7379
(Fformat): Be sure to convert 8-bit characters to
Kenichi Handa <handa@m17n.org>
parents:
28545
diff
changeset
|
4075 || 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
|
4076 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
|
4077 || 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
|
4078 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
|
4079 abort (); |
21245
6cde55b7c9de
Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents:
21235
diff
changeset
|
4080 } |
6cde55b7c9de
Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents:
21235
diff
changeset
|
4081 else |
6cde55b7c9de
Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents:
21235
diff
changeset
|
4082 { |
29008
939760ef7379
(Fformat): Be sure to convert 8-bit characters to
Kenichi Handa <handa@m17n.org>
parents:
28545
diff
changeset
|
4083 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
|
4084 len2_byte, start1, start1_byte) |
939760ef7379
(Fformat): Be sure to convert 8-bit characters to
Kenichi Handa <handa@m17n.org>
parents:
28545
diff
changeset
|
4085 || 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
|
4086 len1_byte, start2, start2_byte) |
939760ef7379
(Fformat): Be sure to convert 8-bit characters to
Kenichi Handa <handa@m17n.org>
parents:
28545
diff
changeset
|
4087 || 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
|
4088 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
|
4089 || 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
|
4090 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
|
4091 abort (); |
21245
6cde55b7c9de
Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents:
21235
diff
changeset
|
4092 } |
29008
939760ef7379
(Fformat): Be sure to convert 8-bit characters to
Kenichi Handa <handa@m17n.org>
parents:
28545
diff
changeset
|
4093 #endif |
939760ef7379
(Fformat): Be sure to convert 8-bit characters to
Kenichi Handa <handa@m17n.org>
parents:
28545
diff
changeset
|
4094 |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4095 /* 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
|
4096 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
|
4097 allocation... interesting. Later, don't fool with it now. */ |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4098 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4099 /* Working without memmove, for portability (sigh), so must be |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4100 careful of overlapping subsections of the array... */ |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4101 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4102 if (end1 == start2) /* adjacent regions */ |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4103 { |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4104 modify_region (current_buffer, start1, end2); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4105 record_change (start1, len1 + len2); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4106 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4107 tmp_interval1 = copy_intervals (cur_intv, start1, len1); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4108 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
|
4109 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
|
4110 Qnil, Qnil); |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4111 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4112 /* 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
|
4113 if (len1_byte < len2_byte) |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4114 { |
56194
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
4115 USE_SAFE_ALLOCA; |
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
4116 |
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
4117 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
|
4118 |
0b6f46029ea2
(transpose_markers): Allow for gap at start of region.
Karl Heuer <kwzh@gnu.org>
parents:
7710
diff
changeset
|
4119 /* 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
|
4120 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
|
4121 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
|
4122 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
|
4123 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
|
4124 |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
4125 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
|
4126 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
|
4127 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
|
4128 SAFE_FREE (); |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4129 } |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4130 else |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4131 /* First region not smaller than second. */ |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4132 { |
56194
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
4133 USE_SAFE_ALLOCA; |
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
4134 |
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
4135 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
|
4136 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
|
4137 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
|
4138 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
|
4139 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
|
4140 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
|
4141 SAFE_FREE (); |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4142 } |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4143 graft_intervals_into_buffer (tmp_interval1, start1 + len2, |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4144 len1, current_buffer, 0); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4145 graft_intervals_into_buffer (tmp_interval2, start1, |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4146 len2, current_buffer, 0); |
26853
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
4147 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
|
4148 update_compositions (start1 + len2, end2, CHECK_TAIL); |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4149 } |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4150 /* Non-adjacent regions, because end1 != start2, bleagh... */ |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4151 else |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4152 { |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
4153 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
|
4154 |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
4155 if (len1_byte == len2_byte) |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4156 /* Regions are same size, though, how nice. */ |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4157 { |
56194
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
4158 USE_SAFE_ALLOCA; |
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
4159 |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4160 modify_region (current_buffer, start1, end1); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4161 modify_region (current_buffer, start2, end2); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4162 record_change (start1, len1); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4163 record_change (start2, len2); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4164 tmp_interval1 = copy_intervals (cur_intv, start1, len1); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4165 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
|
4166 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
|
4167 Qnil, Qnil); |
192b3ebd108e
(Fcurrent_time_zone): Convert Fmake_list argument to Lisp_Integer.
Richard M. Stallman <rms@gnu.org>
parents:
18661
diff
changeset
|
4168 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
|
4169 Qnil, Qnil); |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4170 |
56194
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
4171 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
|
4172 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
|
4173 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
|
4174 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
|
4175 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
|
4176 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
|
4177 SAFE_FREE (); |
56194
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
4178 |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4179 graft_intervals_into_buffer (tmp_interval1, start2, |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4180 len1, current_buffer, 0); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4181 graft_intervals_into_buffer (tmp_interval2, start1, |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4182 len2, current_buffer, 0); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4183 } |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4184 |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
4185 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
|
4186 /* 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
|
4187 { |
56194
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
4188 USE_SAFE_ALLOCA; |
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
4189 |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4190 modify_region (current_buffer, start1, end2); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4191 record_change (start1, (end2 - start1)); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4192 tmp_interval1 = copy_intervals (cur_intv, start1, len1); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4193 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
|
4194 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
|
4195 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
|
4196 Qnil, Qnil); |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4197 |
7250
67bb3bb1b62d
(Ftranspose_regions): Take addresses only after move gap.
Richard M. Stallman <rms@gnu.org>
parents:
7207
diff
changeset
|
4198 /* holds region 2 */ |
56194
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
4199 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
|
4200 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
|
4201 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
|
4202 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
|
4203 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
|
4204 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
|
4205 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
|
4206 SAFE_FREE (); |
56194
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
4207 |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4208 graft_intervals_into_buffer (tmp_interval1, end2 - len1, |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4209 len1, current_buffer, 0); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4210 graft_intervals_into_buffer (tmp_interval_mid, start1 + len2, |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4211 len_mid, current_buffer, 0); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4212 graft_intervals_into_buffer (tmp_interval2, start1, |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4213 len2, current_buffer, 0); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4214 } |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4215 else |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4216 /* Second region smaller than first. */ |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4217 { |
56194
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
4218 USE_SAFE_ALLOCA; |
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
4219 |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4220 record_change (start1, (end2 - start1)); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4221 modify_region (current_buffer, start1, end2); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4222 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4223 tmp_interval1 = copy_intervals (cur_intv, start1, len1); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4224 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
|
4225 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
|
4226 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
|
4227 Qnil, Qnil); |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4228 |
7250
67bb3bb1b62d
(Ftranspose_regions): Take addresses only after move gap.
Richard M. Stallman <rms@gnu.org>
parents:
7207
diff
changeset
|
4229 /* holds region 1 */ |
56194
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
4230 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
|
4231 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
|
4232 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
|
4233 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
|
4234 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
|
4235 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
|
4236 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
|
4237 SAFE_FREE (); |
56194
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
4238 |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4239 graft_intervals_into_buffer (tmp_interval1, end2 - len1, |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4240 len1, current_buffer, 0); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4241 graft_intervals_into_buffer (tmp_interval_mid, start1 + len2, |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4242 len_mid, current_buffer, 0); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4243 graft_intervals_into_buffer (tmp_interval2, start1, |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4244 len2, current_buffer, 0); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4245 } |
26853
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
4246 |
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
4247 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
|
4248 update_compositions (end2 - len1, end2, CHECK_BORDER); |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4249 } |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4250 |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
4251 /* 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
|
4252 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
|
4253 should be organized in some sorted data tree. */ |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4254 if (NILP (leave_markers)) |
7519
987ab382275c
(Ftranspose_regions): Fix overlays after moving markers.
Karl Heuer <kwzh@gnu.org>
parents:
7506
diff
changeset
|
4255 { |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
4256 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
|
4257 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
|
4258 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
|
4259 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
|
4260 } |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4261 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4262 return Qnil; |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4263 } |
305 | 4264 |
4265 | |
4266 void | |
4267 syms_of_editfns () | |
4268 { | |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
4269 environbuf = 0; |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
4270 |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
4271 Qbuffer_access_fontify_functions |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
4272 = intern ("buffer-access-fontify-functions"); |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
4273 staticpro (&Qbuffer_access_fontify_functions); |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
4274 |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
4275 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
|
4276 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
|
4277 Vinhibit_field_text_motion = Qnil; |
19a664c654ab
(Vinhibit_field_text_motion): New variable.
Gerd Moellmann <gerd@gnu.org>
parents:
26853
diff
changeset
|
4278 |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
4279 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
|
4280 &Vbuffer_access_fontify_functions, |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
4281 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
|
4282 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
|
4283 of the buffer being accessed. */); |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
4284 Vbuffer_access_fontify_functions = Qnil; |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
4285 |
14440
e99b3302c154
(syms_of_editfns): Make buffer-access-fontify-functions
Richard M. Stallman <rms@gnu.org>
parents:
14391
diff
changeset
|
4286 { |
e99b3302c154
(syms_of_editfns): Make buffer-access-fontify-functions
Richard M. Stallman <rms@gnu.org>
parents:
14391
diff
changeset
|
4287 Lisp_Object obuf; |
e99b3302c154
(syms_of_editfns): Make buffer-access-fontify-functions
Richard M. Stallman <rms@gnu.org>
parents:
14391
diff
changeset
|
4288 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
|
4289 obuf = Fcurrent_buffer (); |
e99b3302c154
(syms_of_editfns): Make buffer-access-fontify-functions
Richard M. Stallman <rms@gnu.org>
parents:
14391
diff
changeset
|
4290 /* 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
|
4291 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
|
4292 /* 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
|
4293 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
|
4294 Qnil); |
e99b3302c154
(syms_of_editfns): Make buffer-access-fontify-functions
Richard M. Stallman <rms@gnu.org>
parents:
14391
diff
changeset
|
4295 Fset_buffer (obuf); |
e99b3302c154
(syms_of_editfns): Make buffer-access-fontify-functions
Richard M. Stallman <rms@gnu.org>
parents:
14391
diff
changeset
|
4296 } |
e99b3302c154
(syms_of_editfns): Make buffer-access-fontify-functions
Richard M. Stallman <rms@gnu.org>
parents:
14391
diff
changeset
|
4297 |
14220 | 4298 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
|
4299 &Vbuffer_access_fontified_property, |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
4300 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
|
4301 `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
|
4302 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
|
4303 Vbuffer_access_fontified_property = Qnil; |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
4304 |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
4305 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
|
4306 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
|
4307 |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
4308 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
|
4309 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
|
4310 |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
4311 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
|
4312 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
|
4313 |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
4314 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
|
4315 doc: /* The user's name, based upon the real uid only. */); |
305 | 4316 |
59644
d8d85276ffed
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
58029
diff
changeset
|
4317 DEFVAR_LISP ("operating-system-release", &Voperating_system_release, |
d8d85276ffed
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
58029
diff
changeset
|
4318 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
|
4319 |
25833
65cab65c4a28
(Fpropertize): Renamed from Fproperties.
Gerd Moellmann <gerd@gnu.org>
parents:
25815
diff
changeset
|
4320 defsubr (&Spropertize); |
305 | 4321 defsubr (&Schar_equal); |
4322 defsubr (&Sgoto_char); | |
4323 defsubr (&Sstring_to_char); | |
4324 defsubr (&Schar_to_string); | |
4325 defsubr (&Sbuffer_substring); | |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
4326 defsubr (&Sbuffer_substring_no_properties); |
305 | 4327 defsubr (&Sbuffer_string); |
4328 | |
4329 defsubr (&Spoint_marker); | |
4330 defsubr (&Smark_marker); | |
4331 defsubr (&Spoint); | |
4332 defsubr (&Sregion_beginning); | |
4333 defsubr (&Sregion_end); | |
20861
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
4334 |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
4335 staticpro (&Qfield); |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
4336 Qfield = intern ("field"); |
30439
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
4337 staticpro (&Qboundary); |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
4338 Qboundary = intern ("boundary"); |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
4339 defsubr (&Sfield_beginning); |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
4340 defsubr (&Sfield_end); |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
4341 defsubr (&Sfield_string); |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
4342 defsubr (&Sfield_string_no_properties); |
26347
7fd9f4ecdd29
(Fdelete_field): Renamed from Ferase_field.
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
4343 defsubr (&Sdelete_field); |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
4344 defsubr (&Sconstrain_to_field); |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
4345 |
20861
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
4346 defsubr (&Sline_beginning_position); |
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
4347 defsubr (&Sline_end_position); |
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
4348 |
305 | 4349 /* defsubr (&Smark); */ |
4350 /* defsubr (&Sset_mark); */ | |
4351 defsubr (&Ssave_excursion); | |
16298
17304eb73f97
(Fsave_current_buffer): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16269
diff
changeset
|
4352 defsubr (&Ssave_current_buffer); |
305 | 4353 |
4354 defsubr (&Sbufsize); | |
4355 defsubr (&Spoint_max); | |
4356 defsubr (&Spoint_min); | |
4357 defsubr (&Spoint_min_marker); | |
4358 defsubr (&Spoint_max_marker); | |
21821
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
4359 defsubr (&Sgap_position); |
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
4360 defsubr (&Sgap_size); |
20861
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
4361 defsubr (&Sposition_bytes); |
22645
e5b201634497
(Fbyte_to_position): New function.
Richard M. Stallman <rms@gnu.org>
parents:
22199
diff
changeset
|
4362 defsubr (&Sbyte_to_position); |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
4363 |
305 | 4364 defsubr (&Sbobp); |
4365 defsubr (&Seobp); | |
4366 defsubr (&Sbolp); | |
4367 defsubr (&Seolp); | |
512 | 4368 defsubr (&Sfollowing_char); |
4369 defsubr (&Sprevious_char); | |
305 | 4370 defsubr (&Schar_after); |
17031 | 4371 defsubr (&Schar_before); |
305 | 4372 defsubr (&Sinsert); |
4373 defsubr (&Sinsert_before_markers); | |
4714
350231e38e68
(Finsert_and_inherit): New function.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
4374 defsubr (&Sinsert_and_inherit); |
350231e38e68
(Finsert_and_inherit): New function.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
4375 defsubr (&Sinsert_and_inherit_before_markers); |
305 | 4376 defsubr (&Sinsert_char); |
4377 | |
4378 defsubr (&Suser_login_name); | |
4379 defsubr (&Suser_real_login_name); | |
4380 defsubr (&Suser_uid); | |
4381 defsubr (&Suser_real_uid); | |
4382 defsubr (&Suser_full_name); | |
5373
a70b89d2d6bb
(Femacs_pid): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5242
diff
changeset
|
4383 defsubr (&Semacs_pid); |
448 | 4384 defsubr (&Scurrent_time); |
57987
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
4385 defsubr (&Sget_internal_run_time); |
9154
b4739bcefc44
(Fformat_time_string): Mostly rewritten, to handle
Richard M. Stallman <rms@gnu.org>
parents:
8981
diff
changeset
|
4386 defsubr (&Sformat_time_string); |
30480 | 4387 defsubr (&Sfloat_time); |
9801
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
4388 defsubr (&Sdecode_time); |
11402
66d935214d8e
(Fencode_time): Use XINT to examine `zone'.
Richard M. Stallman <rms@gnu.org>
parents:
11263
diff
changeset
|
4389 defsubr (&Sencode_time); |
305 | 4390 defsubr (&Scurrent_time_string); |
962
3533821d6edc
* editfns.c (Fcurrent_time_zone): Doc fix.
Jim Blandy <jimb@redhat.com>
parents:
690
diff
changeset
|
4391 defsubr (&Scurrent_time_zone); |
13019
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
4392 defsubr (&Sset_time_zone_rule); |
305 | 4393 defsubr (&Ssystem_name); |
4394 defsubr (&Smessage); | |
8975
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
4395 defsubr (&Smessage_box); |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
4396 defsubr (&Smessage_or_box); |
18937
ddb91108a9d2
(Fcurrent_message): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18756
diff
changeset
|
4397 defsubr (&Scurrent_message); |
305 | 4398 defsubr (&Sformat); |
4399 | |
4400 defsubr (&Sinsert_buffer_substring); | |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
4401 defsubr (&Scompare_buffer_substrings); |
305 | 4402 defsubr (&Ssubst_char_in_region); |
57644
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
4403 defsubr (&Stranslate_region_internal); |
305 | 4404 defsubr (&Sdelete_region); |
26742
936b39bd05b4
* editfns.c (Fdelete_and_extract_region): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
26699
diff
changeset
|
4405 defsubr (&Sdelete_and_extract_region); |
305 | 4406 defsubr (&Swiden); |
4407 defsubr (&Snarrow_to_region); | |
4408 defsubr (&Ssave_restriction); | |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4409 defsubr (&Stranspose_regions); |
305 | 4410 } |
52401 | 4411 |
4412 /* arch-tag: fc3827d8-6f60-4067-b11e-c3218031b018 | |
4413 (do not change this comment) */ |