Mercurial > emacs
annotate src/editfns.c @ 90600:84dd84b43e1b
Merge from emacs--devo--0
Patches applied:
* emacs--devo--0 (patch 423-426)
- Update from CVS
- Merge from gnus--rel--5.10
* gnus--rel--5.10 (patch 131-133)
- Update from CVS
Revision: emacs@sv.gnu.org/emacs--unicode--0--patch-109
author | Miles Bader <miles@gnu.org> |
---|---|
date | Wed, 06 Sep 2006 07:30:39 +0000 |
parents | c358d0861b16 d8f99fba05ca |
children | a1a25ac6c88a |
rev | line source |
---|---|
305 | 1 /* Lisp functions pertaining to editing. |
64770
a0d1312ede66
Update years in copyright notice; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
64084
diff
changeset
|
2 Copyright (C) 1985, 1986, 1987, 1989, 1993, 1994, 1995, 1996, |
a0d1312ede66
Update years in copyright notice; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
64084
diff
changeset
|
3 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, |
68651
3bd95f4f2941
Update years in copyright notice; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
68626
diff
changeset
|
4 2005, 2006 Free Software Foundation, Inc. |
305 | 5 |
6 This file is part of GNU Emacs. | |
7 | |
8 GNU Emacs is free software; you can redistribute it and/or modify | |
9 it under the terms of the GNU General Public License as published by | |
12244 | 10 the Free Software Foundation; either version 2, or (at your option) |
305 | 11 any later version. |
12 | |
13 GNU Emacs is distributed in the hope that it will be useful, | |
14 but WITHOUT ANY WARRANTY; without even the implied warranty of | |
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
16 GNU General Public License for more details. | |
17 | |
18 You should have received a copy of the GNU General Public License | |
19 along with GNU Emacs; see the file COPYING. If not, write to | |
64084 | 20 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
21 Boston, MA 02110-1301, USA. */ | |
305 | 22 |
23 | |
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
parents:
26058
diff
changeset
|
24 #include <config.h> |
2962
79314d830f7d
* editfns.c: #include <sys/types.h>, to get time_t for Eggert's
Jim Blandy <jimb@redhat.com>
parents:
2921
diff
changeset
|
25 #include <sys/types.h> |
58029
46a652255057
Move #include "systime.h" before <sys/resource.h>.
Eli Zaretskii <eliz@gnu.org>
parents:
58011
diff
changeset
|
26 #include <stdio.h> |
2962
79314d830f7d
* editfns.c: #include <sys/types.h>, to get time_t for Eggert's
Jim Blandy <jimb@redhat.com>
parents:
2921
diff
changeset
|
27 |
61700
8a54ce1fae6a
Remove reference to defunct vms-pwd.h.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
61017
diff
changeset
|
28 #ifdef HAVE_PWD_H |
305 | 29 #include <pwd.h> |
372 | 30 #endif |
31 | |
21514 | 32 #ifdef HAVE_UNISTD_H |
33 #include <unistd.h> | |
34 #endif | |
35 | |
59644
d8d85276ffed
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
58029
diff
changeset
|
36 #ifdef HAVE_SYS_UTSNAME_H |
d8d85276ffed
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
58029
diff
changeset
|
37 #include <sys/utsname.h> |
d8d85276ffed
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
58029
diff
changeset
|
38 #endif |
d8d85276ffed
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
58029
diff
changeset
|
39 |
65763
1a50ac5aaa75
Move systime.h include after lisp.h.
Dan Nicolaescu <dann@ics.uci.edu>
parents:
65739
diff
changeset
|
40 #include "lisp.h" |
1a50ac5aaa75
Move systime.h include after lisp.h.
Dan Nicolaescu <dann@ics.uci.edu>
parents:
65739
diff
changeset
|
41 |
58029
46a652255057
Move #include "systime.h" before <sys/resource.h>.
Eli Zaretskii <eliz@gnu.org>
parents:
58011
diff
changeset
|
42 /* 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
|
43 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
|
44 <sys/resource.h> */ |
46a652255057
Move #include "systime.h" before <sys/resource.h>.
Eli Zaretskii <eliz@gnu.org>
parents:
58011
diff
changeset
|
45 #include "systime.h" |
58011
79614f2016d5
editfns.c: Adding in better patch
Steven Tamm <steventamm@mac.com>
parents:
58010
diff
changeset
|
46 |
79614f2016d5
editfns.c: Adding in better patch
Steven Tamm <steventamm@mac.com>
parents:
58010
diff
changeset
|
47 #if defined HAVE_SYS_RESOURCE_H |
57987
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
48 #include <sys/resource.h> |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
49 #endif |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
50 |
40699
d51d2fa675d0
Move the include of ctype.h after unistd.h.
Richard M. Stallman <rms@gnu.org>
parents:
40656
diff
changeset
|
51 #include <ctype.h> |
d51d2fa675d0
Move the include of ctype.h after unistd.h.
Richard M. Stallman <rms@gnu.org>
parents:
40656
diff
changeset
|
52 |
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" |
88372
7d0adc8c7f07
Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents:
43042
diff
changeset
|
55 #include "character.h" |
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
parents:
26058
diff
changeset
|
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" |
71817
fb57c1830788
Include blockinput.h.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents:
71498
diff
changeset
|
59 #include "blockinput.h" |
305 | 60 |
38519
200c049178cc
(toplevel) [STDC_HEADERS]: Include float.h.
Gerd Moellmann <gerd@gnu.org>
parents:
38059
diff
changeset
|
61 #ifdef STDC_HEADERS |
200c049178cc
(toplevel) [STDC_HEADERS]: Include float.h.
Gerd Moellmann <gerd@gnu.org>
parents:
38059
diff
changeset
|
62 #include <float.h> |
200c049178cc
(toplevel) [STDC_HEADERS]: Include float.h.
Gerd Moellmann <gerd@gnu.org>
parents:
38059
diff
changeset
|
63 #define MAX_10_EXP DBL_MAX_10_EXP |
200c049178cc
(toplevel) [STDC_HEADERS]: Include float.h.
Gerd Moellmann <gerd@gnu.org>
parents:
38059
diff
changeset
|
64 #else |
200c049178cc
(toplevel) [STDC_HEADERS]: Include float.h.
Gerd Moellmann <gerd@gnu.org>
parents:
38059
diff
changeset
|
65 #define MAX_10_EXP 310 |
200c049178cc
(toplevel) [STDC_HEADERS]: Include float.h.
Gerd Moellmann <gerd@gnu.org>
parents:
38059
diff
changeset
|
66 #endif |
200c049178cc
(toplevel) [STDC_HEADERS]: Include float.h.
Gerd Moellmann <gerd@gnu.org>
parents:
38059
diff
changeset
|
67 |
19441
2e2b54ae9b9d
(NULL): Define, if not defined.
Richard M. Stallman <rms@gnu.org>
parents:
19416
diff
changeset
|
68 #ifndef NULL |
2e2b54ae9b9d
(NULL): Define, if not defined.
Richard M. Stallman <rms@gnu.org>
parents:
19416
diff
changeset
|
69 #define NULL 0 |
2e2b54ae9b9d
(NULL): Define, if not defined.
Richard M. Stallman <rms@gnu.org>
parents:
19416
diff
changeset
|
70 #endif |
2e2b54ae9b9d
(NULL): Define, if not defined.
Richard M. Stallman <rms@gnu.org>
parents:
19416
diff
changeset
|
71 |
31095
e19d38e14720
[USE_CRT_DLL]: Remove unnecessary extern, which screws
Andrew Innes <andrewi@gnu.org>
parents:
31016
diff
changeset
|
72 #ifndef USE_CRT_DLL |
13025
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
73 extern char **environ; |
31095
e19d38e14720
[USE_CRT_DLL]: Remove unnecessary extern, which screws
Andrew Innes <andrewi@gnu.org>
parents:
31016
diff
changeset
|
74 #endif |
e19d38e14720
[USE_CRT_DLL]: Remove unnecessary extern, which screws
Andrew Innes <andrewi@gnu.org>
parents:
31016
diff
changeset
|
75 |
69664
55e66496ae1a
* editfns.c: (TM_YEAR_BASE): Move up.
Paul Eggert <eggert@twinsun.com>
parents:
68669
diff
changeset
|
76 #define TM_YEAR_BASE 1900 |
55e66496ae1a
* editfns.c: (TM_YEAR_BASE): Move up.
Paul Eggert <eggert@twinsun.com>
parents:
68669
diff
changeset
|
77 |
69790
1e68e7f3b824
* lib-src/b2m.c (main): Don't include <limits.h>.
Paul Eggert <eggert@twinsun.com>
parents:
69673
diff
changeset
|
78 /* Nonzero if TM_YEAR is a struct tm's tm_year value that causes |
1e68e7f3b824
* lib-src/b2m.c (main): Don't include <limits.h>.
Paul Eggert <eggert@twinsun.com>
parents:
69673
diff
changeset
|
79 asctime to have well-defined behavior. */ |
1e68e7f3b824
* lib-src/b2m.c (main): Don't include <limits.h>.
Paul Eggert <eggert@twinsun.com>
parents:
69673
diff
changeset
|
80 #ifndef TM_YEAR_IN_ASCTIME_RANGE |
1e68e7f3b824
* lib-src/b2m.c (main): Don't include <limits.h>.
Paul Eggert <eggert@twinsun.com>
parents:
69673
diff
changeset
|
81 # define TM_YEAR_IN_ASCTIME_RANGE(tm_year) \ |
1e68e7f3b824
* lib-src/b2m.c (main): Don't include <limits.h>.
Paul Eggert <eggert@twinsun.com>
parents:
69673
diff
changeset
|
82 (1000 - TM_YEAR_BASE <= (tm_year) && (tm_year) <= 9999 - TM_YEAR_BASE) |
1e68e7f3b824
* lib-src/b2m.c (main): Don't include <limits.h>.
Paul Eggert <eggert@twinsun.com>
parents:
69673
diff
changeset
|
83 #endif |
1e68e7f3b824
* lib-src/b2m.c (main): Don't include <limits.h>.
Paul Eggert <eggert@twinsun.com>
parents:
69673
diff
changeset
|
84 |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
85 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
|
86 const struct tm *, int)); |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
87 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
|
88 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
|
89 static void update_buffer_properties P_ ((int, int)); |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
90 static Lisp_Object region_limit P_ ((int)); |
55193
1b09eb24ab02
(lisp_time_argument): Provide externally.
Eli Zaretskii <eliz@gnu.org>
parents:
54846
diff
changeset
|
91 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
|
92 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
|
93 size_t, const struct tm *, int)); |
46464
e05dd5b81fc7
(general_insert_function): Insertion function now
Ken Raeburn <raeburn@raeburn.org>
parents:
46447
diff
changeset
|
94 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
|
95 void (*) (Lisp_Object, int, int, int, |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
96 int, int), |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
97 int, int, Lisp_Object *)); |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
98 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
|
99 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
|
100 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
|
101 |
31336 | 102 #ifdef HAVE_INDEX |
103 extern char *index P_ ((const char *, int)); | |
104 #endif | |
105 | |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
106 Lisp_Object Vbuffer_access_fontify_functions; |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
107 Lisp_Object Qbuffer_access_fontify_functions; |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
108 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
|
109 |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
110 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
|
111 |
27077
19a664c654ab
(Vinhibit_field_text_motion): New variable.
Gerd Moellmann <gerd@gnu.org>
parents:
26853
diff
changeset
|
112 /* 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
|
113 |
19a664c654ab
(Vinhibit_field_text_motion): New variable.
Gerd Moellmann <gerd@gnu.org>
parents:
26853
diff
changeset
|
114 Lisp_Object Vinhibit_field_text_motion; |
19a664c654ab
(Vinhibit_field_text_motion): New variable.
Gerd Moellmann <gerd@gnu.org>
parents:
26853
diff
changeset
|
115 |
305 | 116 /* Some static data, and a function to initialize it for each run */ |
117 | |
118 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
|
119 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
|
120 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
|
121 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
|
122 Lisp_Object Voperating_system_release; /* Operating System Release */ |
305 | 123 |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
124 /* Symbol for the text property used to mark fields. */ |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
125 |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
126 Lisp_Object Qfield; |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
127 |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
128 /* A special value for Qfield properties. */ |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
129 |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
130 Lisp_Object Qboundary; |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
131 |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
132 |
305 | 133 void |
134 init_editfns () | |
135 { | |
330 | 136 char *user_name; |
25782
8f59abd3a02b
(init_editfns): Remove unused variables.
Gerd Moellmann <gerd@gnu.org>
parents:
25662
diff
changeset
|
137 register unsigned char *p; |
305 | 138 struct passwd *pw; /* password entry for the current user */ |
139 Lisp_Object tem; | |
140 | |
141 /* 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
|
142 init_system_name (); |
305 | 143 |
144 #ifndef CANNOT_DUMP | |
145 /* Don't bother with this on initial start when just dumping out */ | |
146 if (!initialized) | |
147 return; | |
148 #endif /* not CANNOT_DUMP */ | |
149 | |
150 pw = (struct passwd *) getpwuid (getuid ()); | |
9572 | 151 #ifdef MSDOS |
152 /* We let the real user name default to "root" because that's quite | |
153 accurate on MSDOG and because it lets Emacs find the init file. | |
154 (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
|
155 Vuser_real_login_name = build_string (pw ? pw->pw_name : "root"); |
9572 | 156 #else |
12026
505a894d943e
(syms_of_editfns): user-login-name renamed from user-name.
Karl Heuer <kwzh@gnu.org>
parents:
11912
diff
changeset
|
157 Vuser_real_login_name = build_string (pw ? pw->pw_name : "unknown"); |
9572 | 158 #endif |
305 | 159 |
330 | 160 /* Get the effective user name, by consulting environment variables, |
161 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
|
162 user_name = (char *) getenv ("LOGNAME"); |
330 | 163 if (!user_name) |
9801
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
164 #ifdef WINDOWSNT |
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
165 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
|
166 #else /* WINDOWSNT */ |
5907
5fdb226fe9a4
(init_editfns): Look at LOGNAME before USER.
Karl Heuer <kwzh@gnu.org>
parents:
5884
diff
changeset
|
167 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
|
168 #endif /* WINDOWSNT */ |
305 | 169 if (!user_name) |
330 | 170 { |
171 pw = (struct passwd *) getpwuid (geteuid ()); | |
172 user_name = (char *) (pw ? pw->pw_name : "unknown"); | |
173 } | |
12026
505a894d943e
(syms_of_editfns): user-login-name renamed from user-name.
Karl Heuer <kwzh@gnu.org>
parents:
11912
diff
changeset
|
174 Vuser_login_name = build_string (user_name); |
305 | 175 |
330 | 176 /* If the user name claimed in the environment vars differs from |
177 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
|
178 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
|
179 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
|
180 : Vuser_login_name); |
30480 | 181 |
11447
d51e912495be
(init_editfns): Add casts.
Richard M. Stallman <rms@gnu.org>
parents:
11433
diff
changeset
|
182 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
|
183 if (p) |
9ab21ef32537
(init_editfns): Use NAME envvar to init user-full-name.
Richard M. Stallman <rms@gnu.org>
parents:
10480
diff
changeset
|
184 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
|
185 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
|
186 Vuser_full_name = build_string ("unknown"); |
59644
d8d85276ffed
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
58029
diff
changeset
|
187 |
d8d85276ffed
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
58029
diff
changeset
|
188 #ifdef HAVE_SYS_UTSNAME_H |
d8d85276ffed
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
58029
diff
changeset
|
189 { |
d8d85276ffed
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
58029
diff
changeset
|
190 struct utsname uts; |
d8d85276ffed
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
58029
diff
changeset
|
191 uname (&uts); |
d8d85276ffed
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
58029
diff
changeset
|
192 Voperating_system_release = build_string (uts.release); |
d8d85276ffed
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
58029
diff
changeset
|
193 } |
d8d85276ffed
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
58029
diff
changeset
|
194 #else |
d8d85276ffed
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
58029
diff
changeset
|
195 Voperating_system_release = Qnil; |
d8d85276ffed
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
58029
diff
changeset
|
196 #endif |
305 | 197 } |
198 | |
199 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
|
200 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
|
201 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
|
202 (character) |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
203 Lisp_Object character; |
305 | 204 { |
17031 | 205 int len; |
26853
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
206 unsigned char str[MAX_MULTIBYTE_LENGTH]; |
17031 | 207 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
208 CHECK_NUMBER (character); |
305 | 209 |
88372
7d0adc8c7f07
Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents:
43042
diff
changeset
|
210 len = CHAR_STRING (XFASTINT (character), str); |
21257
205a5aa4aa2f
(Fchar_to_string): Use make_string_from_bytes.
Richard M. Stallman <rms@gnu.org>
parents:
21245
diff
changeset
|
211 return make_string_from_bytes (str, 1, len); |
305 | 212 } |
213 | |
214 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
|
215 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
|
216 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
|
217 (string) |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
218 register Lisp_Object string; |
305 | 219 { |
220 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
|
221 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
|
222 if (SCHARS (string)) |
23650
3cc42e65f25b
(Fstring_to_char): Don't return a multibyte character
Kenichi Handa <handa@m17n.org>
parents:
23596
diff
changeset
|
223 { |
3cc42e65f25b
(Fstring_to_char): Don't return a multibyte character
Kenichi Handa <handa@m17n.org>
parents:
23596
diff
changeset
|
224 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
|
225 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
|
226 else |
46443
b612fecce4cc
(Fstring_to_char): Use string macros instead of Lisp_String fields.
Ken Raeburn <raeburn@raeburn.org>
parents:
46370
diff
changeset
|
227 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
|
228 } |
305 | 229 else |
9305
ac077e2a75f1
(Fstring_to_char, Fpoint, Fbufsize, Fpoint_min, Fpoint_max, Ffollowing_char,
Karl Heuer <kwzh@gnu.org>
parents:
9265
diff
changeset
|
230 XSETFASTINT (val, 0); |
305 | 231 return val; |
232 } | |
233 | |
234 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
|
235 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
|
236 int charpos, bytepos; |
305 | 237 { |
238 register Lisp_Object mark; | |
239 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
|
240 set_marker_both (mark, Qnil, charpos, bytepos); |
305 | 241 return mark; |
242 } | |
243 | |
244 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
|
245 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
|
246 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
|
247 () |
305 | 248 { |
249 Lisp_Object temp; | |
16039
855c8d8ba0f0
Change all references from point to PT.
Karl Heuer <kwzh@gnu.org>
parents:
15910
diff
changeset
|
250 XSETFASTINT (temp, PT); |
305 | 251 return temp; |
252 } | |
253 | |
254 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
|
255 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
|
256 () |
305 | 257 { |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
258 return buildmark (PT, PT_BYTE); |
305 | 259 } |
260 | |
261 int | |
262 clip_to_bounds (lower, num, upper) | |
263 int lower, num, upper; | |
264 { | |
265 if (num < lower) | |
266 return lower; | |
267 else if (num > upper) | |
268 return upper; | |
269 else | |
270 return num; | |
271 } | |
272 | |
273 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
|
274 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
|
275 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
|
276 (position) |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
277 register Lisp_Object position; |
305 | 278 { |
17031 | 279 int pos; |
280 | |
21226
c8d0df2cbd3d
(Fgoto_char): If POSITION is a marker pointing a
Richard M. Stallman <rms@gnu.org>
parents:
21225
diff
changeset
|
281 if (MARKERP (position) |
c8d0df2cbd3d
(Fgoto_char): If POSITION is a marker pointing a
Richard M. Stallman <rms@gnu.org>
parents:
21225
diff
changeset
|
282 && 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
|
283 { |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
284 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
|
285 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
|
286 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
|
287 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
|
288 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
|
289 else |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
290 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
|
291 |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
292 return position; |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
293 } |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
294 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
295 CHECK_NUMBER_COERCE_MARKER (position); |
305 | 296 |
17031 | 297 pos = clip_to_bounds (BEGV, XINT (position), ZV); |
298 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
|
299 return position; |
305 | 300 } |
301 | |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
302 |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
303 /* Return the start or end position of the region. |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
304 BEGINNINGP non-zero means return the start. |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
305 If there is no region active, signal an error. */ |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
306 |
305 | 307 static Lisp_Object |
308 region_limit (beginningp) | |
309 int beginningp; | |
310 { | |
4047
e950abdc9ed2
(region_limit): Declare Vmark_even_if_inactive.
Roland McGrath <roland@gnu.org>
parents:
4038
diff
changeset
|
311 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
|
312 Lisp_Object m; |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49472
diff
changeset
|
313 |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
314 if (!NILP (Vtransient_mark_mode) |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
315 && 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
|
316 && NILP (current_buffer->mark_active)) |
71975
6d29dff081c5
(region_limit, Fget_internal_run_time): Use xsignal0.
Kim F. Storm <storm@cua.dk>
parents:
71865
diff
changeset
|
317 xsignal0 (Qmark_inactive); |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49472
diff
changeset
|
318 |
305 | 319 m = Fmarker_position (current_buffer->mark); |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
320 if (NILP (m)) |
43042
63639e690611
(region_limit): Nicer error message.
Richard M. Stallman <rms@gnu.org>
parents:
42484
diff
changeset
|
321 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
|
322 |
52451
c7860e5cc982
(region_limit): Support any non-zero value of BEGINNINGP.
Eli Zaretskii <eliz@gnu.org>
parents:
52401
diff
changeset
|
323 if ((PT < XFASTINT (m)) == (beginningp != 0)) |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
324 m = make_number (PT); |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
325 return m; |
305 | 326 } |
327 | |
328 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
|
329 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
|
330 () |
305 | 331 { |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
332 return region_limit (1); |
305 | 333 } |
334 | |
335 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
|
336 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
|
337 () |
305 | 338 { |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
339 return region_limit (0); |
305 | 340 } |
341 | |
342 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
|
343 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
|
344 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
|
345 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
|
346 () |
305 | 347 { |
348 return current_buffer->mark; | |
349 } | |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
350 |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
351 |
48094
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
352 /* 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
|
353 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
|
354 of length LEN. */ |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
355 |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
356 static int |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
357 overlays_around (pos, vec, len) |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
358 int pos; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
359 Lisp_Object *vec; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
360 int len; |
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 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
|
363 struct Lisp_Overlay *tail; |
48094
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
364 int startpos, endpos; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
365 int idx = 0; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
366 |
51841
59ba1f5d0a16
(overlays_around): Use new type for overlays_(before|after).
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
51670
diff
changeset
|
367 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
|
368 { |
51841
59ba1f5d0a16
(overlays_around): Use new type for overlays_(before|after).
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
51670
diff
changeset
|
369 XSETMISC (overlay, tail); |
48094
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
370 |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
371 end = OVERLAY_END (overlay); |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
372 endpos = OVERLAY_POSITION (end); |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
373 if (endpos < pos) |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
374 break; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
375 start = OVERLAY_START (overlay); |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
376 startpos = OVERLAY_POSITION (start); |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
377 if (startpos <= pos) |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
378 { |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
379 if (idx < len) |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
380 vec[idx] = overlay; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
381 /* 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
|
382 idx++; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
383 } |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
384 } |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
385 |
51841
59ba1f5d0a16
(overlays_around): Use new type for overlays_(before|after).
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
51670
diff
changeset
|
386 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
|
387 { |
51841
59ba1f5d0a16
(overlays_around): Use new type for overlays_(before|after).
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
51670
diff
changeset
|
388 XSETMISC (overlay, tail); |
48094
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
389 |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
390 start = OVERLAY_START (overlay); |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
391 startpos = OVERLAY_POSITION (start); |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
392 if (pos < startpos) |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
393 break; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
394 end = OVERLAY_END (overlay); |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
395 endpos = OVERLAY_POSITION (end); |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
396 if (pos <= endpos) |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
397 { |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
398 if (idx < len) |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
399 vec[idx] = overlay; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
400 idx++; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
401 } |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
402 } |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
403 |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
404 return idx; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
405 } |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
406 |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
407 /* 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
|
408 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
|
409 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
|
410 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
|
411 text properties. |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
412 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
|
413 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
|
414 with OBJECT. */ |
48134
ef2b87569c38
(get_pos_property): Don't hardcode Qfield.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48115
diff
changeset
|
415 Lisp_Object |
48094
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
416 get_pos_property (position, prop, object) |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
417 Lisp_Object position, object; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
418 register Lisp_Object prop; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
419 { |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
420 CHECK_NUMBER_COERCE_MARKER (position); |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
421 |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
422 if (NILP (object)) |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
423 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
|
424 else if (WINDOWP (object)) |
edeae7524de9
(get_pos_property): Don't assume that `object' = nil.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50746
diff
changeset
|
425 object = XWINDOW (object)->buffer; |
edeae7524de9
(get_pos_property): Don't assume that `object' = nil.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50746
diff
changeset
|
426 |
edeae7524de9
(get_pos_property): Don't assume that `object' = nil.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50746
diff
changeset
|
427 if (!BUFFERP (object)) |
edeae7524de9
(get_pos_property): Don't assume that `object' = nil.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50746
diff
changeset
|
428 /* 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
|
429 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
|
430 could be obeyed. */ |
edeae7524de9
(get_pos_property): Don't assume that `object' = nil.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50746
diff
changeset
|
431 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
|
432 else |
48094
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 int posn = XINT (position); |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
435 int noverlays; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
436 Lisp_Object *overlay_vec, tem; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
437 struct buffer *obuf = current_buffer; |
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 set_buffer_temp (XBUFFER (object)); |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
440 |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
441 /* 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
|
442 noverlays = 40; |
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 /* If there are more than 40, |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
447 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
|
448 if (noverlays > 40) |
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 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
|
451 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
|
452 } |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
453 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
|
454 |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
455 set_buffer_temp (obuf); |
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 /* 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
|
458 while (--noverlays >= 0) |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
459 { |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
460 Lisp_Object ol = overlay_vec[noverlays]; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
461 tem = Foverlay_get (ol, prop); |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
462 if (!NILP (tem)) |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
463 { |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
464 /* 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
|
465 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
|
466 if ((OVERLAY_POSITION (start) == posn |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
467 && XMARKER (start)->insertion_type == 1) |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
468 || (OVERLAY_POSITION (finish) == posn |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
469 && XMARKER (finish)->insertion_type == 0)) |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
470 ; /* 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
|
471 else |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
472 { |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
473 return tem; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
474 } |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
475 } |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
476 } |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49472
diff
changeset
|
477 |
51042
edeae7524de9
(get_pos_property): Don't assume that `object' = nil.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50746
diff
changeset
|
478 { /* 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
|
479 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
|
480 if (stickiness > 0) |
edeae7524de9
(get_pos_property): Don't assume that `object' = nil.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50746
diff
changeset
|
481 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
|
482 else if (stickiness < 0 |
edeae7524de9
(get_pos_property): Don't assume that `object' = nil.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50746
diff
changeset
|
483 && 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
|
484 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
|
485 prop, object); |
edeae7524de9
(get_pos_property): Don't assume that `object' = nil.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50746
diff
changeset
|
486 else |
edeae7524de9
(get_pos_property): Don't assume that `object' = nil.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50746
diff
changeset
|
487 return Qnil; |
edeae7524de9
(get_pos_property): Don't assume that `object' = nil.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50746
diff
changeset
|
488 } |
48094
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
489 } |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
490 } |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
491 |
26389
e2acf63b5403
(Fline_beginning_position): If N is not 1,
Richard M. Stallman <rms@gnu.org>
parents:
26372
diff
changeset
|
492 /* Find the field surrounding POS in *BEG and *END. If POS is nil, |
70188 | 493 the value of point is used instead. If BEG or END is null, |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
494 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
|
495 |
41065
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
496 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
|
497 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
|
498 |
70213
e9ea7c53ddc7
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-245
Miles Bader <miles@gnu.org>
parents:
70188
diff
changeset
|
499 If MERGE_AT_BOUNDARY is nonzero, then if POS is at the very first |
e9ea7c53ddc7
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-245
Miles Bader <miles@gnu.org>
parents:
70188
diff
changeset
|
500 position of a field, then the beginning of the previous field is |
e9ea7c53ddc7
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-245
Miles Bader <miles@gnu.org>
parents:
70188
diff
changeset
|
501 returned instead of the beginning of POS's field (since the end of a |
e9ea7c53ddc7
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-245
Miles Bader <miles@gnu.org>
parents:
70188
diff
changeset
|
502 field is actually also the beginning of the next input field, this |
e9ea7c53ddc7
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-245
Miles Bader <miles@gnu.org>
parents:
70188
diff
changeset
|
503 behavior is sometimes useful). Additionally in the MERGE_AT_BOUNDARY |
30439
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
504 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
|
505 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
|
506 fields are considered to be adjacent, and POS between them, when |
70213
e9ea7c53ddc7
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-245
Miles Bader <miles@gnu.org>
parents:
70188
diff
changeset
|
507 finding the beginning and ending of the "merged" field. |
e9ea7c53ddc7
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-245
Miles Bader <miles@gnu.org>
parents:
70188
diff
changeset
|
508 |
e9ea7c53ddc7
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-245
Miles Bader <miles@gnu.org>
parents:
70188
diff
changeset
|
509 Either BEG or END may be 0, in which case the corresponding value |
e9ea7c53ddc7
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-245
Miles Bader <miles@gnu.org>
parents:
70188
diff
changeset
|
510 is not stored. */ |
26389
e2acf63b5403
(Fline_beginning_position): If N is not 1,
Richard M. Stallman <rms@gnu.org>
parents:
26372
diff
changeset
|
511 |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
512 static void |
41065
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
513 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
|
514 Lisp_Object pos; |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
515 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
|
516 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
|
517 int *beg, *end; |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
518 { |
30439
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
519 /* Fields right before and after the point. */ |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
520 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
|
521 /* 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
|
522 int at_field_start = 0; |
e2acf63b5403
(Fline_beginning_position): If N is not 1,
Richard M. Stallman <rms@gnu.org>
parents:
26372
diff
changeset
|
523 /* 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
|
524 int at_field_end = 0; |
30439
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
525 |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
526 if (NILP (pos)) |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
527 XSETFASTINT (pos, PT); |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
528 else |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
529 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
|
530 |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
531 after_field |
48094
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
532 = get_char_property_and_overlay (pos, Qfield, Qnil, NULL); |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
533 before_field |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
534 = (XFASTINT (pos) > BEGV |
32850 | 535 ? 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
|
536 Qfield, Qnil, NULL) |
68394
0b6d0aad4517
(Fconstrain_to_field): Fix behaviour on field boundaries.
Károly Lőrentey <lorentey@elte.hu>
parents:
68392
diff
changeset
|
537 /* Using nil here would be a more obvious choice, but it would |
0b6d0aad4517
(Fconstrain_to_field): Fix behaviour on field boundaries.
Károly Lőrentey <lorentey@elte.hu>
parents:
68392
diff
changeset
|
538 fail when the buffer starts with a non-sticky field. */ |
0b6d0aad4517
(Fconstrain_to_field): Fix behaviour on field boundaries.
Károly Lőrentey <lorentey@elte.hu>
parents:
68392
diff
changeset
|
539 : after_field); |
30439
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
540 |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
541 /* 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
|
542 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
|
543 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
|
544 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
|
545 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
|
546 specially. */ |
48094
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
547 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
|
548 { |
48094
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
549 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
|
550 if (!EQ (field, after_field)) |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
551 at_field_end = 1; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
552 if (!EQ (field, before_field)) |
30439
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
553 at_field_start = 1; |
48111
7103ad01172d
(find_field): Make an exception for nil fields.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48094
diff
changeset
|
554 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
|
555 /* 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
|
556 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
|
557 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
|
558 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
|
559 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
|
560 } |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
561 |
30439
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
562 /* Note about special `boundary' fields: |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
563 |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
564 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
|
565 |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
566 xxxx.yyyy |
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 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
|
569 `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
|
570 of the field is the end of `y'. |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
571 |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
572 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
|
573 (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
|
574 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
|
575 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
|
576 |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
577 xxx.BBBByyyy |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
578 |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
579 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
|
580 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
|
581 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
|
582 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
|
583 |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
584 if (beg) |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
585 { |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
586 if (at_field_start) |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
587 /* 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
|
588 the beginning of the following field. */ |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
589 *beg = XFASTINT (pos); |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
590 else |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
591 /* Find the previous field boundary. */ |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
592 { |
48094
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
593 Lisp_Object p = pos; |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
594 if (!NILP (merge_at_boundary) && EQ (before_field, Qboundary)) |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
595 /* Skip a `boundary' field. */ |
48094
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
596 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
|
597 beg_limit); |
48094
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
598 |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
599 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
|
600 beg_limit); |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
601 *beg = NILP (p) ? BEGV : XFASTINT (p); |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
602 } |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
603 } |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
604 |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
605 if (end) |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
606 { |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
607 if (at_field_end) |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
608 /* 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
|
609 the end of the previous field. */ |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
610 *end = XFASTINT (pos); |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
611 else |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
612 /* Find the next field boundary. */ |
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 if (!NILP (merge_at_boundary) && EQ (after_field, Qboundary)) |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
615 /* Skip a `boundary' field. */ |
41065
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
616 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
|
617 end_limit); |
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
618 |
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
619 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
|
620 end_limit); |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
621 *end = NILP (pos) ? ZV : XFASTINT (pos); |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
622 } |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
623 } |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
624 } |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
625 |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
626 |
26629
05dcbc266797
(Fdelete_field): Make it noninteractive. Return nil.
Richard M. Stallman <rms@gnu.org>
parents:
26526
diff
changeset
|
627 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
|
628 doc: /* Delete the field surrounding POS. |
39966
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
629 A field is a region of text with the same `field' property. |
72194
06ca00cbd2ca
Undo 2006-06-28 change.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
71975
diff
changeset
|
630 If POS is nil, the value of point is used for POS. */) |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
631 (pos) |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
632 Lisp_Object pos; |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
633 { |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
634 int beg, end; |
41065
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
635 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
|
636 if (beg != end) |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
637 del_range (beg, end); |
26629
05dcbc266797
(Fdelete_field): Make it noninteractive. Return nil.
Richard M. Stallman <rms@gnu.org>
parents:
26526
diff
changeset
|
638 return Qnil; |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
639 } |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
640 |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
641 DEFUN ("field-string", 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
|
642 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
|
643 A field is a region of text with the same `field' property. |
72194
06ca00cbd2ca
Undo 2006-06-28 change.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
71975
diff
changeset
|
644 If POS is nil, the value of point is used for POS. */) |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
645 (pos) |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
646 Lisp_Object pos; |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
647 { |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
648 int beg, end; |
41065
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
649 find_field (pos, Qnil, Qnil, &beg, Qnil, &end); |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
650 return make_buffer_string (beg, end, 1); |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
651 } |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
652 |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
653 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
|
654 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
|
655 A field is a region of text with the same `field' property. |
72194
06ca00cbd2ca
Undo 2006-06-28 change.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
71975
diff
changeset
|
656 If POS is nil, the value of point is used for POS. */) |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
657 (pos) |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
658 Lisp_Object pos; |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
659 { |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
660 int beg, end; |
41065
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
661 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
|
662 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
|
663 } |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
664 |
41065
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
665 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
|
666 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
|
667 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
|
668 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
|
669 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
|
670 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
|
671 If LIMIT is non-nil, it is a buffer position; if the beginning of the field |
72194
06ca00cbd2ca
Undo 2006-06-28 change.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
71975
diff
changeset
|
672 is before LIMIT, then LIMIT will be returned instead. */) |
41065
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
673 (pos, escape_from_edge, limit) |
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
674 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
|
675 { |
70213
e9ea7c53ddc7
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-245
Miles Bader <miles@gnu.org>
parents:
70188
diff
changeset
|
676 int beg; |
e9ea7c53ddc7
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-245
Miles Bader <miles@gnu.org>
parents:
70188
diff
changeset
|
677 find_field (pos, escape_from_edge, limit, &beg, Qnil, 0); |
e9ea7c53ddc7
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-245
Miles Bader <miles@gnu.org>
parents:
70188
diff
changeset
|
678 return make_number (beg); |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
679 } |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
680 |
41065
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
681 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
|
682 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
|
683 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
|
684 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
|
685 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
|
686 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
|
687 If LIMIT is non-nil, it is a buffer position; if the end of the field |
72194
06ca00cbd2ca
Undo 2006-06-28 change.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
71975
diff
changeset
|
688 is after LIMIT, then LIMIT will be returned instead. */) |
41065
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
689 (pos, escape_from_edge, limit) |
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
690 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
|
691 { |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
692 int end; |
41065
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
693 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
|
694 return make_number (end); |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
695 } |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
696 |
30439
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
697 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
|
698 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
|
699 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
700 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
|
701 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
|
702 constrained position if that is different. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
703 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
704 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
|
705 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
|
706 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
|
707 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
|
708 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
|
709 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
|
710 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
|
711 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
|
712 also considered to be `on the boundary'. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
713 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
714 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
|
715 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
|
716 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
|
717 \\[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
|
718 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
|
719 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
720 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
|
721 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
|
722 |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
723 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
|
724 (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
|
725 Lisp_Object new_pos, old_pos; |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
726 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
|
727 { |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
728 /* 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
|
729 int orig_point = 0; |
68626
ee9f9dd4337d
(Fconstrain_to_field): Fix int/Lisp_Object mixup.
Ken Raeburn <raeburn@raeburn.org>
parents:
68394
diff
changeset
|
730 int fwd; |
ee9f9dd4337d
(Fconstrain_to_field): Fix int/Lisp_Object mixup.
Ken Raeburn <raeburn@raeburn.org>
parents:
68394
diff
changeset
|
731 Lisp_Object prev_old, prev_new; |
69664
55e66496ae1a
* editfns.c: (TM_YEAR_BASE): Move up.
Paul Eggert <eggert@twinsun.com>
parents:
68669
diff
changeset
|
732 |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
733 if (NILP (new_pos)) |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
734 /* 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
|
735 { |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
736 orig_point = PT; |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
737 XSETFASTINT (new_pos, PT); |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
738 } |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
739 |
68394
0b6d0aad4517
(Fconstrain_to_field): Fix behaviour on field boundaries.
Károly Lőrentey <lorentey@elte.hu>
parents:
68392
diff
changeset
|
740 CHECK_NUMBER_COERCE_MARKER (new_pos); |
0b6d0aad4517
(Fconstrain_to_field): Fix behaviour on field boundaries.
Károly Lőrentey <lorentey@elte.hu>
parents:
68392
diff
changeset
|
741 CHECK_NUMBER_COERCE_MARKER (old_pos); |
0b6d0aad4517
(Fconstrain_to_field): Fix behaviour on field boundaries.
Károly Lőrentey <lorentey@elte.hu>
parents:
68392
diff
changeset
|
742 |
0b6d0aad4517
(Fconstrain_to_field): Fix behaviour on field boundaries.
Károly Lőrentey <lorentey@elte.hu>
parents:
68392
diff
changeset
|
743 fwd = (XFASTINT (new_pos) > XFASTINT (old_pos)); |
0b6d0aad4517
(Fconstrain_to_field): Fix behaviour on field boundaries.
Károly Lőrentey <lorentey@elte.hu>
parents:
68392
diff
changeset
|
744 |
0b6d0aad4517
(Fconstrain_to_field): Fix behaviour on field boundaries.
Károly Lőrentey <lorentey@elte.hu>
parents:
68392
diff
changeset
|
745 prev_old = make_number (XFASTINT (old_pos) - 1); |
0b6d0aad4517
(Fconstrain_to_field): Fix behaviour on field boundaries.
Károly Lőrentey <lorentey@elte.hu>
parents:
68392
diff
changeset
|
746 prev_new = make_number (XFASTINT (new_pos) - 1); |
69664
55e66496ae1a
* editfns.c: (TM_YEAR_BASE): Move up.
Paul Eggert <eggert@twinsun.com>
parents:
68669
diff
changeset
|
747 |
27081
f068649f1c28
(Fconstrain_to_field): Don't constrain if
Gerd Moellmann <gerd@gnu.org>
parents:
27077
diff
changeset
|
748 if (NILP (Vinhibit_field_text_motion) |
f068649f1c28
(Fconstrain_to_field): Don't constrain if
Gerd Moellmann <gerd@gnu.org>
parents:
27077
diff
changeset
|
749 && !EQ (new_pos, old_pos) |
68669
82590f3df577
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-51
Miles Bader <miles@gnu.org>
parents:
68651
diff
changeset
|
750 && (!NILP (Fget_char_property (new_pos, Qfield, Qnil)) |
82590f3df577
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-51
Miles Bader <miles@gnu.org>
parents:
68651
diff
changeset
|
751 || !NILP (Fget_char_property (old_pos, Qfield, Qnil)) |
68394
0b6d0aad4517
(Fconstrain_to_field): Fix behaviour on field boundaries.
Károly Lőrentey <lorentey@elte.hu>
parents:
68392
diff
changeset
|
752 /* To recognize field boundaries, we must also look at the |
0b6d0aad4517
(Fconstrain_to_field): Fix behaviour on field boundaries.
Károly Lőrentey <lorentey@elte.hu>
parents:
68392
diff
changeset
|
753 previous positions; we could use `get_pos_property' |
0b6d0aad4517
(Fconstrain_to_field): Fix behaviour on field boundaries.
Károly Lőrentey <lorentey@elte.hu>
parents:
68392
diff
changeset
|
754 instead, but in itself that would fail inside non-sticky |
0b6d0aad4517
(Fconstrain_to_field): Fix behaviour on field boundaries.
Károly Lőrentey <lorentey@elte.hu>
parents:
68392
diff
changeset
|
755 fields (like comint prompts). */ |
0b6d0aad4517
(Fconstrain_to_field): Fix behaviour on field boundaries.
Károly Lőrentey <lorentey@elte.hu>
parents:
68392
diff
changeset
|
756 || (XFASTINT (new_pos) > BEGV |
68669
82590f3df577
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-51
Miles Bader <miles@gnu.org>
parents:
68651
diff
changeset
|
757 && !NILP (Fget_char_property (prev_new, Qfield, Qnil))) |
68394
0b6d0aad4517
(Fconstrain_to_field): Fix behaviour on field boundaries.
Károly Lőrentey <lorentey@elte.hu>
parents:
68392
diff
changeset
|
758 || (XFASTINT (old_pos) > BEGV |
68669
82590f3df577
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-51
Miles Bader <miles@gnu.org>
parents:
68651
diff
changeset
|
759 && !NILP (Fget_char_property (prev_old, Qfield, Qnil)))) |
30439
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
760 && (NILP (inhibit_capture_property) |
68394
0b6d0aad4517
(Fconstrain_to_field): Fix behaviour on field boundaries.
Károly Lőrentey <lorentey@elte.hu>
parents:
68392
diff
changeset
|
761 /* Field boundaries are again a problem; but now we must |
0b6d0aad4517
(Fconstrain_to_field): Fix behaviour on field boundaries.
Károly Lőrentey <lorentey@elte.hu>
parents:
68392
diff
changeset
|
762 decide the case exactly, so we need to call |
0b6d0aad4517
(Fconstrain_to_field): Fix behaviour on field boundaries.
Károly Lőrentey <lorentey@elte.hu>
parents:
68392
diff
changeset
|
763 `get_pos_property' as well. */ |
0b6d0aad4517
(Fconstrain_to_field): Fix behaviour on field boundaries.
Károly Lőrentey <lorentey@elte.hu>
parents:
68392
diff
changeset
|
764 || (NILP (get_pos_property (old_pos, inhibit_capture_property, Qnil)) |
0b6d0aad4517
(Fconstrain_to_field): Fix behaviour on field boundaries.
Károly Lőrentey <lorentey@elte.hu>
parents:
68392
diff
changeset
|
765 && (XFASTINT (old_pos) <= BEGV |
68669
82590f3df577
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-51
Miles Bader <miles@gnu.org>
parents:
68651
diff
changeset
|
766 || NILP (Fget_char_property (old_pos, inhibit_capture_property, Qnil)) |
82590f3df577
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-51
Miles Bader <miles@gnu.org>
parents:
68651
diff
changeset
|
767 || NILP (Fget_char_property (prev_old, inhibit_capture_property, Qnil)))))) |
68392
a0208539b9a3
(Fconstrain_to_field): Use get_pos_property, not Fget_char_property,
Károly Lőrentey <lorentey@elte.hu>
parents:
66500
diff
changeset
|
768 /* It is possible that NEW_POS is not within the same field as |
a0208539b9a3
(Fconstrain_to_field): Use get_pos_property, not Fget_char_property,
Károly Lőrentey <lorentey@elte.hu>
parents:
66500
diff
changeset
|
769 OLD_POS; try to move NEW_POS so that it is. */ |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
770 { |
68394
0b6d0aad4517
(Fconstrain_to_field): Fix behaviour on field boundaries.
Károly Lőrentey <lorentey@elte.hu>
parents:
68392
diff
changeset
|
771 int shortage; |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
772 Lisp_Object field_bound; |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
773 |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
774 if (fwd) |
41065
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
775 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
|
776 else |
41065
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
777 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
|
778 |
30550
73040724e653
(Fconstrain_to_field): Fix the conditions for deciding when to constrain
Miles Bader <miles@gnu.org>
parents:
30503
diff
changeset
|
779 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
|
780 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
|
781 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
|
782 to FIELD_BOUND. */ |
73040724e653
(Fconstrain_to_field): Fix the conditions for deciding when to constrain
Miles Bader <miles@gnu.org>
parents:
30503
diff
changeset
|
783 ((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
|
784 /* 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
|
785 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
|
786 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
|
787 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
|
788 && (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
|
789 /* 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
|
790 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
|
791 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
|
792 || (scan_buffer ('\n', |
73040724e653
(Fconstrain_to_field): Fix the conditions for deciding when to constrain
Miles Bader <miles@gnu.org>
parents:
30503
diff
changeset
|
793 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
|
794 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
|
795 shortage != 0))) |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
796 /* 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
|
797 new_pos = field_bound; |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
798 |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
799 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
|
800 /* 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
|
801 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
|
802 } |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
803 |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
804 return new_pos; |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
805 } |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
806 |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
807 |
40042
c9ad5da1f79d
(Fline_beginning_position, Fline_end_position): Clarify documentation.
Miles Bader <miles@gnu.org>
parents:
39988
diff
changeset
|
808 DEFUN ("line-beginning-position", |
c9ad5da1f79d
(Fline_beginning_position, Fline_end_position): Clarify documentation.
Miles Bader <miles@gnu.org>
parents:
39988
diff
changeset
|
809 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
|
810 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
|
811 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
|
812 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
|
813 |
68392
a0208539b9a3
(Fconstrain_to_field): Use get_pos_property, not Fget_char_property,
Károly Lőrentey <lorentey@elte.hu>
parents:
66500
diff
changeset
|
814 This function constrains the returned position to the current field |
a0208539b9a3
(Fconstrain_to_field): Use get_pos_property, not Fget_char_property,
Károly Lőrentey <lorentey@elte.hu>
parents:
66500
diff
changeset
|
815 unless that would be on a different line than the original, |
a0208539b9a3
(Fconstrain_to_field): Use get_pos_property, not Fget_char_property,
Károly Lőrentey <lorentey@elte.hu>
parents:
66500
diff
changeset
|
816 unconstrained result. If N is nil or 1, and a front-sticky field |
a0208539b9a3
(Fconstrain_to_field): Use get_pos_property, not Fget_char_property,
Károly Lőrentey <lorentey@elte.hu>
parents:
66500
diff
changeset
|
817 starts at point, the scan stops as soon as it starts. To ignore field |
40042
c9ad5da1f79d
(Fline_beginning_position, Fline_end_position): Clarify documentation.
Miles Bader <miles@gnu.org>
parents:
39988
diff
changeset
|
818 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
|
819 |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
820 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
|
821 (n) |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
822 Lisp_Object n; |
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
823 { |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
824 int orig, orig_byte, end; |
70619
f5917c21d187
* intervals.c (set_point_both): Fix mixup before before and after
Chong Yidong <cyd@stupidchicken.com>
parents:
70213
diff
changeset
|
825 int count = SPECPDL_INDEX (); |
f5917c21d187
* intervals.c (set_point_both): Fix mixup before before and after
Chong Yidong <cyd@stupidchicken.com>
parents:
70213
diff
changeset
|
826 specbind (Qinhibit_point_motion_hooks, Qt); |
305 | 827 |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
828 if (NILP (n)) |
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
829 XSETFASTINT (n, 1); |
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
830 else |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
831 CHECK_NUMBER (n); |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
832 |
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
833 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
|
834 orig_byte = PT_BYTE; |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
835 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
|
836 end = PT; |
25647
947cb0e32a1d
(Fline_beginning_position): Handle minibuffer prompt here.
Richard M. Stallman <rms@gnu.org>
parents:
25609
diff
changeset
|
837 |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
838 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
|
839 |
70619
f5917c21d187
* intervals.c (set_point_both): Fix mixup before before and after
Chong Yidong <cyd@stupidchicken.com>
parents:
70213
diff
changeset
|
840 unbind_to (count, Qnil); |
f5917c21d187
* intervals.c (set_point_both): Fix mixup before before and after
Chong Yidong <cyd@stupidchicken.com>
parents:
70213
diff
changeset
|
841 |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
842 /* 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
|
843 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
|
844 XINT (n) != 1 ? Qt : Qnil, |
30439
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
845 Qt, Qnil); |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
846 } |
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
847 |
40042
c9ad5da1f79d
(Fline_beginning_position, Fline_end_position): Clarify documentation.
Miles Bader <miles@gnu.org>
parents:
39988
diff
changeset
|
848 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
|
849 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
|
850 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
|
851 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
|
852 |
68392
a0208539b9a3
(Fconstrain_to_field): Use get_pos_property, not Fget_char_property,
Károly Lőrentey <lorentey@elte.hu>
parents:
66500
diff
changeset
|
853 This function constrains the returned position to the current field |
a0208539b9a3
(Fconstrain_to_field): Use get_pos_property, not Fget_char_property,
Károly Lőrentey <lorentey@elte.hu>
parents:
66500
diff
changeset
|
854 unless that would be on a different line than the original, |
a0208539b9a3
(Fconstrain_to_field): Use get_pos_property, not Fget_char_property,
Károly Lőrentey <lorentey@elte.hu>
parents:
66500
diff
changeset
|
855 unconstrained result. If N is nil or 1, and a rear-sticky field ends |
a0208539b9a3
(Fconstrain_to_field): Use get_pos_property, not Fget_char_property,
Károly Lőrentey <lorentey@elte.hu>
parents:
66500
diff
changeset
|
856 at point, the scan stops as soon as it starts. To ignore field |
40042
c9ad5da1f79d
(Fline_beginning_position, Fline_end_position): Clarify documentation.
Miles Bader <miles@gnu.org>
parents:
39988
diff
changeset
|
857 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
|
858 |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
859 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
|
860 (n) |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
861 Lisp_Object n; |
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
862 { |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
863 int end_pos; |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
864 int orig = PT; |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
865 |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
866 if (NILP (n)) |
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
867 XSETFASTINT (n, 1); |
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
868 else |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
869 CHECK_NUMBER (n); |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
870 |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
871 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
|
872 |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
873 /* 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
|
874 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
|
875 Qnil, Qt, Qnil); |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
876 } |
40042
c9ad5da1f79d
(Fline_beginning_position, Fline_end_position): Clarify documentation.
Miles Bader <miles@gnu.org>
parents:
39988
diff
changeset
|
877 |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
878 |
305 | 879 Lisp_Object |
880 save_excursion_save () | |
881 { | |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
882 int visible = (XBUFFER (XWINDOW (selected_window)->buffer) |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
883 == current_buffer); |
305 | 884 |
885 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
|
886 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
|
887 Fcons (visible ? Qt : Qnil, |
32420
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
888 Fcons (current_buffer->mark_active, |
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
889 selected_window)))); |
305 | 890 } |
891 | |
892 Lisp_Object | |
893 save_excursion_restore (info) | |
15075
e8613675066c
(save_excursion_restore): Add gcpros.
Richard M. Stallman <rms@gnu.org>
parents:
15015
diff
changeset
|
894 Lisp_Object info; |
305 | 895 { |
15075
e8613675066c
(save_excursion_restore): Add gcpros.
Richard M. Stallman <rms@gnu.org>
parents:
15015
diff
changeset
|
896 Lisp_Object tem, tem1, omark, nmark; |
e8613675066c
(save_excursion_restore): Add gcpros.
Richard M. Stallman <rms@gnu.org>
parents:
15015
diff
changeset
|
897 struct gcpro gcpro1, gcpro2, gcpro3; |
32420
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
898 int visible_p; |
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
899 |
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
900 tem = Fmarker_buffer (XCAR (info)); |
305 | 901 /* If buffer being returned to is now deleted, avoid error */ |
902 /* Otherwise could get error here while unwinding to top level | |
903 and crash */ | |
904 /* In that case, Fmarker_buffer returns nil now. */ | |
488 | 905 if (NILP (tem)) |
305 | 906 return Qnil; |
15075
e8613675066c
(save_excursion_restore): Add gcpros.
Richard M. Stallman <rms@gnu.org>
parents:
15015
diff
changeset
|
907 |
e8613675066c
(save_excursion_restore): Add gcpros.
Richard M. Stallman <rms@gnu.org>
parents:
15015
diff
changeset
|
908 omark = nmark = Qnil; |
e8613675066c
(save_excursion_restore): Add gcpros.
Richard M. Stallman <rms@gnu.org>
parents:
15015
diff
changeset
|
909 GCPRO3 (info, omark, nmark); |
e8613675066c
(save_excursion_restore): Add gcpros.
Richard M. Stallman <rms@gnu.org>
parents:
15015
diff
changeset
|
910 |
305 | 911 Fset_buffer (tem); |
32420
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
912 |
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
913 /* Point marker. */ |
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
914 tem = XCAR (info); |
305 | 915 Fgoto_char (tem); |
51670
beceb827c1ce
(save_excursion_restore, transpose_markers): Update for new types.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
51042
diff
changeset
|
916 unchain_marker (XMARKER (tem)); |
32420
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
917 |
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
918 /* Mark marker. */ |
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
919 info = XCDR (info); |
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
920 tem = XCAR (info); |
7485
a1b7f72e0ea2
(save_excursion_restore): Don't run activate-mark-hook
Richard M. Stallman <rms@gnu.org>
parents:
7307
diff
changeset
|
921 omark = Fmarker_position (current_buffer->mark); |
305 | 922 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
|
923 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
|
924 unchain_marker (XMARKER (tem)); |
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 /* visible */ |
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
927 info = XCDR (info); |
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
928 visible_p = !NILP (XCAR (info)); |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49472
diff
changeset
|
929 |
4420
8113d9ba472e
(save_excursion_restore): Never make the buffer visible.
Richard M. Stallman <rms@gnu.org>
parents:
4358
diff
changeset
|
930 #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
|
931 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
|
932 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
|
933 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
|
934 tem1 = Fcar (tem); |
a358c97a23e4
(save_excursion_save): Save mark_active of buffer.
Richard M. Stallman <rms@gnu.org>
parents:
1916
diff
changeset
|
935 if (!NILP (tem1) |
1254
c7e7e3438711
* editfns.c (save_excursion_save, save_excursion_restore):
Jim Blandy <jimb@redhat.com>
parents:
1117
diff
changeset
|
936 && current_buffer != XBUFFER (XWINDOW (selected_window)->buffer)) |
305 | 937 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
|
938 #endif /* 0 */ |
2049
a358c97a23e4
(save_excursion_save): Save mark_active of buffer.
Richard M. Stallman <rms@gnu.org>
parents:
1916
diff
changeset
|
939 |
32420
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
940 /* Mark active */ |
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
941 info = XCDR (info); |
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
942 tem = XCAR (info); |
2049
a358c97a23e4
(save_excursion_save): Save mark_active of buffer.
Richard M. Stallman <rms@gnu.org>
parents:
1916
diff
changeset
|
943 tem1 = current_buffer->mark_active; |
32420
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
944 current_buffer->mark_active = tem; |
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
945 |
6206
67c608b0e2f7
(save_excursion_restore): Don't call Vrun_hooks if nil.
Richard M. Stallman <rms@gnu.org>
parents:
5915
diff
changeset
|
946 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
|
947 { |
7485
a1b7f72e0ea2
(save_excursion_restore): Don't run activate-mark-hook
Richard M. Stallman <rms@gnu.org>
parents:
7307
diff
changeset
|
948 /* 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
|
949 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
|
950 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
|
951 { |
a1b7f72e0ea2
(save_excursion_restore): Don't run activate-mark-hook
Richard M. Stallman <rms@gnu.org>
parents:
7307
diff
changeset
|
952 if (! EQ (omark, nmark)) |
a1b7f72e0ea2
(save_excursion_restore): Don't run activate-mark-hook
Richard M. Stallman <rms@gnu.org>
parents:
7307
diff
changeset
|
953 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
|
954 } |
a1b7f72e0ea2
(save_excursion_restore): Don't run activate-mark-hook
Richard M. Stallman <rms@gnu.org>
parents:
7307
diff
changeset
|
955 /* 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
|
956 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
|
957 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
|
958 } |
32420
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
959 |
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
960 /* 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
|
961 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
|
962 buffer, restore point in that window. */ |
32420
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
963 tem = XCDR (info); |
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
964 if (visible_p |
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
965 && !EQ (tem, selected_window) |
37492
b9cea35cf91f
(save_excursion_restore): Don't use XBUFFER on
Gerd Moellmann <gerd@gnu.org>
parents:
37217
diff
changeset
|
966 && (tem1 = XWINDOW (tem)->buffer, |
b9cea35cf91f
(save_excursion_restore): Don't use XBUFFER on
Gerd Moellmann <gerd@gnu.org>
parents:
37217
diff
changeset
|
967 (/* Window is live... */ |
b9cea35cf91f
(save_excursion_restore): Don't use XBUFFER on
Gerd Moellmann <gerd@gnu.org>
parents:
37217
diff
changeset
|
968 BUFFERP (tem1) |
b9cea35cf91f
(save_excursion_restore): Don't use XBUFFER on
Gerd Moellmann <gerd@gnu.org>
parents:
37217
diff
changeset
|
969 /* ...and it shows the current buffer. */ |
b9cea35cf91f
(save_excursion_restore): Don't use XBUFFER on
Gerd Moellmann <gerd@gnu.org>
parents:
37217
diff
changeset
|
970 && XBUFFER (tem1) == current_buffer))) |
32420
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
971 Fset_window_point (tem, make_number (PT)); |
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
972 |
15075
e8613675066c
(save_excursion_restore): Add gcpros.
Richard M. Stallman <rms@gnu.org>
parents:
15015
diff
changeset
|
973 UNGCPRO; |
305 | 974 return Qnil; |
975 } | |
976 | |
977 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
|
978 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
|
979 Executes BODY just like `progn'. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
980 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
|
981 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
|
982 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
|
983 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
984 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
|
985 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
|
986 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
|
987 `deactivate-mark' with `let'. |
9bf80d5fff41
(Fsave_excursion, Fsave_current_buffer)
Miles Bader <miles@gnu.org>
parents:
40131
diff
changeset
|
988 |
9bf80d5fff41
(Fsave_excursion, Fsave_current_buffer)
Miles Bader <miles@gnu.org>
parents:
40131
diff
changeset
|
989 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
|
990 (args) |
305 | 991 Lisp_Object args; |
992 { | |
993 register Lisp_Object val; | |
46293
1fb8f75062c6
Use macro SPECPDL_INDEX.
Juanma Barranquero <lekktu@gmail.com>
parents:
45398
diff
changeset
|
994 int count = SPECPDL_INDEX (); |
305 | 995 |
996 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
|
997 |
17304eb73f97
(Fsave_current_buffer): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16269
diff
changeset
|
998 val = Fprogn (args); |
17304eb73f97
(Fsave_current_buffer): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16269
diff
changeset
|
999 return unbind_to (count, val); |
17304eb73f97
(Fsave_current_buffer): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16269
diff
changeset
|
1000 } |
17304eb73f97
(Fsave_current_buffer): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16269
diff
changeset
|
1001 |
17304eb73f97
(Fsave_current_buffer): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16269
diff
changeset
|
1002 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
|
1003 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
|
1004 Executes BODY just like `progn'. |
9bf80d5fff41
(Fsave_excursion, Fsave_current_buffer)
Miles Bader <miles@gnu.org>
parents:
40131
diff
changeset
|
1005 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
|
1006 (args) |
16298
17304eb73f97
(Fsave_current_buffer): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16269
diff
changeset
|
1007 Lisp_Object args; |
17304eb73f97
(Fsave_current_buffer): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16269
diff
changeset
|
1008 { |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
1009 Lisp_Object val; |
46293
1fb8f75062c6
Use macro SPECPDL_INDEX.
Juanma Barranquero <lekktu@gmail.com>
parents:
45398
diff
changeset
|
1010 int count = SPECPDL_INDEX (); |
16298
17304eb73f97
(Fsave_current_buffer): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16269
diff
changeset
|
1011 |
20696
cdbe4824e7f1
(Fsave_current_buffer): Use set_buffer_if_live.
Richard M. Stallman <rms@gnu.org>
parents:
20688
diff
changeset
|
1012 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
|
1013 |
305 | 1014 val = Fprogn (args); |
1015 return unbind_to (count, val); | |
1016 } | |
1017 | |
25608
1cdab17df2b3
(Fbufsize): Accept an extra BUFFER parameter.
Richard M. Stallman <rms@gnu.org>
parents:
25507
diff
changeset
|
1018 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
|
1019 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
|
1020 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
|
1021 (buffer) |
25608
1cdab17df2b3
(Fbufsize): Accept an extra BUFFER parameter.
Richard M. Stallman <rms@gnu.org>
parents:
25507
diff
changeset
|
1022 Lisp_Object buffer; |
305 | 1023 { |
25608
1cdab17df2b3
(Fbufsize): Accept an extra BUFFER parameter.
Richard M. Stallman <rms@gnu.org>
parents:
25507
diff
changeset
|
1024 if (NILP (buffer)) |
1cdab17df2b3
(Fbufsize): Accept an extra BUFFER parameter.
Richard M. Stallman <rms@gnu.org>
parents:
25507
diff
changeset
|
1025 return make_number (Z - BEG); |
25609
157f0e91232e
Clear up previous change.
Richard M. Stallman <rms@gnu.org>
parents:
25608
diff
changeset
|
1026 else |
157f0e91232e
Clear up previous change.
Richard M. Stallman <rms@gnu.org>
parents:
25608
diff
changeset
|
1027 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
1028 CHECK_BUFFER (buffer); |
25609
157f0e91232e
Clear up previous change.
Richard M. Stallman <rms@gnu.org>
parents:
25608
diff
changeset
|
1029 return make_number (BUF_Z (XBUFFER (buffer)) |
157f0e91232e
Clear up previous change.
Richard M. Stallman <rms@gnu.org>
parents:
25608
diff
changeset
|
1030 - BUF_BEG (XBUFFER (buffer))); |
157f0e91232e
Clear up previous change.
Richard M. Stallman <rms@gnu.org>
parents:
25608
diff
changeset
|
1031 } |
305 | 1032 } |
1033 | |
1034 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
|
1035 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
|
1036 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
|
1037 () |
305 | 1038 { |
1039 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
|
1040 XSETFASTINT (temp, BEGV); |
305 | 1041 return temp; |
1042 } | |
1043 | |
1044 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
|
1045 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
|
1046 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
|
1047 () |
305 | 1048 { |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
1049 return buildmark (BEGV, BEGV_BYTE); |
305 | 1050 } |
1051 | |
1052 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
|
1053 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
|
1054 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
|
1055 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
|
1056 () |
305 | 1057 { |
1058 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
|
1059 XSETFASTINT (temp, ZV); |
305 | 1060 return temp; |
1061 } | |
1062 | |
1063 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
|
1064 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
|
1065 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
|
1066 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
|
1067 () |
305 | 1068 { |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
1069 return buildmark (ZV, ZV_BYTE); |
305 | 1070 } |
1071 | |
21821
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
1072 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
|
1073 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
|
1074 See also `gap-size'. */) |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1075 () |
21821
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
1076 { |
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
1077 Lisp_Object temp; |
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
1078 XSETFASTINT (temp, GPT); |
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
1079 return temp; |
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
1080 } |
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
1081 |
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
1082 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
|
1083 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
|
1084 See also `gap-position'. */) |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1085 () |
21821
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
1086 { |
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
1087 Lisp_Object temp; |
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
1088 XSETFASTINT (temp, GAP_SIZE); |
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
1089 return temp; |
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
1090 } |
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
1091 |
20861
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
1092 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
|
1093 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
|
1094 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
|
1095 (position) |
20879
64d2baa47498
(Fposition_bytes): Declare arg POSITION as Lips_Object.
Kenichi Handa <handa@m17n.org>
parents:
20878
diff
changeset
|
1096 Lisp_Object position; |
20861
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
1097 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
1098 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
|
1099 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
|
1100 return Qnil; |
20878
34e0c8eb49eb
(Fposition_bytes): Allow marker as arg POSITION. Use
Kenichi Handa <handa@m17n.org>
parents:
20861
diff
changeset
|
1101 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
|
1102 } |
22645
e5b201634497
(Fbyte_to_position): New function.
Richard M. Stallman <rms@gnu.org>
parents:
22199
diff
changeset
|
1103 |
e5b201634497
(Fbyte_to_position): New function.
Richard M. Stallman <rms@gnu.org>
parents:
22199
diff
changeset
|
1104 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
|
1105 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
|
1106 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
|
1107 (bytepos) |
22645
e5b201634497
(Fbyte_to_position): New function.
Richard M. Stallman <rms@gnu.org>
parents:
22199
diff
changeset
|
1108 Lisp_Object bytepos; |
e5b201634497
(Fbyte_to_position): New function.
Richard M. Stallman <rms@gnu.org>
parents:
22199
diff
changeset
|
1109 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
1110 CHECK_NUMBER (bytepos); |
23132
1c8e0e09aea1
(Fposition_bytes): If the arg POSITION is out of
Kenichi Handa <handa@m17n.org>
parents:
23063
diff
changeset
|
1111 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
|
1112 return Qnil; |
22645
e5b201634497
(Fbyte_to_position): New function.
Richard M. Stallman <rms@gnu.org>
parents:
22199
diff
changeset
|
1113 return make_number (BYTE_TO_CHAR (XINT (bytepos))); |
e5b201634497
(Fbyte_to_position): New function.
Richard M. Stallman <rms@gnu.org>
parents:
22199
diff
changeset
|
1114 } |
20861
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
1115 |
512 | 1116 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
|
1117 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
|
1118 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
|
1119 () |
305 | 1120 { |
1121 Lisp_Object temp; | |
16039
855c8d8ba0f0
Change all references from point to PT.
Karl Heuer <kwzh@gnu.org>
parents:
15910
diff
changeset
|
1122 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
|
1123 XSETFASTINT (temp, 0); |
512 | 1124 else |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
1125 XSETFASTINT (temp, FETCH_CHAR (PT_BYTE)); |
305 | 1126 return temp; |
1127 } | |
1128 | |
512 | 1129 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
|
1130 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
|
1131 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
|
1132 () |
305 | 1133 { |
1134 Lisp_Object temp; | |
16039
855c8d8ba0f0
Change all references from point to PT.
Karl Heuer <kwzh@gnu.org>
parents:
15910
diff
changeset
|
1135 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
|
1136 XSETFASTINT (temp, 0); |
17031 | 1137 else if (!NILP (current_buffer->enable_multibyte_characters)) |
1138 { | |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
1139 int pos = PT_BYTE; |
17031 | 1140 DEC_POS (pos); |
1141 XSETFASTINT (temp, FETCH_CHAR (pos)); | |
1142 } | |
305 | 1143 else |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
1144 XSETFASTINT (temp, FETCH_BYTE (PT_BYTE - 1)); |
305 | 1145 return temp; |
1146 } | |
1147 | |
1148 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
|
1149 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
|
1150 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
|
1151 () |
305 | 1152 { |
16039
855c8d8ba0f0
Change all references from point to PT.
Karl Heuer <kwzh@gnu.org>
parents:
15910
diff
changeset
|
1153 if (PT == BEGV) |
305 | 1154 return Qt; |
1155 return Qnil; | |
1156 } | |
1157 | |
1158 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
|
1159 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
|
1160 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
|
1161 () |
305 | 1162 { |
16039
855c8d8ba0f0
Change all references from point to PT.
Karl Heuer <kwzh@gnu.org>
parents:
15910
diff
changeset
|
1163 if (PT == ZV) |
305 | 1164 return Qt; |
1165 return Qnil; | |
1166 } | |
1167 | |
1168 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
|
1169 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
|
1170 () |
305 | 1171 { |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
1172 if (PT == BEGV || FETCH_BYTE (PT_BYTE - 1) == '\n') |
305 | 1173 return Qt; |
1174 return Qnil; | |
1175 } | |
1176 | |
1177 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
|
1178 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
|
1179 `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
|
1180 () |
305 | 1181 { |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
1182 if (PT == ZV || FETCH_BYTE (PT_BYTE) == '\n') |
305 | 1183 return Qt; |
1184 return Qnil; | |
1185 } | |
1186 | |
18252
9c4fb902b6eb
(Fchar_after, Fchar_before): Make arg optional.
Richard M. Stallman <rms@gnu.org>
parents:
18240
diff
changeset
|
1187 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
|
1188 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
|
1189 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
|
1190 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
|
1191 (pos) |
305 | 1192 Lisp_Object pos; |
1193 { | |
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; |
305 | 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 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
|
1206 return Qnil; |
ea520c42a342
(Fchar_after, Fchar_before): Properly check arg type
Richard M. Stallman <rms@gnu.org>
parents:
21064
diff
changeset
|
1207 } |
18252
9c4fb902b6eb
(Fchar_after, Fchar_before): Make arg optional.
Richard M. Stallman <rms@gnu.org>
parents:
18240
diff
changeset
|
1208 else |
9c4fb902b6eb
(Fchar_after, Fchar_before): Make arg optional.
Richard M. Stallman <rms@gnu.org>
parents:
18240
diff
changeset
|
1209 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
1210 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
|
1211 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
|
1212 return Qnil; |
30480 | 1213 |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
1214 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
|
1215 } |
305 | 1216 |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
1217 return make_number (FETCH_CHAR (pos_byte)); |
305 | 1218 } |
17031 | 1219 |
18252
9c4fb902b6eb
(Fchar_after, Fchar_before): Make arg optional.
Richard M. Stallman <rms@gnu.org>
parents:
18240
diff
changeset
|
1220 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
|
1221 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
|
1222 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
|
1223 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
|
1224 (pos) |
17031 | 1225 Lisp_Object pos; |
1226 { | |
1227 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
|
1228 register int pos_byte; |
17031 | 1229 |
18252
9c4fb902b6eb
(Fchar_after, Fchar_before): Make arg optional.
Richard M. Stallman <rms@gnu.org>
parents:
18240
diff
changeset
|
1230 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
|
1231 { |
edca9002c740
(Fchar_after): Make nil fully equivalent to (point) as arg.
Richard M. Stallman <rms@gnu.org>
parents:
21914
diff
changeset
|
1232 pos_byte = PT_BYTE; |
23577
36cccf1ba0a9
(Fchar_after): Fix type clashes.
Andreas Schwab <schwab@suse.de>
parents:
23565
diff
changeset
|
1233 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
|
1234 } |
edca9002c740
(Fchar_after): Make nil fully equivalent to (point) as arg.
Richard M. Stallman <rms@gnu.org>
parents:
21914
diff
changeset
|
1235 |
edca9002c740
(Fchar_after): Make nil fully equivalent to (point) as arg.
Richard M. Stallman <rms@gnu.org>
parents:
21914
diff
changeset
|
1236 if (MARKERP (pos)) |
21200
ea520c42a342
(Fchar_after, Fchar_before): Properly check arg type
Richard M. Stallman <rms@gnu.org>
parents:
21064
diff
changeset
|
1237 { |
ea520c42a342
(Fchar_after, Fchar_before): Properly check arg type
Richard M. Stallman <rms@gnu.org>
parents:
21064
diff
changeset
|
1238 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
|
1239 |
ea520c42a342
(Fchar_after, Fchar_before): Properly check arg type
Richard M. Stallman <rms@gnu.org>
parents:
21064
diff
changeset
|
1240 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
|
1241 return Qnil; |
ea520c42a342
(Fchar_after, Fchar_before): Properly check arg type
Richard M. Stallman <rms@gnu.org>
parents:
21064
diff
changeset
|
1242 } |
18252
9c4fb902b6eb
(Fchar_after, Fchar_before): Make arg optional.
Richard M. Stallman <rms@gnu.org>
parents:
18240
diff
changeset
|
1243 else |
9c4fb902b6eb
(Fchar_after, Fchar_before): Make arg optional.
Richard M. Stallman <rms@gnu.org>
parents:
18240
diff
changeset
|
1244 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
1245 CHECK_NUMBER_COERCE_MARKER (pos); |
17031 | 1246 |
21521
354a7085f1d7
(Fchar_after, Fchar_before): Fix mixing of Lisp_Object
Andreas Schwab <schwab@suse.de>
parents:
21514
diff
changeset
|
1247 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
|
1248 return Qnil; |
ea520c42a342
(Fchar_after, Fchar_before): Properly check arg type
Richard M. Stallman <rms@gnu.org>
parents:
21064
diff
changeset
|
1249 |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
1250 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
|
1251 } |
17031 | 1252 |
1253 if (!NILP (current_buffer->enable_multibyte_characters)) | |
1254 { | |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
1255 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
|
1256 XSETFASTINT (val, FETCH_CHAR (pos_byte)); |
17031 | 1257 } |
1258 else | |
1259 { | |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
1260 pos_byte--; |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
1261 XSETFASTINT (val, FETCH_BYTE (pos_byte)); |
17031 | 1262 } |
1263 return val; | |
1264 } | |
305 | 1265 |
9572 | 1266 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
|
1267 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
|
1268 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
|
1269 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
|
1270 that determines the value of this function. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1271 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1272 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
|
1273 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
|
1274 (uid) |
9572 | 1275 Lisp_Object uid; |
305 | 1276 { |
9572 | 1277 struct passwd *pw; |
1278 | |
9520
5187a4159d16
(Fuser_login_name, Fuser_real_login_name):
Richard M. Stallman <rms@gnu.org>
parents:
9305
diff
changeset
|
1279 /* 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
|
1280 (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
|
1281 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
|
1282 if (INTEGERP (Vuser_login_name)) |
9520
5187a4159d16
(Fuser_login_name, Fuser_real_login_name):
Richard M. Stallman <rms@gnu.org>
parents:
9305
diff
changeset
|
1283 init_editfns (); |
9572 | 1284 |
1285 if (NILP (uid)) | |
12026
505a894d943e
(syms_of_editfns): user-login-name renamed from user-name.
Karl Heuer <kwzh@gnu.org>
parents:
11912
diff
changeset
|
1286 return Vuser_login_name; |
9572 | 1287 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
1288 CHECK_NUMBER (uid); |
71817
fb57c1830788
Include blockinput.h.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents:
71498
diff
changeset
|
1289 BLOCK_INPUT; |
9572 | 1290 pw = (struct passwd *) getpwuid (XINT (uid)); |
71817
fb57c1830788
Include blockinput.h.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents:
71498
diff
changeset
|
1291 UNBLOCK_INPUT; |
9572 | 1292 return (pw ? build_string (pw->pw_name) : Qnil); |
305 | 1293 } |
1294 | |
1295 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
|
1296 0, 0, 0, |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1297 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
|
1298 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
|
1299 `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
|
1300 () |
305 | 1301 { |
9520
5187a4159d16
(Fuser_login_name, Fuser_real_login_name):
Richard M. Stallman <rms@gnu.org>
parents:
9305
diff
changeset
|
1302 /* 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
|
1303 (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
|
1304 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
|
1305 if (INTEGERP (Vuser_login_name)) |
9520
5187a4159d16
(Fuser_login_name, Fuser_real_login_name):
Richard M. Stallman <rms@gnu.org>
parents:
9305
diff
changeset
|
1306 init_editfns (); |
12026
505a894d943e
(syms_of_editfns): user-login-name renamed from user-name.
Karl Heuer <kwzh@gnu.org>
parents:
11912
diff
changeset
|
1307 return Vuser_real_login_name; |
305 | 1308 } |
1309 | |
1310 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
|
1311 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
|
1312 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
|
1313 () |
305 | 1314 { |
39774
b34a792f4234
(Fuser_uid, Fuser_real_uid): Use make_fixnum_or_float.
Gerd Moellmann <gerd@gnu.org>
parents:
39720
diff
changeset
|
1315 return make_fixnum_or_float (geteuid ()); |
305 | 1316 } |
1317 | |
1318 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
|
1319 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
|
1320 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
|
1321 () |
305 | 1322 { |
39774
b34a792f4234
(Fuser_uid, Fuser_real_uid): Use make_fixnum_or_float.
Gerd Moellmann <gerd@gnu.org>
parents:
39720
diff
changeset
|
1323 return make_fixnum_or_float (getuid ()); |
305 | 1324 } |
1325 | |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
1326 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
|
1327 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
|
1328 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
|
1329 return "unknown". |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1330 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1331 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
|
1332 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
|
1333 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
|
1334 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
|
1335 (uid) |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
1336 Lisp_Object uid; |
305 | 1337 { |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
1338 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
|
1339 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
|
1340 Lisp_Object full; |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
1341 |
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
1342 if (NILP (uid)) |
30480 | 1343 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
|
1344 else if (NUMBERP (uid)) |
71817
fb57c1830788
Include blockinput.h.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents:
71498
diff
changeset
|
1345 { |
fb57c1830788
Include blockinput.h.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents:
71498
diff
changeset
|
1346 BLOCK_INPUT; |
fb57c1830788
Include blockinput.h.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents:
71498
diff
changeset
|
1347 pw = (struct passwd *) getpwuid ((uid_t) XFLOATINT (uid)); |
fb57c1830788
Include blockinput.h.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents:
71498
diff
changeset
|
1348 UNBLOCK_INPUT; |
fb57c1830788
Include blockinput.h.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents:
71498
diff
changeset
|
1349 } |
30480 | 1350 else if (STRINGP (uid)) |
71817
fb57c1830788
Include blockinput.h.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents:
71498
diff
changeset
|
1351 { |
fb57c1830788
Include blockinput.h.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents:
71498
diff
changeset
|
1352 BLOCK_INPUT; |
fb57c1830788
Include blockinput.h.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents:
71498
diff
changeset
|
1353 pw = (struct passwd *) getpwnam (SDATA (uid)); |
fb57c1830788
Include blockinput.h.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents:
71498
diff
changeset
|
1354 UNBLOCK_INPUT; |
fb57c1830788
Include blockinput.h.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents:
71498
diff
changeset
|
1355 } |
16641
2103a88cc61f
(Fuser_full_name): Accept a string (the login name) as
Richard M. Stallman <rms@gnu.org>
parents:
16639
diff
changeset
|
1356 else |
2103a88cc61f
(Fuser_full_name): Accept a string (the login name) as
Richard M. Stallman <rms@gnu.org>
parents:
16639
diff
changeset
|
1357 error ("Invalid UID specification"); |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
1358 |
16641
2103a88cc61f
(Fuser_full_name): Accept a string (the login name) as
Richard M. Stallman <rms@gnu.org>
parents:
16639
diff
changeset
|
1359 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
|
1360 return Qnil; |
30480 | 1361 |
16641
2103a88cc61f
(Fuser_full_name): Accept a string (the login name) as
Richard M. Stallman <rms@gnu.org>
parents:
16639
diff
changeset
|
1362 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
|
1363 /* 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
|
1364 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
|
1365 full = make_string (p, q ? q - p : strlen (p)); |
30480 | 1366 |
16641
2103a88cc61f
(Fuser_full_name): Accept a string (the login name) as
Richard M. Stallman <rms@gnu.org>
parents:
16639
diff
changeset
|
1367 #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
|
1368 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
|
1369 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
|
1370 /* 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
|
1371 if (q) |
2103a88cc61f
(Fuser_full_name): Accept a string (the login name) as
Richard M. Stallman <rms@gnu.org>
parents:
16639
diff
changeset
|
1372 { |
18661
537522d5e6d8
(Fuser_full_name): Declare p, q and r as unsigned char *.
Richard M. Stallman <rms@gnu.org>
parents:
18613
diff
changeset
|
1373 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
|
1374 Lisp_Object login; |
2103a88cc61f
(Fuser_full_name): Accept a string (the login name) as
Richard M. Stallman <rms@gnu.org>
parents:
16639
diff
changeset
|
1375 |
2103a88cc61f
(Fuser_full_name): Accept a string (the login name) as
Richard M. Stallman <rms@gnu.org>
parents:
16639
diff
changeset
|
1376 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
|
1377 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
|
1378 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
|
1379 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
|
1380 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
|
1381 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
|
1382 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
|
1383 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
|
1384 } |
2103a88cc61f
(Fuser_full_name): Accept a string (the login name) as
Richard M. Stallman <rms@gnu.org>
parents:
16639
diff
changeset
|
1385 #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
|
1386 |
2103a88cc61f
(Fuser_full_name): Accept a string (the login name) as
Richard M. Stallman <rms@gnu.org>
parents:
16639
diff
changeset
|
1387 return full; |
305 | 1388 } |
1389 | |
1390 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
|
1391 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
|
1392 () |
305 | 1393 { |
1394 return Vsystem_name; | |
1395 } | |
1396 | |
7907
148ad20d6774
(init_editfns): Call init_system_name instead of get_system_name.
Karl Heuer <kwzh@gnu.org>
parents:
7862
diff
changeset
|
1397 /* 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
|
1398 |
7907
148ad20d6774
(init_editfns): Call init_system_name instead of get_system_name.
Karl Heuer <kwzh@gnu.org>
parents:
7862
diff
changeset
|
1399 char * |
148ad20d6774
(init_editfns): Call init_system_name instead of get_system_name.
Karl Heuer <kwzh@gnu.org>
parents:
7862
diff
changeset
|
1400 get_system_name () |
148ad20d6774
(init_editfns): Call init_system_name instead of get_system_name.
Karl Heuer <kwzh@gnu.org>
parents:
7862
diff
changeset
|
1401 { |
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
|
1402 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
|
1403 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
|
1404 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
|
1405 return ""; |
7907
148ad20d6774
(init_editfns): Call init_system_name instead of get_system_name.
Karl Heuer <kwzh@gnu.org>
parents:
7862
diff
changeset
|
1406 } |
148ad20d6774
(init_editfns): Call init_system_name instead of get_system_name.
Karl Heuer <kwzh@gnu.org>
parents:
7862
diff
changeset
|
1407 |
59658
45074d913d23
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
59644
diff
changeset
|
1408 char * |
45074d913d23
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
59644
diff
changeset
|
1409 get_operating_system_release() |
45074d913d23
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
59644
diff
changeset
|
1410 { |
45074d913d23
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
59644
diff
changeset
|
1411 if (STRINGP (Voperating_system_release)) |
45074d913d23
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
59644
diff
changeset
|
1412 return (char *) SDATA (Voperating_system_release); |
45074d913d23
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
59644
diff
changeset
|
1413 else |
45074d913d23
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
59644
diff
changeset
|
1414 return ""; |
45074d913d23
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
59644
diff
changeset
|
1415 } |
45074d913d23
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
59644
diff
changeset
|
1416 |
5373
a70b89d2d6bb
(Femacs_pid): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5242
diff
changeset
|
1417 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
|
1418 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
|
1419 () |
5373
a70b89d2d6bb
(Femacs_pid): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5242
diff
changeset
|
1420 { |
a70b89d2d6bb
(Femacs_pid): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5242
diff
changeset
|
1421 return make_number (getpid ()); |
a70b89d2d6bb
(Femacs_pid): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5242
diff
changeset
|
1422 } |
a70b89d2d6bb
(Femacs_pid): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5242
diff
changeset
|
1423 |
448 | 1424 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
|
1425 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
|
1426 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
|
1427 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
|
1428 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
|
1429 count. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1430 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1431 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
|
1432 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
|
1433 () |
448 | 1434 { |
577 | 1435 EMACS_TIME t; |
1436 | |
1437 EMACS_GET_TIME (t); | |
72531
90bdf0a2ff4c
(Fcurrent_time, Fget_internal_run_time): Simplify; use list3.
Kim F. Storm <storm@cua.dk>
parents:
72272
diff
changeset
|
1438 return list3 (make_number ((EMACS_SECS (t) >> 16) & 0xffff), |
90bdf0a2ff4c
(Fcurrent_time, Fget_internal_run_time): Simplify; use list3.
Kim F. Storm <storm@cua.dk>
parents:
72272
diff
changeset
|
1439 make_number ((EMACS_SECS (t) >> 0) & 0xffff), |
90bdf0a2ff4c
(Fcurrent_time, Fget_internal_run_time): Simplify; use list3.
Kim F. Storm <storm@cua.dk>
parents:
72272
diff
changeset
|
1440 make_number (EMACS_USECS (t))); |
448 | 1441 } |
57987
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1442 |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1443 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
|
1444 0, 0, 0, |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1445 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
|
1446 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
|
1447 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
|
1448 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
|
1449 count. |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1450 |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1451 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
|
1452 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
|
1453 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
|
1454 () |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1455 { |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1456 #ifdef HAVE_GETRUSAGE |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1457 struct rusage usage; |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1458 int secs, usecs; |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1459 |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1460 if (getrusage (RUSAGE_SELF, &usage) < 0) |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1461 /* This shouldn't happen. What action is appropriate? */ |
71975
6d29dff081c5
(region_limit, Fget_internal_run_time): Use xsignal0.
Kim F. Storm <storm@cua.dk>
parents:
71865
diff
changeset
|
1462 xsignal0 (Qerror); |
57987
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1463 |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1464 /* Sum up user time and system time. */ |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1465 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
|
1466 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
|
1467 if (usecs >= 1000000) |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1468 { |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1469 usecs -= 1000000; |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1470 secs++; |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1471 } |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1472 |
72531
90bdf0a2ff4c
(Fcurrent_time, Fget_internal_run_time): Simplify; use list3.
Kim F. Storm <storm@cua.dk>
parents:
72272
diff
changeset
|
1473 return list3 (make_number ((secs >> 16) & 0xffff), |
90bdf0a2ff4c
(Fcurrent_time, Fget_internal_run_time): Simplify; use list3.
Kim F. Storm <storm@cua.dk>
parents:
72272
diff
changeset
|
1474 make_number ((secs >> 0) & 0xffff), |
90bdf0a2ff4c
(Fcurrent_time, Fget_internal_run_time): Simplify; use list3.
Kim F. Storm <storm@cua.dk>
parents:
72272
diff
changeset
|
1475 make_number (usecs)); |
57987
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1476 #else |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1477 return Fcurrent_time (); |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1478 #endif |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1479 } |
448 | 1480 |
1481 | |
55193
1b09eb24ab02
(lisp_time_argument): Provide externally.
Eli Zaretskii <eliz@gnu.org>
parents:
54846
diff
changeset
|
1482 int |
30480 | 1483 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
|
1484 Lisp_Object specified_time; |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1485 time_t *result; |
30480 | 1486 int *usec; |
2921
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1487 { |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1488 if (NILP (specified_time)) |
30480 | 1489 { |
1490 if (usec) | |
1491 { | |
1492 EMACS_TIME t; | |
1493 | |
30503
fef49230e1aa
(lisp_time_argument): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents:
30480
diff
changeset
|
1494 EMACS_GET_TIME (t); |
30480 | 1495 *usec = EMACS_USECS (t); |
1496 *result = EMACS_SECS (t); | |
1497 return 1; | |
1498 } | |
1499 else | |
1500 return time (result) != -1; | |
1501 } | |
2921
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1502 else |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1503 { |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1504 Lisp_Object high, low; |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1505 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
|
1506 CHECK_NUMBER (high); |
2921
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1507 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
|
1508 if (CONSP (low)) |
30480 | 1509 { |
1510 if (usec) | |
1511 { | |
1512 Lisp_Object usec_l = Fcdr (low); | |
1513 if (CONSP (usec_l)) | |
1514 usec_l = Fcar (usec_l); | |
1515 if (NILP (usec_l)) | |
1516 *usec = 0; | |
1517 else | |
1518 { | |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
1519 CHECK_NUMBER (usec_l); |
30480 | 1520 *usec = XINT (usec_l); |
1521 } | |
1522 } | |
1523 low = Fcar (low); | |
1524 } | |
1525 else if (usec) | |
1526 *usec = 0; | |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
1527 CHECK_NUMBER (low); |
2921
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1528 *result = (XINT (high) << 16) + (XINT (low) & 0xffff); |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1529 return *result >> 16 == XINT (high); |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1530 } |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1531 } |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1532 |
30480 | 1533 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
|
1534 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
|
1535 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
|
1536 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
|
1537 (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
|
1538 `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
|
1539 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
|
1540 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1541 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
|
1542 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
|
1543 (specified_time) |
30480 | 1544 Lisp_Object specified_time; |
1545 { | |
1546 time_t sec; | |
1547 int usec; | |
1548 | |
1549 if (! lisp_time_argument (specified_time, &sec, &usec)) | |
1550 error ("Invalid time specification"); | |
1551 | |
37046
a9b2639dd045
(Ffloat_time): Fix off-by-factor-of-10 bug in the
Gerd Moellmann <gerd@gnu.org>
parents:
36479
diff
changeset
|
1552 return make_float ((sec * 1e6 + usec) / 1e6); |
30480 | 1553 } |
1554 | |
23213
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1555 /* 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
|
1556 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
|
1557 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
|
1558 Return the number of bytes written, not including the terminating |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1559 '\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
|
1560 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
|
1561 ((size_t) -1) for MAXSIZE. |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1562 |
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
parents:
26058
diff
changeset
|
1563 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
|
1564 bytes in FORMAT. */ |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1565 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
|
1566 emacs_memftimeu (s, maxsize, format, format_len, tp, ut) |
23213
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1567 char *s; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1568 size_t maxsize; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1569 const char *format; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1570 size_t format_len; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1571 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
|
1572 int ut; |
23213
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1573 { |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1574 size_t total = 0; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1575 |
23218
90e5d916ebd9
Add a comment to emacs_memftime, explaining why it needs to loop.
Paul Eggert <eggert@twinsun.com>
parents:
23213
diff
changeset
|
1576 /* 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
|
1577 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
|
1578 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
|
1579 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
|
1580 '\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
|
1581 for (;;) |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1582 { |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1583 size_t len; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1584 size_t result; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1585 |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1586 if (s) |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1587 s[0] = '\1'; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1588 |
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
parents:
26058
diff
changeset
|
1589 result = emacs_strftimeu (s, maxsize, format, tp, ut); |
23213
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1590 |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1591 if (s) |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1592 { |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1593 if (result == 0 && s[0] != '\0') |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1594 return 0; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1595 s += result + 1; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1596 } |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1597 |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1598 maxsize -= result + 1; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1599 total += result; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1600 len = strlen (format); |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1601 if (len == format_len) |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1602 return total; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1603 total++; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1604 format += len + 1; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1605 format_len -= len + 1; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1606 } |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1607 } |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1608 |
17907
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1609 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
|
1610 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
|
1611 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
|
1612 `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
|
1613 is also still accepted. |
39966
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1614 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
|
1615 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
|
1616 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
|
1617 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
|
1618 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1619 %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
|
1620 %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
|
1621 %m is the numeric month. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1622 %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
|
1623 %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
|
1624 %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
|
1625 %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
|
1626 %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
|
1627 %V according to ISO 8601. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1628 %j is the day of the year. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1629 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1630 %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
|
1631 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
|
1632 %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
|
1633 %M is the minute. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1634 %S is the second. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1635 %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
|
1636 %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
|
1637 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1638 %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
|
1639 %x is the locale's "preferred" date format. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1640 %D is like "%m/%d/%y". |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1641 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1642 %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
|
1643 %X is the locale's "preferred" time format. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1644 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1645 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
|
1646 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1647 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
|
1648 The flags are `_', `-', `^' and `#'. For certain characters X, |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1649 %_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
|
1650 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
|
1651 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
|
1652 all textual characters reversed. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1653 %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
|
1654 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
|
1655 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
|
1656 %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
|
1657 %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
|
1658 |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1659 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
|
1660 (format_string, time, universal) |
17907
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1661 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
|
1662 { |
b4739bcefc44
(Fformat_time_string): Mostly rewritten, to handle
Richard M. Stallman <rms@gnu.org>
parents:
8981
diff
changeset
|
1663 time_t value; |
b4739bcefc44
(Fformat_time_string): Mostly rewritten, to handle
Richard M. Stallman <rms@gnu.org>
parents:
8981
diff
changeset
|
1664 int size; |
23198
dddce768cf7a
(Fformat_time_string, Fdecode_time, Fcurrent_time_zone):
Paul Eggert <eggert@twinsun.com>
parents:
23197
diff
changeset
|
1665 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
|
1666 int ut = ! NILP (universal); |
9154
b4739bcefc44
(Fformat_time_string): Mostly rewritten, to handle
Richard M. Stallman <rms@gnu.org>
parents:
8981
diff
changeset
|
1667 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
1668 CHECK_STRING (format_string); |
9154
b4739bcefc44
(Fformat_time_string): Mostly rewritten, to handle
Richard M. Stallman <rms@gnu.org>
parents:
8981
diff
changeset
|
1669 |
30480 | 1670 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
|
1671 error ("Invalid time specification"); |
b4739bcefc44
(Fformat_time_string): Mostly rewritten, to handle
Richard M. Stallman <rms@gnu.org>
parents:
8981
diff
changeset
|
1672 |
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
parents:
26058
diff
changeset
|
1673 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
|
1674 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
|
1675 |
9154
b4739bcefc44
(Fformat_time_string): Mostly rewritten, to handle
Richard M. Stallman <rms@gnu.org>
parents:
8981
diff
changeset
|
1676 /* 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
|
1677 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
|
1678 |
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
parents:
26058
diff
changeset
|
1679 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
|
1680 if (! tm) |
dddce768cf7a
(Fformat_time_string, Fdecode_time, Fcurrent_time_zone):
Paul Eggert <eggert@twinsun.com>
parents:
23197
diff
changeset
|
1681 error ("Specified time is not representable"); |
dddce768cf7a
(Fformat_time_string, Fdecode_time, Fcurrent_time_zone):
Paul Eggert <eggert@twinsun.com>
parents:
23197
diff
changeset
|
1682 |
26526
b7438760079b
* callproc.c (strerror): Remove decl.
Paul Eggert <eggert@twinsun.com>
parents:
26415
diff
changeset
|
1683 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
|
1684 |
9154
b4739bcefc44
(Fformat_time_string): Mostly rewritten, to handle
Richard M. Stallman <rms@gnu.org>
parents:
8981
diff
changeset
|
1685 while (1) |
b4739bcefc44
(Fformat_time_string): Mostly rewritten, to handle
Richard M. Stallman <rms@gnu.org>
parents:
8981
diff
changeset
|
1686 { |
17907
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1687 char *buf = (char *) alloca (size + 1); |
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1688 int result; |
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1689 |
19032
84ae0a03a643
(Fformat_time_string): Don't hang if strftime produces
Richard M. Stallman <rms@gnu.org>
parents:
18937
diff
changeset
|
1690 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
|
1691 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
|
1692 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
|
1693 tm, ut); |
19032
84ae0a03a643
(Fformat_time_string): Don't hang if strftime produces
Richard M. Stallman <rms@gnu.org>
parents:
18937
diff
changeset
|
1694 if ((result > 0 && result < size) || (result == 0 && buf[0] == '\0')) |
72669
d8f99fba05ca
(Fformat_time_string): Use make_unibyte_string to make
Kenichi Handa <handa@m17n.org>
parents:
72592
diff
changeset
|
1695 return code_convert_string_norecord (make_unibyte_string (buf, result), |
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
parents:
26058
diff
changeset
|
1696 Vlocale_coding_system, 0); |
17907
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1697 |
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1698 /* 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
|
1699 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
|
1700 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
|
1701 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
|
1702 tm, ut); |
17907
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1703 size = result + 1; |
9154
b4739bcefc44
(Fformat_time_string): Mostly rewritten, to handle
Richard M. Stallman <rms@gnu.org>
parents:
8981
diff
changeset
|
1704 } |
b4739bcefc44
(Fformat_time_string): Mostly rewritten, to handle
Richard M. Stallman <rms@gnu.org>
parents:
8981
diff
changeset
|
1705 } |
b4739bcefc44
(Fformat_time_string): Mostly rewritten, to handle
Richard M. Stallman <rms@gnu.org>
parents:
8981
diff
changeset
|
1706 |
9801
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
1707 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
|
1708 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
|
1709 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
|
1710 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
|
1711 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
|
1712 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
|
1713 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
|
1714 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
|
1715 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
|
1716 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
|
1717 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
|
1718 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
|
1719 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
|
1720 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
|
1721 DOW and ZONE.) */) |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1722 (specified_time) |
9801
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
1723 Lisp_Object specified_time; |
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
1724 { |
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
1725 time_t time_spec; |
9812
bc352c8f079c
(Fdecode_time): Fix Lisp_Object vs. integer problems.
Karl Heuer <kwzh@gnu.org>
parents:
9809
diff
changeset
|
1726 struct tm save_tm; |
9801
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
1727 struct tm *decoded_time; |
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
1728 Lisp_Object list_args[9]; |
30480 | 1729 |
1730 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
|
1731 error ("Invalid time specification"); |
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
1732 |
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
1733 decoded_time = localtime (&time_spec); |
23198
dddce768cf7a
(Fformat_time_string, Fdecode_time, Fcurrent_time_zone):
Paul Eggert <eggert@twinsun.com>
parents:
23197
diff
changeset
|
1734 if (! decoded_time) |
dddce768cf7a
(Fformat_time_string, Fdecode_time, Fcurrent_time_zone):
Paul Eggert <eggert@twinsun.com>
parents:
23197
diff
changeset
|
1735 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
|
1736 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
|
1737 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
|
1738 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
|
1739 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
|
1740 XSETFASTINT (list_args[4], decoded_time->tm_mon + 1); |
69673
23a81b585dd1
Move explanations from ChangeLog to the source.
Eli Zaretskii <eliz@gnu.org>
parents:
69664
diff
changeset
|
1741 /* On 64-bit machines an int is narrower than EMACS_INT, thus the |
23a81b585dd1
Move explanations from ChangeLog to the source.
Eli Zaretskii <eliz@gnu.org>
parents:
69664
diff
changeset
|
1742 cast below avoids overflow in int arithmetics. */ |
69664
55e66496ae1a
* editfns.c: (TM_YEAR_BASE): Move up.
Paul Eggert <eggert@twinsun.com>
parents:
68669
diff
changeset
|
1743 XSETINT (list_args[5], TM_YEAR_BASE + (EMACS_INT) decoded_time->tm_year); |
9812
bc352c8f079c
(Fdecode_time): Fix Lisp_Object vs. integer problems.
Karl Heuer <kwzh@gnu.org>
parents:
9809
diff
changeset
|
1744 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
|
1745 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
|
1746 |
bc352c8f079c
(Fdecode_time): Fix Lisp_Object vs. integer problems.
Karl Heuer <kwzh@gnu.org>
parents:
9809
diff
changeset
|
1747 /* 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
|
1748 save_tm = *decoded_time; |
bc352c8f079c
(Fdecode_time): Fix Lisp_Object vs. integer problems.
Karl Heuer <kwzh@gnu.org>
parents:
9809
diff
changeset
|
1749 decoded_time = gmtime (&time_spec); |
bc352c8f079c
(Fdecode_time): Fix Lisp_Object vs. integer problems.
Karl Heuer <kwzh@gnu.org>
parents:
9809
diff
changeset
|
1750 if (decoded_time == 0) |
bc352c8f079c
(Fdecode_time): Fix Lisp_Object vs. integer problems.
Karl Heuer <kwzh@gnu.org>
parents:
9809
diff
changeset
|
1751 list_args[8] = Qnil; |
bc352c8f079c
(Fdecode_time): Fix Lisp_Object vs. integer problems.
Karl Heuer <kwzh@gnu.org>
parents:
9809
diff
changeset
|
1752 else |
16269
79e6c47054c5
(tm_diff): Renamed from difftm. Yield int, not long.
Paul Eggert <eggert@twinsun.com>
parents:
16134
diff
changeset
|
1753 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
|
1754 return Flist (9, list_args); |
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
1755 } |
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
1756 |
15180
9a22c72359c1
(Fencode_time): Accept MANY args, so as to cope
Richard M. Stallman <rms@gnu.org>
parents:
15075
diff
changeset
|
1757 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
|
1758 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
|
1759 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
|
1760 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
|
1761 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
|
1762 \(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
|
1763 applied without consideration for daylight savings time. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1764 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1765 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
|
1766 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
|
1767 The intervening arguments are ignored. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1768 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
|
1769 |
55972
db2480202623
(Fuser_login_name, Ffloat_time, Fencode_time, Fcurrent_time_string)
Juanma Barranquero <lekktu@gmail.com>
parents:
55424
diff
changeset
|
1770 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
|
1771 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
|
1772 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
|
1773 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
|
1774 |
52211
a057bd074729
(Fencode_time): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
51841
diff
changeset
|
1775 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
|
1776 year values as low as 1901 do work. |
a057bd074729
(Fencode_time): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
51841
diff
changeset
|
1777 |
40131
de086e415fa2
(Finsert, Finsert_and_inherit, Finsert_before_markers, Fmessage)
Miles Bader <miles@gnu.org>
parents:
40046
diff
changeset
|
1778 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
|
1779 (nargs, args) |
15180
9a22c72359c1
(Fencode_time): Accept MANY args, so as to cope
Richard M. Stallman <rms@gnu.org>
parents:
15075
diff
changeset
|
1780 int nargs; |
9a22c72359c1
(Fencode_time): Accept MANY args, so as to cope
Richard M. Stallman <rms@gnu.org>
parents:
15075
diff
changeset
|
1781 register Lisp_Object *args; |
11402
66d935214d8e
(Fencode_time): Use XINT to examine `zone'.
Richard M. Stallman <rms@gnu.org>
parents:
11263
diff
changeset
|
1782 { |
11468
772f49d1969d
(Fencode_time): Rewrite by Naggum.
Richard M. Stallman <rms@gnu.org>
parents:
11451
diff
changeset
|
1783 time_t time; |
13025
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1784 struct tm tm; |
16874 | 1785 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
|
1786 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
1787 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
|
1788 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
|
1789 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
|
1790 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
|
1791 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
|
1792 CHECK_NUMBER (args[5]); /* year */ |
11468
772f49d1969d
(Fencode_time): Rewrite by Naggum.
Richard M. Stallman <rms@gnu.org>
parents:
11451
diff
changeset
|
1793 |
15180
9a22c72359c1
(Fencode_time): Accept MANY args, so as to cope
Richard M. Stallman <rms@gnu.org>
parents:
15075
diff
changeset
|
1794 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
|
1795 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
|
1796 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
|
1797 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
|
1798 tm.tm_mon = XINT (args[4]) - 1; |
69664
55e66496ae1a
* editfns.c: (TM_YEAR_BASE): Move up.
Paul Eggert <eggert@twinsun.com>
parents:
68669
diff
changeset
|
1799 tm.tm_year = XINT (args[5]) - TM_YEAR_BASE; |
13025
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1800 tm.tm_isdst = -1; |
11468
772f49d1969d
(Fencode_time): Rewrite by Naggum.
Richard M. Stallman <rms@gnu.org>
parents:
11451
diff
changeset
|
1801 |
13025
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1802 if (CONSP (zone)) |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1803 zone = Fcar (zone); |
11468
772f49d1969d
(Fencode_time): Rewrite by Naggum.
Richard M. Stallman <rms@gnu.org>
parents:
11451
diff
changeset
|
1804 if (NILP (zone)) |
13025
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1805 time = mktime (&tm); |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1806 else |
11468
772f49d1969d
(Fencode_time): Rewrite by Naggum.
Richard M. Stallman <rms@gnu.org>
parents:
11451
diff
changeset
|
1807 { |
13025
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1808 char tzbuf[100]; |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1809 char *tzstring; |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1810 char **oldenv = environ, **newenv; |
30480 | 1811 |
18613
614b916ff5bf
Fix bugs with inappropriate mixing of Lisp_Object with int.
Richard M. Stallman <rms@gnu.org>
parents:
18605
diff
changeset
|
1812 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
|
1813 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
|
1814 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
|
1815 tzstring = (char *) SDATA (zone); |
13025
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1816 else if (INTEGERP (zone)) |
11468
772f49d1969d
(Fencode_time): Rewrite by Naggum.
Richard M. Stallman <rms@gnu.org>
parents:
11451
diff
changeset
|
1817 { |
13025
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1818 int abszone = abs (XINT (zone)); |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1819 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
|
1820 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
|
1821 tzstring = tzbuf; |
11468
772f49d1969d
(Fencode_time): Rewrite by Naggum.
Richard M. Stallman <rms@gnu.org>
parents:
11451
diff
changeset
|
1822 } |
13025
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1823 else |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1824 error ("Invalid time zone specification"); |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1825 |
30480 | 1826 /* 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
|
1827 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
|
1828 set_time_zone_rule (tzstring); |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1829 |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1830 time = mktime (&tm); |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1831 |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1832 /* Restore TZ to previous value. */ |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1833 newenv = environ; |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1834 environ = oldenv; |
16521
fe9cc0d392dd
(Fencode_time): Use xfree, not free.
Richard M. Stallman <rms@gnu.org>
parents:
16485
diff
changeset
|
1835 xfree (newenv); |
13025
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1836 #ifdef LOCALTIME_CACHE |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1837 tzset (); |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1838 #endif |
11468
772f49d1969d
(Fencode_time): Rewrite by Naggum.
Richard M. Stallman <rms@gnu.org>
parents:
11451
diff
changeset
|
1839 } |
11402
66d935214d8e
(Fencode_time): Use XINT to examine `zone'.
Richard M. Stallman <rms@gnu.org>
parents:
11263
diff
changeset
|
1840 |
13025
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1841 if (time == (time_t) -1) |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1842 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
|
1843 |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1844 return make_time (time); |
11402
66d935214d8e
(Fencode_time): Use XINT to examine `zone'.
Richard M. Stallman <rms@gnu.org>
parents:
11263
diff
changeset
|
1845 } |
66d935214d8e
(Fencode_time): Use XINT to examine `zone'.
Richard M. Stallman <rms@gnu.org>
parents:
11263
diff
changeset
|
1846 |
2154
69c58e548ca5
(Fcurrent_time_string): Optional arg specifies time.
Richard M. Stallman <rms@gnu.org>
parents:
2049
diff
changeset
|
1847 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
|
1848 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
|
1849 Programs can use this function to decode a time, |
69790
1e68e7f3b824
* lib-src/b2m.c (main): Don't include <limits.h>.
Paul Eggert <eggert@twinsun.com>
parents:
69673
diff
changeset
|
1850 since the number of columns in each field is fixed |
1e68e7f3b824
* lib-src/b2m.c (main): Don't include <limits.h>.
Paul Eggert <eggert@twinsun.com>
parents:
69673
diff
changeset
|
1851 if the year is in the range 1000-9999. |
39966
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1852 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
|
1853 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
|
1854 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
|
1855 |
56386
4f00fbfe3c1e
(Ffloat_time, Fformat_time_string, Fdecode_time)
Luc Teirlinck <teirllm@auburn.edu>
parents:
56194
diff
changeset
|
1856 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
|
1857 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
|
1858 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
|
1859 `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
|
1860 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
|
1861 (specified_time) |
2154
69c58e548ca5
(Fcurrent_time_string): Optional arg specifies time.
Richard M. Stallman <rms@gnu.org>
parents:
2049
diff
changeset
|
1862 Lisp_Object specified_time; |
305 | 1863 { |
2921
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1864 time_t value; |
69664
55e66496ae1a
* editfns.c: (TM_YEAR_BASE): Move up.
Paul Eggert <eggert@twinsun.com>
parents:
68669
diff
changeset
|
1865 struct tm *tm; |
2154
69c58e548ca5
(Fcurrent_time_string): Optional arg specifies time.
Richard M. Stallman <rms@gnu.org>
parents:
2049
diff
changeset
|
1866 register char *tem; |
69c58e548ca5
(Fcurrent_time_string): Optional arg specifies time.
Richard M. Stallman <rms@gnu.org>
parents:
2049
diff
changeset
|
1867 |
30480 | 1868 if (! lisp_time_argument (specified_time, &value, NULL)) |
69664
55e66496ae1a
* editfns.c: (TM_YEAR_BASE): Move up.
Paul Eggert <eggert@twinsun.com>
parents:
68669
diff
changeset
|
1869 error ("Invalid time specification"); |
69790
1e68e7f3b824
* lib-src/b2m.c (main): Don't include <limits.h>.
Paul Eggert <eggert@twinsun.com>
parents:
69673
diff
changeset
|
1870 |
1e68e7f3b824
* lib-src/b2m.c (main): Don't include <limits.h>.
Paul Eggert <eggert@twinsun.com>
parents:
69673
diff
changeset
|
1871 /* Convert to a string, checking for out-of-range time stamps. |
1e68e7f3b824
* lib-src/b2m.c (main): Don't include <limits.h>.
Paul Eggert <eggert@twinsun.com>
parents:
69673
diff
changeset
|
1872 Don't use 'ctime', as that might dump core if VALUE is out of |
1e68e7f3b824
* lib-src/b2m.c (main): Don't include <limits.h>.
Paul Eggert <eggert@twinsun.com>
parents:
69673
diff
changeset
|
1873 range. */ |
69664
55e66496ae1a
* editfns.c: (TM_YEAR_BASE): Move up.
Paul Eggert <eggert@twinsun.com>
parents:
68669
diff
changeset
|
1874 tm = localtime (&value); |
69790
1e68e7f3b824
* lib-src/b2m.c (main): Don't include <limits.h>.
Paul Eggert <eggert@twinsun.com>
parents:
69673
diff
changeset
|
1875 if (! (tm && TM_YEAR_IN_ASCTIME_RANGE (tm->tm_year) && (tem = asctime (tm)))) |
69664
55e66496ae1a
* editfns.c: (TM_YEAR_BASE): Move up.
Paul Eggert <eggert@twinsun.com>
parents:
68669
diff
changeset
|
1876 error ("Specified time is not representable"); |
69790
1e68e7f3b824
* lib-src/b2m.c (main): Don't include <limits.h>.
Paul Eggert <eggert@twinsun.com>
parents:
69673
diff
changeset
|
1877 |
1e68e7f3b824
* lib-src/b2m.c (main): Don't include <limits.h>.
Paul Eggert <eggert@twinsun.com>
parents:
69673
diff
changeset
|
1878 /* Remove the trailing newline. */ |
1e68e7f3b824
* lib-src/b2m.c (main): Don't include <limits.h>.
Paul Eggert <eggert@twinsun.com>
parents:
69673
diff
changeset
|
1879 tem[strlen (tem) - 1] = '\0'; |
1e68e7f3b824
* lib-src/b2m.c (main): Don't include <limits.h>.
Paul Eggert <eggert@twinsun.com>
parents:
69673
diff
changeset
|
1880 |
1e68e7f3b824
* lib-src/b2m.c (main): Don't include <limits.h>.
Paul Eggert <eggert@twinsun.com>
parents:
69673
diff
changeset
|
1881 return build_string (tem); |
305 | 1882 } |
962
3533821d6edc
* editfns.c (Fcurrent_time_zone): Doc fix.
Jim Blandy <jimb@redhat.com>
parents:
690
diff
changeset
|
1883 |
16269
79e6c47054c5
(tm_diff): Renamed from difftm. Yield int, not long.
Paul Eggert <eggert@twinsun.com>
parents:
16134
diff
changeset
|
1884 /* 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
|
1885 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
|
1886 static int |
79e6c47054c5
(tm_diff): Renamed from difftm. Yield int, not long.
Paul Eggert <eggert@twinsun.com>
parents:
16134
diff
changeset
|
1887 tm_diff (a, b) |
2921
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1888 struct tm *a, *b; |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1889 { |
16269
79e6c47054c5
(tm_diff): Renamed from difftm. Yield int, not long.
Paul Eggert <eggert@twinsun.com>
parents:
16134
diff
changeset
|
1890 /* 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
|
1891 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
|
1892 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
|
1893 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
|
1894 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
|
1895 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
|
1896 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
|
1897 int a400 = a100 >> 2; |
79e6c47054c5
(tm_diff): Renamed from difftm. Yield int, not long.
Paul Eggert <eggert@twinsun.com>
parents:
16134
diff
changeset
|
1898 int b400 = b100 >> 2; |
79e6c47054c5
(tm_diff): Renamed from difftm. Yield int, not long.
Paul Eggert <eggert@twinsun.com>
parents:
16134
diff
changeset
|
1899 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
|
1900 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
|
1901 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
|
1902 + (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
|
1903 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
|
1904 + (a->tm_min - b->tm_min)) |
5882 | 1905 + (a->tm_sec - b->tm_sec)); |
2921
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1906 } |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1907 |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1908 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
|
1909 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
|
1910 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
|
1911 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
|
1912 A negative value means west of Greenwich. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1913 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
|
1914 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
|
1915 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
|
1916 (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
|
1917 `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
|
1918 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
|
1919 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1920 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
|
1921 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
|
1922 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
|
1923 (specified_time) |
2921
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1924 Lisp_Object specified_time; |
962
3533821d6edc
* editfns.c (Fcurrent_time_zone): Doc fix.
Jim Blandy <jimb@redhat.com>
parents:
690
diff
changeset
|
1925 { |
2921
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1926 time_t value; |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1927 struct tm *t; |
23198
dddce768cf7a
(Fformat_time_string, Fdecode_time, Fcurrent_time_zone):
Paul Eggert <eggert@twinsun.com>
parents:
23197
diff
changeset
|
1928 struct tm gmt; |
962
3533821d6edc
* editfns.c (Fcurrent_time_zone): Doc fix.
Jim Blandy <jimb@redhat.com>
parents:
690
diff
changeset
|
1929 |
30480 | 1930 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
|
1931 && (t = gmtime (&value)) != 0 |
dddce768cf7a
(Fformat_time_string, Fdecode_time, Fcurrent_time_zone):
Paul Eggert <eggert@twinsun.com>
parents:
23197
diff
changeset
|
1932 && (gmt = *t, t = localtime (&value)) != 0) |
2921
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1933 { |
23198
dddce768cf7a
(Fformat_time_string, Fdecode_time, Fcurrent_time_zone):
Paul Eggert <eggert@twinsun.com>
parents:
23197
diff
changeset
|
1934 int offset = tm_diff (t, &gmt); |
dddce768cf7a
(Fformat_time_string, Fdecode_time, Fcurrent_time_zone):
Paul Eggert <eggert@twinsun.com>
parents:
23197
diff
changeset
|
1935 char *s = 0; |
dddce768cf7a
(Fformat_time_string, Fdecode_time, Fcurrent_time_zone):
Paul Eggert <eggert@twinsun.com>
parents:
23197
diff
changeset
|
1936 char buf[6]; |
2921
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1937 #ifdef HAVE_TM_ZONE |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1938 if (t->tm_zone) |
7506
9fa47d36798a
(Fcurrent_time_zone): Add cast.
Richard M. Stallman <rms@gnu.org>
parents:
7485
diff
changeset
|
1939 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
|
1940 #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
|
1941 #ifdef HAVE_TZNAME |
dc9f7a107e28
(Fcurrent_time_zone): Add alternative for !HAVE_TM_ZONE.
Richard M. Stallman <rms@gnu.org>
parents:
2994
diff
changeset
|
1942 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
|
1943 s = tzname[t->tm_isdst]; |
962
3533821d6edc
* editfns.c (Fcurrent_time_zone): Doc fix.
Jim Blandy <jimb@redhat.com>
parents:
690
diff
changeset
|
1944 #endif |
3522
dc9f7a107e28
(Fcurrent_time_zone): Add alternative for !HAVE_TM_ZONE.
Richard M. Stallman <rms@gnu.org>
parents:
2994
diff
changeset
|
1945 #endif /* not HAVE_TM_ZONE */ |
36479
ac3ee681e8f9
(Fcurrent_time_zone) [HAVE_TM_ZONE || HAVE_TZNAME]:
Gerd Moellmann <gerd@gnu.org>
parents:
35998
diff
changeset
|
1946 |
ac3ee681e8f9
(Fcurrent_time_zone) [HAVE_TM_ZONE || HAVE_TZNAME]:
Gerd Moellmann <gerd@gnu.org>
parents:
35998
diff
changeset
|
1947 #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
|
1948 if (s) |
ac3ee681e8f9
(Fcurrent_time_zone) [HAVE_TM_ZONE || HAVE_TZNAME]:
Gerd Moellmann <gerd@gnu.org>
parents:
35998
diff
changeset
|
1949 { |
ac3ee681e8f9
(Fcurrent_time_zone) [HAVE_TM_ZONE || HAVE_TZNAME]:
Gerd Moellmann <gerd@gnu.org>
parents:
35998
diff
changeset
|
1950 /* 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
|
1951 zone name. Don't accept that. */ |
ac3ee681e8f9
(Fcurrent_time_zone) [HAVE_TM_ZONE || HAVE_TZNAME]:
Gerd Moellmann <gerd@gnu.org>
parents:
35998
diff
changeset
|
1952 char *p; |
39720
e7c5b465528a
(Fcurrent_time_zone): Cast isalnum() argument to
Gerd Moellmann <gerd@gnu.org>
parents:
39682
diff
changeset
|
1953 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
|
1954 ; |
ac3ee681e8f9
(Fcurrent_time_zone) [HAVE_TM_ZONE || HAVE_TZNAME]:
Gerd Moellmann <gerd@gnu.org>
parents:
35998
diff
changeset
|
1955 if (p == s || *p) |
ac3ee681e8f9
(Fcurrent_time_zone) [HAVE_TM_ZONE || HAVE_TZNAME]:
Gerd Moellmann <gerd@gnu.org>
parents:
35998
diff
changeset
|
1956 s = NULL; |
ac3ee681e8f9
(Fcurrent_time_zone) [HAVE_TM_ZONE || HAVE_TZNAME]:
Gerd Moellmann <gerd@gnu.org>
parents:
35998
diff
changeset
|
1957 } |
ac3ee681e8f9
(Fcurrent_time_zone) [HAVE_TM_ZONE || HAVE_TZNAME]:
Gerd Moellmann <gerd@gnu.org>
parents:
35998
diff
changeset
|
1958 #endif |
ac3ee681e8f9
(Fcurrent_time_zone) [HAVE_TM_ZONE || HAVE_TZNAME]:
Gerd Moellmann <gerd@gnu.org>
parents:
35998
diff
changeset
|
1959 |
2921
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1960 if (!s) |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1961 { |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1962 /* 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
|
1963 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
|
1964 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
|
1965 s = buf; |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1966 } |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1967 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
|
1968 } |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1969 else |
18745
192b3ebd108e
(Fcurrent_time_zone): Convert Fmake_list argument to Lisp_Integer.
Richard M. Stallman <rms@gnu.org>
parents:
18661
diff
changeset
|
1970 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
|
1971 } |
3533821d6edc
* editfns.c (Fcurrent_time_zone): Doc fix.
Jim Blandy <jimb@redhat.com>
parents:
690
diff
changeset
|
1972 |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
1973 /* 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
|
1974 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
|
1975 has never been called. */ |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
1976 static char **environbuf; |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
1977 |
13019
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1978 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
|
1979 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
|
1980 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
|
1981 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
|
1982 (tz) |
13019
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1983 Lisp_Object tz; |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1984 { |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1985 char *tzstring; |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1986 |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1987 if (NILP (tz)) |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1988 tzstring = 0; |
18613
614b916ff5bf
Fix bugs with inappropriate mixing of Lisp_Object with int.
Richard M. Stallman <rms@gnu.org>
parents:
18605
diff
changeset
|
1989 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
|
1990 tzstring = "UTC0"; |
13019
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1991 else |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1992 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
1993 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
|
1994 tzstring = (char *) SDATA (tz); |
13019
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1995 } |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
1996 |
13025
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1997 set_time_zone_rule (tzstring); |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1998 if (environbuf) |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1999 free (environbuf); |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
2000 environbuf = environ; |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
2001 |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
2002 return Qnil; |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
2003 } |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
2004 |
16918
ab49512bcdff
(set_time_zone_rule_tz1, set_time_zone_rule_tz2):
Paul Eggert <eggert@twinsun.com>
parents:
16874
diff
changeset
|
2005 #ifdef LOCALTIME_CACHE |
ab49512bcdff
(set_time_zone_rule_tz1, set_time_zone_rule_tz2):
Paul Eggert <eggert@twinsun.com>
parents:
16874
diff
changeset
|
2006 |
ab49512bcdff
(set_time_zone_rule_tz1, set_time_zone_rule_tz2):
Paul Eggert <eggert@twinsun.com>
parents:
16874
diff
changeset
|
2007 /* 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
|
2008 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
|
2009 Their values shouldn't matter in non-buggy implementations. |
30480 | 2010 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
|
2011 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
|
2012 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
|
2013 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
|
2014 improperly modify environment''. */ |
80a852988718
(set_time_zone_rule): Don't put a string literal
Richard M. Stallman <rms@gnu.org>
parents:
15779
diff
changeset
|
2015 |
16918
ab49512bcdff
(set_time_zone_rule_tz1, set_time_zone_rule_tz2):
Paul Eggert <eggert@twinsun.com>
parents:
16874
diff
changeset
|
2016 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
|
2017 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
|
2018 |
ab49512bcdff
(set_time_zone_rule_tz1, set_time_zone_rule_tz2):
Paul Eggert <eggert@twinsun.com>
parents:
16874
diff
changeset
|
2019 #endif |
15841
80a852988718
(set_time_zone_rule): Don't put a string literal
Richard M. Stallman <rms@gnu.org>
parents:
15779
diff
changeset
|
2020 |
13025
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
2021 /* 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
|
2022 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
|
2023 responsibility to free. */ |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
2024 |
14201
ff372902386d
(set_time_zone_rule): No longer static.
Richard M. Stallman <rms@gnu.org>
parents:
14126
diff
changeset
|
2025 void |
13025
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
2026 set_time_zone_rule (tzstring) |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
2027 char *tzstring; |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
2028 { |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
2029 int envptrs; |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
2030 char **from, **to, **newenv; |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
2031 |
15334 | 2032 /* 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
|
2033 for (from = environ; *from; from++) |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
2034 continue; |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
2035 envptrs = from - environ + 2; |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
2036 newenv = to = (char **) xmalloc (envptrs * sizeof (char *) |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
2037 + (tzstring ? strlen (tzstring) + 4 : 0)); |
15334 | 2038 |
2039 /* 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
|
2040 if (tzstring) |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
2041 { |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
2042 char *t = (char *) (to + envptrs); |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
2043 strcpy (t, "TZ="); |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
2044 strcat (t, tzstring); |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
2045 *to++ = t; |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
2046 } |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
2047 |
15334 | 2048 /* Copy the old environ vector elements into NEWENV, |
2049 but don't copy the TZ variable. | |
2050 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
|
2051 for (from = environ; *from; from++) |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
2052 if (strncmp (*from, "TZ=", 3) != 0) |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
2053 *to++ = *from; |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
2054 *to = 0; |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
2055 |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
2056 environ = newenv; |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
2057 |
15334 | 2058 /* If we do have a TZSTRING, NEWENV points to the vector slot where |
2059 the TZ variable is stored. If we do not have a TZSTRING, | |
2060 TO points to the vector slot which has the terminating null. */ | |
2061 | |
13019
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
2062 #ifdef LOCALTIME_CACHE |
15334 | 2063 { |
2064 /* In SunOS 4.1.3_U1 and 4.1.4, if TZ has a value like | |
2065 "US/Pacific" that loads a tz file, then changes to a value like | |
2066 "XXX0" that does not load a tz file, and then changes back to | |
2067 its original value, the last change is (incorrectly) ignored. | |
2068 Also, if TZ changes twice in succession to values that do | |
2069 not load a tz file, tzset can dump core (see Sun bug#1225179). | |
2070 The following code works around these bugs. */ | |
2071 | |
2072 if (tzstring) | |
2073 { | |
2074 /* Temporarily set TZ to a value that loads a tz file | |
2075 and that differs from tzstring. */ | |
2076 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
|
2077 *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
|
2078 ? set_time_zone_rule_tz2 : set_time_zone_rule_tz1); |
15334 | 2079 tzset (); |
2080 *newenv = tz; | |
2081 } | |
2082 else | |
2083 { | |
2084 /* The implied tzstring is unknown, so temporarily set TZ to | |
2085 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
|
2086 *to = set_time_zone_rule_tz1; |
15334 | 2087 to[1] = 0; |
2088 tzset (); | |
15841
80a852988718
(set_time_zone_rule): Don't put a string literal
Richard M. Stallman <rms@gnu.org>
parents:
15779
diff
changeset
|
2089 *to = set_time_zone_rule_tz2; |
15334 | 2090 tzset (); |
2091 *to = 0; | |
2092 } | |
2093 | |
2094 /* Now TZ has the desired value, and tzset can be invoked safely. */ | |
2095 } | |
2096 | |
13019
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
2097 tzset (); |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
2098 #endif |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
2099 } |
305 | 2100 |
17031 | 2101 /* Insert NARGS Lisp objects in the array ARGS by calling INSERT_FUNC |
2102 (if a type of object is Lisp_Int) or INSERT_FROM_STRING_FUNC (if a | |
2103 type of object is Lisp_String). INHERIT is passed to | |
2104 INSERT_FROM_STRING_FUNC as the last argument. */ | |
2105 | |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
2106 static void |
17031 | 2107 general_insert_function (insert_func, insert_from_string_func, |
2108 inherit, nargs, args) | |
46464
e05dd5b81fc7
(general_insert_function): Insertion function now
Ken Raeburn <raeburn@raeburn.org>
parents:
46447
diff
changeset
|
2109 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
|
2110 void (*insert_from_string_func) P_ ((Lisp_Object, int, int, int, int, int)); |
17031 | 2111 int inherit, nargs; |
2112 register Lisp_Object *args; | |
2113 { | |
2114 register int argnum; | |
2115 register Lisp_Object val; | |
2116 | |
2117 for (argnum = 0; argnum < nargs; argnum++) | |
2118 { | |
2119 val = args[argnum]; | |
2120 if (INTEGERP (val)) | |
2121 { | |
26853
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2122 unsigned char str[MAX_MULTIBYTE_LENGTH]; |
17031 | 2123 int len; |
2124 | |
2125 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
|
2126 len = CHAR_STRING (XFASTINT (val), str); |
17031 | 2127 else |
22929
6dda0a4b882f
(general_insert_function): If enable-multibyte-characters is
Kenichi Handa <handa@m17n.org>
parents:
22895
diff
changeset
|
2128 { |
89209
3903a3ae19cb
(general_insert_function): Check VAL by ASCII_CHAR_P,
Kenichi Handa <handa@m17n.org>
parents:
89034
diff
changeset
|
2129 str[0] = (ASCII_CHAR_P (XINT (val)) |
26853
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2130 ? XINT (val) |
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2131 : 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
|
2132 len = 1; |
6dda0a4b882f
(general_insert_function): If enable-multibyte-characters is
Kenichi Handa <handa@m17n.org>
parents:
22895
diff
changeset
|
2133 } |
17031 | 2134 (*insert_func) (str, len); |
2135 } | |
2136 else if (STRINGP (val)) | |
2137 { | |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
2138 (*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
|
2139 SCHARS (val), |
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
2140 SBYTES (val), |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
2141 inherit); |
17031 | 2142 } |
2143 else | |
71832
e891eb992cb2
(general_insert_function): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents:
71817
diff
changeset
|
2144 wrong_type_argument (Qchar_or_string_p, val); |
17031 | 2145 } |
2146 } | |
2147 | |
305 | 2148 void |
2149 insert1 (arg) | |
2150 Lisp_Object arg; | |
2151 { | |
2152 Finsert (1, &arg); | |
2153 } | |
2154 | |
330 | 2155 |
2156 /* Callers passing one argument to Finsert need not gcpro the | |
2157 argument "array", since the only element of the array will | |
2158 not be used after calling insert or insert_from_string, so | |
2159 we don't care if it gets trashed. */ | |
2160 | |
305 | 2161 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
|
2162 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
|
2163 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
|
2164 after the inserted text. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2165 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
|
2166 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2167 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
|
2168 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
|
2169 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
|
2170 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
|
2171 |
41213ea7b9d6
(Finsert): Mention `string-make-multibyte' and
Kim F. Storm <storm@cua.dk>
parents:
49285
diff
changeset
|
2172 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
|
2173 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
|
2174 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
|
2175 and insert the result. |
40131
de086e415fa2
(Finsert, Finsert_and_inherit, Finsert_before_markers, Fmessage)
Miles Bader <miles@gnu.org>
parents:
40046
diff
changeset
|
2176 |
de086e415fa2
(Finsert, Finsert_and_inherit, Finsert_before_markers, Fmessage)
Miles Bader <miles@gnu.org>
parents:
40046
diff
changeset
|
2177 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
|
2178 (nargs, args) |
305 | 2179 int nargs; |
2180 register Lisp_Object *args; | |
2181 { | |
17031 | 2182 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
|
2183 return Qnil; |
350231e38e68
(Finsert_and_inherit): New function.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2184 } |
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 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
|
2187 0, MANY, 0, |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
2188 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
|
2189 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
|
2190 after the inserted text. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2191 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
|
2192 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2193 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
|
2194 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
|
2195 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
|
2196 to unibyte for insertion. |
de086e415fa2
(Finsert, Finsert_and_inherit, Finsert_before_markers, Fmessage)
Miles Bader <miles@gnu.org>
parents:
40046
diff
changeset
|
2197 |
de086e415fa2
(Finsert, Finsert_and_inherit, Finsert_before_markers, Fmessage)
Miles Bader <miles@gnu.org>
parents:
40046
diff
changeset
|
2198 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
|
2199 (nargs, args) |
4714
350231e38e68
(Finsert_and_inherit): New function.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2200 int nargs; |
350231e38e68
(Finsert_and_inherit): New function.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2201 register Lisp_Object *args; |
350231e38e68
(Finsert_and_inherit): New function.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2202 { |
17031 | 2203 general_insert_function (insert_and_inherit, insert_from_string, 1, |
2204 nargs, args); | |
305 | 2205 return Qnil; |
2206 } | |
2207 | |
2208 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
|
2209 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
|
2210 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
|
2211 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2212 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
|
2213 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
|
2214 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
|
2215 to unibyte for insertion. |
de086e415fa2
(Finsert, Finsert_and_inherit, Finsert_before_markers, Fmessage)
Miles Bader <miles@gnu.org>
parents:
40046
diff
changeset
|
2216 |
de086e415fa2
(Finsert, Finsert_and_inherit, Finsert_before_markers, Fmessage)
Miles Bader <miles@gnu.org>
parents:
40046
diff
changeset
|
2217 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
|
2218 (nargs, args) |
305 | 2219 int nargs; |
2220 register Lisp_Object *args; | |
2221 { | |
17031 | 2222 general_insert_function (insert_before_markers, |
2223 insert_from_string_before_markers, 0, | |
2224 nargs, args); | |
4714
350231e38e68
(Finsert_and_inherit): New function.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2225 return Qnil; |
350231e38e68
(Finsert_and_inherit): New function.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2226 } |
350231e38e68
(Finsert_and_inherit): New function.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2227 |
16485
9b919c5464a4
Reorganize function definitions so etags finds them.
Erik Naggum <erik@naggum.no>
parents:
16298
diff
changeset
|
2228 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
|
2229 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
|
2230 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
|
2231 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
|
2232 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2233 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
|
2234 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
|
2235 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
|
2236 to unibyte for insertion. |
de086e415fa2
(Finsert, Finsert_and_inherit, Finsert_before_markers, Fmessage)
Miles Bader <miles@gnu.org>
parents:
40046
diff
changeset
|
2237 |
de086e415fa2
(Finsert, Finsert_and_inherit, Finsert_before_markers, Fmessage)
Miles Bader <miles@gnu.org>
parents:
40046
diff
changeset
|
2238 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
|
2239 (nargs, args) |
4714
350231e38e68
(Finsert_and_inherit): New function.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2240 int nargs; |
350231e38e68
(Finsert_and_inherit): New function.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2241 register Lisp_Object *args; |
350231e38e68
(Finsert_and_inherit): New function.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2242 { |
17031 | 2243 general_insert_function (insert_before_markers_and_inherit, |
2244 insert_from_string_before_markers, 1, | |
2245 nargs, args); | |
305 | 2246 return Qnil; |
2247 } | |
2248 | |
8646
0f05e3e89f87
(Finsert_char): New arg INHERIT.
Richard M. Stallman <rms@gnu.org>
parents:
8333
diff
changeset
|
2249 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
|
2250 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
|
2251 Both arguments are required. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2252 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
|
2253 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
|
2254 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
|
2255 (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
|
2256 Lisp_Object character, count, inherit; |
305 | 2257 { |
2258 register unsigned char *string; | |
2259 register int strlen; | |
2260 register int i, n; | |
17031 | 2261 int len; |
26853
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2262 unsigned char str[MAX_MULTIBYTE_LENGTH]; |
305 | 2263 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
2264 CHECK_NUMBER (character); |
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
2265 CHECK_NUMBER (count); |
305 | 2266 |
17031 | 2267 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
|
2268 len = CHAR_STRING (XFASTINT (character), str); |
17031 | 2269 else |
26853
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2270 str[0] = XFASTINT (character), len = 1; |
17031 | 2271 n = XINT (count) * len; |
305 | 2272 if (n <= 0) |
2273 return Qnil; | |
17031 | 2274 strlen = min (n, 256 * len); |
305 | 2275 string = (unsigned char *) alloca (strlen); |
2276 for (i = 0; i < strlen; i++) | |
17031 | 2277 string[i] = str[i % len]; |
305 | 2278 while (n >= strlen) |
2279 { | |
18194
c291aa915b85
(Finsert_char): Check QUIT.
Richard M. Stallman <rms@gnu.org>
parents:
18106
diff
changeset
|
2280 QUIT; |
8646
0f05e3e89f87
(Finsert_char): New arg INHERIT.
Richard M. Stallman <rms@gnu.org>
parents:
8333
diff
changeset
|
2281 if (!NILP (inherit)) |
0f05e3e89f87
(Finsert_char): New arg INHERIT.
Richard M. Stallman <rms@gnu.org>
parents:
8333
diff
changeset
|
2282 insert_and_inherit (string, strlen); |
0f05e3e89f87
(Finsert_char): New arg INHERIT.
Richard M. Stallman <rms@gnu.org>
parents:
8333
diff
changeset
|
2283 else |
0f05e3e89f87
(Finsert_char): New arg INHERIT.
Richard M. Stallman <rms@gnu.org>
parents:
8333
diff
changeset
|
2284 insert (string, strlen); |
305 | 2285 n -= strlen; |
2286 } | |
2287 if (n > 0) | |
10382
9738aad59697
(Finsert_char): Check inherit flag for long strings too.
Karl Heuer <kwzh@gnu.org>
parents:
10308
diff
changeset
|
2288 { |
9738aad59697
(Finsert_char): Check inherit flag for long strings too.
Karl Heuer <kwzh@gnu.org>
parents:
10308
diff
changeset
|
2289 if (!NILP (inherit)) |
9738aad59697
(Finsert_char): Check inherit flag for long strings too.
Karl Heuer <kwzh@gnu.org>
parents:
10308
diff
changeset
|
2290 insert_and_inherit (string, n); |
9738aad59697
(Finsert_char): Check inherit flag for long strings too.
Karl Heuer <kwzh@gnu.org>
parents:
10308
diff
changeset
|
2291 else |
9738aad59697
(Finsert_char): Check inherit flag for long strings too.
Karl Heuer <kwzh@gnu.org>
parents:
10308
diff
changeset
|
2292 insert (string, n); |
9738aad59697
(Finsert_char): Check inherit flag for long strings too.
Karl Heuer <kwzh@gnu.org>
parents:
10308
diff
changeset
|
2293 } |
305 | 2294 return Qnil; |
2295 } | |
2296 | |
89034
63f566c131d7
(Finsert_byte): New function.
Kenichi Handa <handa@m17n.org>
parents:
89025
diff
changeset
|
2297 DEFUN ("insert-byte", Finsert_byte, Sinsert_byte, 2, 3, 0, |
63f566c131d7
(Finsert_byte): New function.
Kenichi Handa <handa@m17n.org>
parents:
89025
diff
changeset
|
2298 doc: /* Insert COUNT (second arg) copies of BYTE (first arg). |
63f566c131d7
(Finsert_byte): New function.
Kenichi Handa <handa@m17n.org>
parents:
89025
diff
changeset
|
2299 Both arguments are required. |
63f566c131d7
(Finsert_byte): New function.
Kenichi Handa <handa@m17n.org>
parents:
89025
diff
changeset
|
2300 BYTE is a number of the range 0..255. |
63f566c131d7
(Finsert_byte): New function.
Kenichi Handa <handa@m17n.org>
parents:
89025
diff
changeset
|
2301 |
63f566c131d7
(Finsert_byte): New function.
Kenichi Handa <handa@m17n.org>
parents:
89025
diff
changeset
|
2302 If BYTE is 128..255 and the current buffer is multibyte, the |
63f566c131d7
(Finsert_byte): New function.
Kenichi Handa <handa@m17n.org>
parents:
89025
diff
changeset
|
2303 corresponding eight-bit character is inserted. |
63f566c131d7
(Finsert_byte): New function.
Kenichi Handa <handa@m17n.org>
parents:
89025
diff
changeset
|
2304 |
63f566c131d7
(Finsert_byte): New function.
Kenichi Handa <handa@m17n.org>
parents:
89025
diff
changeset
|
2305 Point, and before-insertion markers, are relocated as in the function `insert'. |
63f566c131d7
(Finsert_byte): New function.
Kenichi Handa <handa@m17n.org>
parents:
89025
diff
changeset
|
2306 The optional third arg INHERIT, if non-nil, says to inherit text properties |
63f566c131d7
(Finsert_byte): New function.
Kenichi Handa <handa@m17n.org>
parents:
89025
diff
changeset
|
2307 from adjoining text, if those properties are sticky. */) |
63f566c131d7
(Finsert_byte): New function.
Kenichi Handa <handa@m17n.org>
parents:
89025
diff
changeset
|
2308 (byte, count, inherit) |
63f566c131d7
(Finsert_byte): New function.
Kenichi Handa <handa@m17n.org>
parents:
89025
diff
changeset
|
2309 Lisp_Object byte, count, inherit; |
63f566c131d7
(Finsert_byte): New function.
Kenichi Handa <handa@m17n.org>
parents:
89025
diff
changeset
|
2310 { |
63f566c131d7
(Finsert_byte): New function.
Kenichi Handa <handa@m17n.org>
parents:
89025
diff
changeset
|
2311 CHECK_NUMBER (byte); |
63f566c131d7
(Finsert_byte): New function.
Kenichi Handa <handa@m17n.org>
parents:
89025
diff
changeset
|
2312 if (XINT (byte) < 0 || XINT (byte) > 255) |
63f566c131d7
(Finsert_byte): New function.
Kenichi Handa <handa@m17n.org>
parents:
89025
diff
changeset
|
2313 args_out_of_range_3 (byte, make_number (0), make_number (255)); |
63f566c131d7
(Finsert_byte): New function.
Kenichi Handa <handa@m17n.org>
parents:
89025
diff
changeset
|
2314 if (XINT (byte) >= 128 |
63f566c131d7
(Finsert_byte): New function.
Kenichi Handa <handa@m17n.org>
parents:
89025
diff
changeset
|
2315 && ! NILP (current_buffer->enable_multibyte_characters)) |
63f566c131d7
(Finsert_byte): New function.
Kenichi Handa <handa@m17n.org>
parents:
89025
diff
changeset
|
2316 XSETFASTINT (byte, BYTE8_TO_CHAR (XINT (byte))); |
89217
d0650cc0038f
(Finsert_byte): Return a proper value.
Dave Love <fx@gnu.org>
parents:
89209
diff
changeset
|
2317 return Finsert_char (byte, count, inherit); |
89034
63f566c131d7
(Finsert_byte): New function.
Kenichi Handa <handa@m17n.org>
parents:
89025
diff
changeset
|
2318 } |
63f566c131d7
(Finsert_byte): New function.
Kenichi Handa <handa@m17n.org>
parents:
89025
diff
changeset
|
2319 |
305 | 2320 |
648 | 2321 /* Making strings from buffer contents. */ |
2322 | |
2323 /* 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
|
2324 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
|
2325 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
|
2326 have them, if PROPS is nonzero. |
648 | 2327 |
2328 We don't want to use plain old make_string here, because it calls | |
2329 make_uninit_string, which can cause the buffer arena to be | |
2330 compacted. make_string has no way of knowing that the data has | |
2331 been moved, and thus copies the wrong data into the string. This | |
2332 doesn't effect most of the other users of make_string, so it should | |
2333 be left as is. But we should use this function when conjuring | |
2334 buffer substrings. */ | |
1285
d50533e23dff
* editfns.c (make_buffer_string): Call copy_intervals_to_string().
Joseph Arceneaux <jla@gnu.org>
parents:
1254
diff
changeset
|
2335 |
648 | 2336 Lisp_Object |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2337 make_buffer_string (start, end, props) |
648 | 2338 int start, end; |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2339 int props; |
648 | 2340 { |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
2341 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
|
2342 int end_byte = CHAR_TO_BYTE (end); |
648 | 2343 |
21235
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2344 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
|
2345 } |
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2346 |
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2347 /* 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
|
2348 START / START_BYTE to END / END_BYTE. |
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2349 |
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2350 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
|
2351 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
|
2352 have them, if PROPS is nonzero. |
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2353 |
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2354 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
|
2355 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
|
2356 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
|
2357 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
|
2358 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
|
2359 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
|
2360 buffer substrings. */ |
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2361 |
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2362 Lisp_Object |
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2363 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
|
2364 int start, start_byte, end, end_byte; |
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2365 int props; |
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2366 { |
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2367 Lisp_Object result, tem, tem1; |
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2368 |
648 | 2369 if (start < GPT && GPT < end) |
2370 move_gap (start); | |
2371 | |
21257
205a5aa4aa2f
(Fchar_to_string): Use make_string_from_bytes.
Richard M. Stallman <rms@gnu.org>
parents:
21245
diff
changeset
|
2372 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
|
2373 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
|
2374 else |
205a5aa4aa2f
(Fchar_to_string): Use make_string_from_bytes.
Richard M. Stallman <rms@gnu.org>
parents:
21245
diff
changeset
|
2375 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
|
2376 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
|
2377 end_byte - start_byte); |
648 | 2378 |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2379 /* 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
|
2380 if (props) |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2381 { |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2382 update_buffer_properties (start, end); |
5130
ddee29e260d2
(make_buffer_string): Don't copy intervals
Richard M. Stallman <rms@gnu.org>
parents:
4943
diff
changeset
|
2383 |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2384 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
|
2385 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
|
2386 |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2387 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
|
2388 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
|
2389 end - start); |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2390 } |
1285
d50533e23dff
* editfns.c (make_buffer_string): Call copy_intervals_to_string().
Joseph Arceneaux <jla@gnu.org>
parents:
1254
diff
changeset
|
2391 |
648 | 2392 return result; |
2393 } | |
305 | 2394 |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2395 /* 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
|
2396 in the current buffer, if necessary. */ |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2397 |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2398 static void |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2399 update_buffer_properties (start, end) |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2400 int start, end; |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2401 { |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2402 /* 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
|
2403 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
|
2404 if (!NILP (Vbuffer_access_fontify_functions)) |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2405 { |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2406 Lisp_Object args[3]; |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2407 Lisp_Object tem; |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2408 |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2409 args[0] = Qbuffer_access_fontify_functions; |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2410 XSETINT (args[1], start); |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2411 XSETINT (args[2], end); |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2412 |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2413 /* 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
|
2414 has already been done. */ |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2415 if (!NILP (Vbuffer_access_fontified_property)) |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2416 { |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2417 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
|
2418 Vbuffer_access_fontified_property, |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2419 Qnil, Qnil); |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2420 if (! NILP (tem)) |
14126
edc94b82c3b3
(update_buffer_properties): Delete superfluous &'s.
Karl Heuer <kwzh@gnu.org>
parents:
14071
diff
changeset
|
2421 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
|
2422 } |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2423 else |
14126
edc94b82c3b3
(update_buffer_properties): Delete superfluous &'s.
Karl Heuer <kwzh@gnu.org>
parents:
14071
diff
changeset
|
2424 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
|
2425 } |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2426 } |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2427 |
305 | 2428 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
|
2429 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
|
2430 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
|
2431 they can be in either order. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2432 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
|
2433 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2434 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
|
2435 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
|
2436 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
|
2437 (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
|
2438 Lisp_Object start, end; |
305 | 2439 { |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2440 register int b, e; |
305 | 2441 |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2442 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
|
2443 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
|
2444 e = XINT (end); |
305 | 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 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
|
2447 } |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2448 |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2449 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
|
2450 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
|
2451 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
|
2452 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
|
2453 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
|
2454 (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
|
2455 Lisp_Object start, end; |
13767
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 register int b, e; |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2458 |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2459 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
|
2460 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
|
2461 e = XINT (end); |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2462 |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2463 return make_buffer_string (b, e, 0); |
305 | 2464 } |
2465 | |
2466 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
|
2467 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
|
2468 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
|
2469 of the buffer. */) |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
2470 () |
305 | 2471 { |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
2472 return make_buffer_string (BEGV, ZV, 1); |
305 | 2473 } |
2474 | |
2475 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
|
2476 1, 3, 0, |
55424
04990cada43d
(Finsert_buffer_substring): Make argument names match their use in
Juanma Barranquero <lekktu@gmail.com>
parents:
55193
diff
changeset
|
2477 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
|
2478 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
|
2479 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
|
2480 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
|
2481 (buffer, start, end) |
04990cada43d
(Finsert_buffer_substring): Make argument names match their use in
Juanma Barranquero <lekktu@gmail.com>
parents:
55193
diff
changeset
|
2482 Lisp_Object buffer, start, end; |
305 | 2483 { |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2484 register int b, e, temp; |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2485 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
|
2486 Lisp_Object buf; |
04990cada43d
(Finsert_buffer_substring): Make argument names match their use in
Juanma Barranquero <lekktu@gmail.com>
parents:
55193
diff
changeset
|
2487 |
04990cada43d
(Finsert_buffer_substring): Make argument names match their use in
Juanma Barranquero <lekktu@gmail.com>
parents:
55193
diff
changeset
|
2488 buf = Fget_buffer (buffer); |
04990cada43d
(Finsert_buffer_substring): Make argument names match their use in
Juanma Barranquero <lekktu@gmail.com>
parents:
55193
diff
changeset
|
2489 if (NILP (buf)) |
04990cada43d
(Finsert_buffer_substring): Make argument names match their use in
Juanma Barranquero <lekktu@gmail.com>
parents:
55193
diff
changeset
|
2490 nsberror (buffer); |
04990cada43d
(Finsert_buffer_substring): Make argument names match their use in
Juanma Barranquero <lekktu@gmail.com>
parents:
55193
diff
changeset
|
2491 bp = XBUFFER (buf); |
16134
7558d82368f9
(Finsert_buffer_substring): Check for deleted buffer.
Karl Heuer <kwzh@gnu.org>
parents:
16097
diff
changeset
|
2492 if (NILP (bp->name)) |
7558d82368f9
(Finsert_buffer_substring): Check for deleted buffer.
Karl Heuer <kwzh@gnu.org>
parents:
16097
diff
changeset
|
2493 error ("Selecting deleted buffer"); |
305 | 2494 |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2495 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
|
2496 b = BUF_BEGV (bp); |
305 | 2497 else |
2498 { | |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
2499 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
|
2500 b = XINT (start); |
305 | 2501 } |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2502 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
|
2503 e = BUF_ZV (bp); |
305 | 2504 else |
2505 { | |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
2506 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
|
2507 e = XINT (end); |
305 | 2508 } |
2509 | |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2510 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
|
2511 temp = b, b = e, e = temp; |
305 | 2512 |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2513 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
|
2514 args_out_of_range (start, end); |
305 | 2515 |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2516 obuf = current_buffer; |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2517 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
|
2518 update_buffer_properties (b, e); |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2519 set_buffer_internal_1 (obuf); |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2520 |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2521 insert_from_buffer (bp, b, e - b, 0); |
305 | 2522 return Qnil; |
2523 } | |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2524 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2525 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
|
2526 6, 6, 0, |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
2527 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
|
2528 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
|
2529 +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
|
2530 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
|
2531 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
|
2532 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2533 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
|
2534 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
|
2535 (buffer1, start1, end1, buffer2, start2, end2) |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2536 Lisp_Object buffer1, start1, end1, buffer2, start2, end2; |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2537 { |
21837
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2538 register int begp1, endp1, begp2, endp2, temp; |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2539 register struct buffer *bp1, *bp2; |
66367
a80af18dfc7e
(Fcompare_buffer_substrings): Handle multibyte chars.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65763
diff
changeset
|
2540 register Lisp_Object trt |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2541 = (!NILP (current_buffer->case_fold_search) |
66379
48a5d83a7c9d
(Fcompare_buffer_substrings): Fix last change.
Kim F. Storm <storm@cua.dk>
parents:
66367
diff
changeset
|
2542 ? current_buffer->case_canon_table : Qnil); |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
2543 int chars = 0; |
21837
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2544 int i1, i2, i1_byte, i2_byte; |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2545 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2546 /* Find the first buffer and its substring. */ |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2547 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2548 if (NILP (buffer1)) |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2549 bp1 = current_buffer; |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2550 else |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2551 { |
1854
5a18c36181fa
(Finsert_buffer_substring): Proper error for non-ex buffer.
Richard M. Stallman <rms@gnu.org>
parents:
1853
diff
changeset
|
2552 Lisp_Object buf1; |
5a18c36181fa
(Finsert_buffer_substring): Proper error for non-ex buffer.
Richard M. Stallman <rms@gnu.org>
parents:
1853
diff
changeset
|
2553 buf1 = Fget_buffer (buffer1); |
5a18c36181fa
(Finsert_buffer_substring): Proper error for non-ex buffer.
Richard M. Stallman <rms@gnu.org>
parents:
1853
diff
changeset
|
2554 if (NILP (buf1)) |
5a18c36181fa
(Finsert_buffer_substring): Proper error for non-ex buffer.
Richard M. Stallman <rms@gnu.org>
parents:
1853
diff
changeset
|
2555 nsberror (buffer1); |
5a18c36181fa
(Finsert_buffer_substring): Proper error for non-ex buffer.
Richard M. Stallman <rms@gnu.org>
parents:
1853
diff
changeset
|
2556 bp1 = XBUFFER (buf1); |
16134
7558d82368f9
(Finsert_buffer_substring): Check for deleted buffer.
Karl Heuer <kwzh@gnu.org>
parents:
16097
diff
changeset
|
2557 if (NILP (bp1->name)) |
7558d82368f9
(Finsert_buffer_substring): Check for deleted buffer.
Karl Heuer <kwzh@gnu.org>
parents:
16097
diff
changeset
|
2558 error ("Selecting deleted buffer"); |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2559 } |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2560 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2561 if (NILP (start1)) |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2562 begp1 = BUF_BEGV (bp1); |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2563 else |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2564 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
2565 CHECK_NUMBER_COERCE_MARKER (start1); |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2566 begp1 = XINT (start1); |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2567 } |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2568 if (NILP (end1)) |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2569 endp1 = BUF_ZV (bp1); |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2570 else |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2571 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
2572 CHECK_NUMBER_COERCE_MARKER (end1); |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2573 endp1 = XINT (end1); |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2574 } |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2575 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2576 if (begp1 > endp1) |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2577 temp = begp1, begp1 = endp1, endp1 = temp; |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2578 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2579 if (!(BUF_BEGV (bp1) <= begp1 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2580 && begp1 <= endp1 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2581 && endp1 <= BUF_ZV (bp1))) |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2582 args_out_of_range (start1, end1); |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2583 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2584 /* Likewise for second substring. */ |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2585 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2586 if (NILP (buffer2)) |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2587 bp2 = current_buffer; |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2588 else |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2589 { |
1854
5a18c36181fa
(Finsert_buffer_substring): Proper error for non-ex buffer.
Richard M. Stallman <rms@gnu.org>
parents:
1853
diff
changeset
|
2590 Lisp_Object buf2; |
5a18c36181fa
(Finsert_buffer_substring): Proper error for non-ex buffer.
Richard M. Stallman <rms@gnu.org>
parents:
1853
diff
changeset
|
2591 buf2 = Fget_buffer (buffer2); |
5a18c36181fa
(Finsert_buffer_substring): Proper error for non-ex buffer.
Richard M. Stallman <rms@gnu.org>
parents:
1853
diff
changeset
|
2592 if (NILP (buf2)) |
5a18c36181fa
(Finsert_buffer_substring): Proper error for non-ex buffer.
Richard M. Stallman <rms@gnu.org>
parents:
1853
diff
changeset
|
2593 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
|
2594 bp2 = XBUFFER (buf2); |
16134
7558d82368f9
(Finsert_buffer_substring): Check for deleted buffer.
Karl Heuer <kwzh@gnu.org>
parents:
16097
diff
changeset
|
2595 if (NILP (bp2->name)) |
7558d82368f9
(Finsert_buffer_substring): Check for deleted buffer.
Karl Heuer <kwzh@gnu.org>
parents:
16097
diff
changeset
|
2596 error ("Selecting deleted buffer"); |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2597 } |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2598 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2599 if (NILP (start2)) |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2600 begp2 = BUF_BEGV (bp2); |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2601 else |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2602 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
2603 CHECK_NUMBER_COERCE_MARKER (start2); |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2604 begp2 = XINT (start2); |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2605 } |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2606 if (NILP (end2)) |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2607 endp2 = BUF_ZV (bp2); |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2608 else |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2609 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
2610 CHECK_NUMBER_COERCE_MARKER (end2); |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2611 endp2 = XINT (end2); |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2612 } |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2613 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2614 if (begp2 > endp2) |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2615 temp = begp2, begp2 = endp2, endp2 = temp; |
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 if (!(BUF_BEGV (bp2) <= begp2 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2618 && begp2 <= endp2 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2619 && endp2 <= BUF_ZV (bp2))) |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2620 args_out_of_range (start2, end2); |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2621 |
21837
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2622 i1 = begp1; |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2623 i2 = begp2; |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2624 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
|
2625 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
|
2626 |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2627 while (i1 < endp1 && i2 < endp2) |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2628 { |
21837
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2629 /* 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
|
2630 characters, not just the bytes. */ |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2631 int c1, c2; |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2632 |
42116
37b724c77b98
(Fcompare_buffer_substrings): Add QUIT to main loop.
Richard M. Stallman <rms@gnu.org>
parents:
41065
diff
changeset
|
2633 QUIT; |
37b724c77b98
(Fcompare_buffer_substrings): Add QUIT to main loop.
Richard M. Stallman <rms@gnu.org>
parents:
41065
diff
changeset
|
2634 |
21837
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2635 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
|
2636 { |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2637 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
|
2638 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
|
2639 i1++; |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2640 } |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2641 else |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2642 { |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2643 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
|
2644 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
|
2645 i1++; |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2646 } |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2647 |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2648 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
|
2649 { |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2650 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
|
2651 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
|
2652 i2++; |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2653 } |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2654 else |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2655 { |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2656 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
|
2657 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
|
2658 i2++; |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2659 } |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
2660 |
66367
a80af18dfc7e
(Fcompare_buffer_substrings): Handle multibyte chars.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65763
diff
changeset
|
2661 if (!NILP (trt)) |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2662 { |
66367
a80af18dfc7e
(Fcompare_buffer_substrings): Handle multibyte chars.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65763
diff
changeset
|
2663 c1 = CHAR_TABLE_TRANSLATE (trt, c1); |
a80af18dfc7e
(Fcompare_buffer_substrings): Handle multibyte chars.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65763
diff
changeset
|
2664 c2 = CHAR_TABLE_TRANSLATE (trt, c2); |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2665 } |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2666 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
|
2667 return make_number (- 1 - chars); |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2668 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
|
2669 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
|
2670 |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2671 chars++; |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2672 } |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2673 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2674 /* The strings match as far as they go. |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2675 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
|
2676 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
|
2677 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
|
2678 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
|
2679 return make_number (- chars - 1); |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2680 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2681 /* Same length too => they are equal. */ |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2682 return make_number (0); |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2683 } |
305 | 2684 |
10480
fbb254882b9f
(subst_char_in_region_unwind): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10383
diff
changeset
|
2685 static Lisp_Object |
fbb254882b9f
(subst_char_in_region_unwind): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10383
diff
changeset
|
2686 subst_char_in_region_unwind (arg) |
fbb254882b9f
(subst_char_in_region_unwind): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10383
diff
changeset
|
2687 Lisp_Object arg; |
fbb254882b9f
(subst_char_in_region_unwind): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10383
diff
changeset
|
2688 { |
fbb254882b9f
(subst_char_in_region_unwind): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10383
diff
changeset
|
2689 return current_buffer->undo_list = arg; |
fbb254882b9f
(subst_char_in_region_unwind): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10383
diff
changeset
|
2690 } |
fbb254882b9f
(subst_char_in_region_unwind): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10383
diff
changeset
|
2691 |
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 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
|
2693 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
|
2694 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
|
2695 { |
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
|
2696 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
|
2697 } |
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
|
2698 |
305 | 2699 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
|
2700 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
|
2701 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
|
2702 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
|
2703 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
|
2704 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
|
2705 (start, end, fromchar, tochar, noundo) |
305 | 2706 Lisp_Object start, end, fromchar, tochar, noundo; |
2707 { | |
20834
95a80c1e06c3
(Fsubst_char_in_region): Handle character-base
Kenichi Handa <handa@m17n.org>
parents:
20826
diff
changeset
|
2708 register int pos, pos_byte, stop, i, len, end_byte; |
72272
f3b2e3e20e3b
(Fsubst_char_in_region): Redo the setup work after running
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
72194
diff
changeset
|
2709 /* Keep track of the first change in the buffer: |
f3b2e3e20e3b
(Fsubst_char_in_region): Redo the setup work after running
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
72194
diff
changeset
|
2710 if 0 we haven't found it yet. |
f3b2e3e20e3b
(Fsubst_char_in_region): Redo the setup work after running
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
72194
diff
changeset
|
2711 if < 0 we've found it and we've run the before-change-function. |
f3b2e3e20e3b
(Fsubst_char_in_region): Redo the setup work after running
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
72194
diff
changeset
|
2712 if > 0 we've actually performed it and the value is its position. */ |
5130
ddee29e260d2
(make_buffer_string): Don't copy intervals
Richard M. Stallman <rms@gnu.org>
parents:
4943
diff
changeset
|
2713 int changed = 0; |
26853
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2714 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
|
2715 unsigned char *p; |
46293
1fb8f75062c6
Use macro SPECPDL_INDEX.
Juanma Barranquero <lekktu@gmail.com>
parents:
45398
diff
changeset
|
2716 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
|
2717 #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
|
2718 #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
|
2719 #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
|
2720 #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
|
2721 int maybe_byte_combining = COMBINING_NO; |
32420
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
2722 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
|
2723 int multibyte_p = !NILP (current_buffer->enable_multibyte_characters); |
305 | 2724 |
72272
f3b2e3e20e3b
(Fsubst_char_in_region): Redo the setup work after running
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
72194
diff
changeset
|
2725 restart: |
f3b2e3e20e3b
(Fsubst_char_in_region): Redo the setup work after running
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
72194
diff
changeset
|
2726 |
305 | 2727 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
|
2728 CHECK_NUMBER (fromchar); |
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
2729 CHECK_NUMBER (tochar); |
305 | 2730 |
28358
7ae3851c0a19
(Fsubst_char_in_region): Don't use INC_POS in unibyte
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2731 if (multibyte_p) |
17031 | 2732 { |
26853
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2733 len = CHAR_STRING (XFASTINT (fromchar), fromstr); |
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2734 if (CHAR_STRING (XFASTINT (tochar), tostr) != len) |
63696
43b9742ef102
(Fsubst_char_in_region): Follow error conventions.
Juanma Barranquero <lekktu@gmail.com>
parents:
62662
diff
changeset
|
2735 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
|
2736 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
|
2737 { |
b9b4581adf36
(Fsubst_char_in_region): Adjust the way to check byte-combining
Kenichi Handa <handa@m17n.org>
parents:
25346
diff
changeset
|
2738 /* 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
|
2739 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
|
2740 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
|
2741 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
|
2742 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
|
2743 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
|
2744 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
|
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 } |
17031 | 2747 } |
2748 else | |
2749 { | |
2750 len = 1; | |
26853
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2751 fromstr[0] = XFASTINT (fromchar); |
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2752 tostr[0] = XFASTINT (tochar); |
17031 | 2753 } |
2754 | |
20834
95a80c1e06c3
(Fsubst_char_in_region): Handle character-base
Kenichi Handa <handa@m17n.org>
parents:
20826
diff
changeset
|
2755 pos = XINT (start); |
95a80c1e06c3
(Fsubst_char_in_region): Handle character-base
Kenichi Handa <handa@m17n.org>
parents:
20826
diff
changeset
|
2756 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
|
2757 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
|
2758 end_byte = stop; |
305 | 2759 |
10480
fbb254882b9f
(subst_char_in_region_unwind): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10383
diff
changeset
|
2760 /* 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
|
2761 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
|
2762 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
|
2763 Also inhibit locking the file. */ |
72272
f3b2e3e20e3b
(Fsubst_char_in_region): Redo the setup work after running
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
72194
diff
changeset
|
2764 if (!changed && !NILP (noundo)) |
10480
fbb254882b9f
(subst_char_in_region_unwind): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10383
diff
changeset
|
2765 { |
fbb254882b9f
(subst_char_in_region_unwind): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10383
diff
changeset
|
2766 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
|
2767 current_buffer->undo_list); |
fbb254882b9f
(subst_char_in_region_unwind): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10383
diff
changeset
|
2768 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
|
2769 /* 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
|
2770 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
|
2771 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
|
2772 current_buffer->filename = Qnil; |
10480
fbb254882b9f
(subst_char_in_region_unwind): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10383
diff
changeset
|
2773 } |
fbb254882b9f
(subst_char_in_region_unwind): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10383
diff
changeset
|
2774 |
20834
95a80c1e06c3
(Fsubst_char_in_region): Handle character-base
Kenichi Handa <handa@m17n.org>
parents:
20826
diff
changeset
|
2775 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
|
2776 stop = min (stop, GPT_BYTE); |
17031 | 2777 while (1) |
305 | 2778 { |
23554
e06e84c477fa
(Fsubst_char_in_region): Correctly handle the case
Kenichi Handa <handa@m17n.org>
parents:
23553
diff
changeset
|
2779 int pos_byte_next = pos_byte; |
e06e84c477fa
(Fsubst_char_in_region): Correctly handle the case
Kenichi Handa <handa@m17n.org>
parents:
23553
diff
changeset
|
2780 |
20834
95a80c1e06c3
(Fsubst_char_in_region): Handle character-base
Kenichi Handa <handa@m17n.org>
parents:
20826
diff
changeset
|
2781 if (pos_byte >= stop) |
17031 | 2782 { |
20834
95a80c1e06c3
(Fsubst_char_in_region): Handle character-base
Kenichi Handa <handa@m17n.org>
parents:
20826
diff
changeset
|
2783 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
|
2784 stop = end_byte; |
17031 | 2785 } |
20834
95a80c1e06c3
(Fsubst_char_in_region): Handle character-base
Kenichi Handa <handa@m17n.org>
parents:
20826
diff
changeset
|
2786 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
|
2787 if (multibyte_p) |
7ae3851c0a19
(Fsubst_char_in_region): Don't use INC_POS in unibyte
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2788 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
|
2789 else |
7ae3851c0a19
(Fsubst_char_in_region): Don't use INC_POS in unibyte
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2790 ++pos_byte_next; |
23554
e06e84c477fa
(Fsubst_char_in_region): Correctly handle the case
Kenichi Handa <handa@m17n.org>
parents:
23553
diff
changeset
|
2791 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
|
2792 && p[0] == fromstr[0] |
17031 | 2793 && (len == 1 |
2794 || (p[1] == fromstr[1] | |
2795 && (len == 2 || (p[2] == fromstr[2] | |
2796 && (len == 3 || p[3] == fromstr[3])))))) | |
305 | 2797 { |
72272
f3b2e3e20e3b
(Fsubst_char_in_region): Redo the setup work after running
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
72194
diff
changeset
|
2798 if (changed < 0) |
f3b2e3e20e3b
(Fsubst_char_in_region): Redo the setup work after running
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
72194
diff
changeset
|
2799 /* We've already seen this and run the before-change-function; |
f3b2e3e20e3b
(Fsubst_char_in_region): Redo the setup work after running
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
72194
diff
changeset
|
2800 this time we only need to record the actual position. */ |
f3b2e3e20e3b
(Fsubst_char_in_region): Redo the setup work after running
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
72194
diff
changeset
|
2801 changed = pos; |
f3b2e3e20e3b
(Fsubst_char_in_region): Redo the setup work after running
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
72194
diff
changeset
|
2802 else if (!changed) |
5130
ddee29e260d2
(make_buffer_string): Don't copy intervals
Richard M. Stallman <rms@gnu.org>
parents:
4943
diff
changeset
|
2803 { |
72272
f3b2e3e20e3b
(Fsubst_char_in_region): Redo the setup work after running
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
72194
diff
changeset
|
2804 changed = -1; |
72592
f6de516bbb4b
* buffer.h (struct buffer_text): New field chars_modiff.
Chong Yidong <cyd@stupidchicken.com>
parents:
72584
diff
changeset
|
2805 modify_region (current_buffer, pos, XINT (end), 0); |
5242
0e99ea9941e2
(Fmessage): Use message2.
Richard M. Stallman <rms@gnu.org>
parents:
5130
diff
changeset
|
2806 |
0e99ea9941e2
(Fmessage): Use message2.
Richard M. Stallman <rms@gnu.org>
parents:
5130
diff
changeset
|
2807 if (! NILP (noundo)) |
0e99ea9941e2
(Fmessage): Use message2.
Richard M. Stallman <rms@gnu.org>
parents:
5130
diff
changeset
|
2808 { |
10308
90784ed0416f
Use SAVE_MODIFF and BUF_SAVE_MODIFF
Richard M. Stallman <rms@gnu.org>
parents:
9812
diff
changeset
|
2809 if (MODIFF - 1 == SAVE_MODIFF) |
90784ed0416f
Use SAVE_MODIFF and BUF_SAVE_MODIFF
Richard M. Stallman <rms@gnu.org>
parents:
9812
diff
changeset
|
2810 SAVE_MODIFF++; |
5242
0e99ea9941e2
(Fmessage): Use message2.
Richard M. Stallman <rms@gnu.org>
parents:
5130
diff
changeset
|
2811 if (MODIFF - 1 == current_buffer->auto_save_modified) |
0e99ea9941e2
(Fmessage): Use message2.
Richard M. Stallman <rms@gnu.org>
parents:
5130
diff
changeset
|
2812 current_buffer->auto_save_modified++; |
0e99ea9941e2
(Fmessage): Use message2.
Richard M. Stallman <rms@gnu.org>
parents:
5130
diff
changeset
|
2813 } |
72272
f3b2e3e20e3b
(Fsubst_char_in_region): Redo the setup work after running
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
72194
diff
changeset
|
2814 |
f3b2e3e20e3b
(Fsubst_char_in_region): Redo the setup work after running
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
72194
diff
changeset
|
2815 /* The before-change-function may have moved the gap |
f3b2e3e20e3b
(Fsubst_char_in_region): Redo the setup work after running
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
72194
diff
changeset
|
2816 or even modified the buffer so we should start over. */ |
f3b2e3e20e3b
(Fsubst_char_in_region): Redo the setup work after running
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
72194
diff
changeset
|
2817 goto restart; |
5130
ddee29e260d2
(make_buffer_string): Don't copy intervals
Richard M. Stallman <rms@gnu.org>
parents:
4943
diff
changeset
|
2818 } |
ddee29e260d2
(make_buffer_string): Don't copy intervals
Richard M. Stallman <rms@gnu.org>
parents:
4943
diff
changeset
|
2819 |
22895
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2820 /* Take care of the case where the new character |
30480 | 2821 combines with neighboring bytes. */ |
23554
e06e84c477fa
(Fsubst_char_in_region): Correctly handle the case
Kenichi Handa <handa@m17n.org>
parents:
23553
diff
changeset
|
2822 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
|
2823 && (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
|
2824 ? (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
|
2825 && ! 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
|
2826 : ((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
|
2827 && ! 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
|
2828 || (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
|
2829 && ! 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
|
2830 { |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2831 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
|
2832 |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2833 struct gcpro gcpro1; |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2834 |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2835 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
|
2836 GCPRO1 (tem); |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2837 |
25507
b9b4581adf36
(Fsubst_char_in_region): Adjust the way to check byte-combining
Kenichi Handa <handa@m17n.org>
parents:
25346
diff
changeset
|
2838 /* 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
|
2839 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
|
2840 /* 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
|
2841 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
|
2842 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
|
2843 0, 0, 1); |
23554
e06e84c477fa
(Fsubst_char_in_region): Correctly handle the case
Kenichi Handa <handa@m17n.org>
parents:
23553
diff
changeset
|
2844 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
|
2845 if (pos_byte_next > pos_byte) |
e06e84c477fa
(Fsubst_char_in_region): Correctly handle the case
Kenichi Handa <handa@m17n.org>
parents:
23553
diff
changeset
|
2846 /* 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
|
2847 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
|
2848 decrease it now. */ |
077655e1e014
(Fsubst_char_in_region): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23554
diff
changeset
|
2849 pos--; |
23554
e06e84c477fa
(Fsubst_char_in_region): Correctly handle the case
Kenichi Handa <handa@m17n.org>
parents:
23553
diff
changeset
|
2850 else |
23565
077655e1e014
(Fsubst_char_in_region): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23554
diff
changeset
|
2851 INC_POS (pos_byte_next); |
30480 | 2852 |
22895
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2853 if (! NILP (noundo)) |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2854 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
|
2855 |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2856 UNGCPRO; |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2857 } |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2858 else |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2859 { |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2860 if (NILP (noundo)) |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2861 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
|
2862 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
|
2863 } |
26853
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2864 last_changed = pos + 1; |
305 | 2865 } |
23565
077655e1e014
(Fsubst_char_in_region): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23554
diff
changeset
|
2866 pos_byte = pos_byte_next; |
077655e1e014
(Fsubst_char_in_region): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23554
diff
changeset
|
2867 pos++; |
305 | 2868 } |
2869 | |
72272
f3b2e3e20e3b
(Fsubst_char_in_region): Redo the setup work after running
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
72194
diff
changeset
|
2870 if (changed > 0) |
26853
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2871 { |
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2872 signal_after_change (changed, |
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2873 last_changed - changed, last_changed - changed); |
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2874 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
|
2875 } |
5130
ddee29e260d2
(make_buffer_string): Don't copy intervals
Richard M. Stallman <rms@gnu.org>
parents:
4943
diff
changeset
|
2876 |
10480
fbb254882b9f
(subst_char_in_region_unwind): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10383
diff
changeset
|
2877 unbind_to (count, Qnil); |
305 | 2878 return Qnil; |
2879 } | |
2880 | |
89878 | 2881 |
2882 static Lisp_Object check_translation P_ ((int, int, int, Lisp_Object)); | |
2883 | |
2884 /* Helper function for Ftranslate_region_internal. | |
2885 | |
2886 Check if a character sequence at POS (POS_BYTE) matches an element | |
2887 of VAL. VAL is a list (([FROM-CHAR ...] . TO) ...). If a matching | |
2888 element is found, return it. Otherwise return Qnil. */ | |
2889 | |
2890 static Lisp_Object | |
2891 check_translation (pos, pos_byte, end, val) | |
2892 int pos, pos_byte, end; | |
2893 Lisp_Object val; | |
2894 { | |
2895 int buf_size = 16, buf_used = 0; | |
2896 int *buf = alloca (sizeof (int) * buf_size); | |
2897 | |
2898 for (; CONSP (val); val = XCDR (val)) | |
2899 { | |
2900 Lisp_Object elt; | |
2901 int len, i; | |
2902 | |
2903 elt = XCAR (val); | |
2904 if (! CONSP (elt)) | |
2905 continue; | |
2906 elt = XCAR (elt); | |
2907 if (! VECTORP (elt)) | |
2908 continue; | |
2909 len = ASIZE (elt); | |
2910 if (len <= end - pos) | |
2911 { | |
2912 for (i = 0; i < len; i++) | |
2913 { | |
2914 if (buf_used <= i) | |
2915 { | |
2916 unsigned char *p = BYTE_POS_ADDR (pos_byte); | |
2917 int len; | |
2918 | |
2919 if (buf_used == buf_size) | |
2920 { | |
2921 int *newbuf; | |
2922 | |
2923 buf_size += 16; | |
2924 newbuf = alloca (sizeof (int) * buf_size); | |
2925 memcpy (newbuf, buf, sizeof (int) * buf_used); | |
2926 buf = newbuf; | |
2927 } | |
2928 buf[buf_used++] = STRING_CHAR_AND_LENGTH (p, 0, len); | |
2929 pos_byte += len; | |
2930 } | |
2931 if (XINT (AREF (elt, i)) != buf[i]) | |
2932 break; | |
2933 } | |
2934 if (i == len) | |
2935 return XCAR (val); | |
2936 } | |
2937 } | |
2938 return Qnil; | |
2939 } | |
2940 | |
2941 | |
57644
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2942 DEFUN ("translate-region-internal", Ftranslate_region_internal, |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2943 Stranslate_region_internal, 3, 3, 0, |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2944 doc: /* Internal use only. |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2945 From START to END, translate characters according to TABLE. |
89878 | 2946 TABLE is a string or a char-table; the Nth character in it is the |
2947 mapping for the character with code N. | |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
2948 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
|
2949 (start, end, table) |
305 | 2950 Lisp_Object start; |
2951 Lisp_Object end; | |
2952 register Lisp_Object table; | |
2953 { | |
2954 register unsigned char *tt; /* Trans table. */ | |
2955 register int nc; /* New character. */ | |
2956 int cnt; /* Number of changes made. */ | |
2957 int size; /* Size of translate table. */ | |
57644
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2958 int pos, pos_byte, end_pos; |
26415
bda6a3a2bf96
(Ftranslate_region): Check the buffer multibyteness.
Kenichi Handa <handa@m17n.org>
parents:
26389
diff
changeset
|
2959 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
|
2960 int string_multibyte; |
89840
c49eea8699c8
(Ftranslate_region_internal): Renamed from
Kenichi Handa <handa@m17n.org>
parents:
89601
diff
changeset
|
2961 Lisp_Object val; |
305 | 2962 |
2963 validate_region (&start, &end); | |
57644
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2964 if (CHAR_TABLE_P (table)) |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2965 { |
89878 | 2966 if (! EQ (XCHAR_TABLE (table)->purpose, Qtranslation_table)) |
2967 error ("Not a translation table"); | |
57644
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2968 size = MAX_CHAR; |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2969 tt = NULL; |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2970 } |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2971 else |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2972 { |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2973 CHECK_STRING (table); |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2974 |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2975 if (! multibyte && (SCHARS (table) < SBYTES (table))) |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2976 table = string_make_unibyte (table); |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2977 string_multibyte = SCHARS (table) < SBYTES (table); |
89840
c49eea8699c8
(Ftranslate_region_internal): Renamed from
Kenichi Handa <handa@m17n.org>
parents:
89601
diff
changeset
|
2978 size = SBYTES (table); |
57644
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2979 tt = SDATA (table); |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2980 } |
305 | 2981 |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
2982 pos = XINT (start); |
54214
a2f5ab3b6d1b
(Ftranslate_region): Fix previous change
Kenichi Handa <handa@m17n.org>
parents:
54213
diff
changeset
|
2983 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
|
2984 end_pos = XINT (end); |
90599 | 2985 modify_region (current_buffer, pos, end_pos, 0); |
305 | 2986 |
2987 cnt = 0; | |
57644
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2988 for (; pos < end_pos; ) |
305 | 2989 { |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
2990 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
|
2991 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
|
2992 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
|
2993 int oc; |
89878 | 2994 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
|
2995 |
26415
bda6a3a2bf96
(Ftranslate_region): Check the buffer multibyteness.
Kenichi Handa <handa@m17n.org>
parents:
26389
diff
changeset
|
2996 if (multibyte) |
54214
a2f5ab3b6d1b
(Ftranslate_region): Fix previous change
Kenichi Handa <handa@m17n.org>
parents:
54213
diff
changeset
|
2997 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
|
2998 else |
bda6a3a2bf96
(Ftranslate_region): Check the buffer multibyteness.
Kenichi Handa <handa@m17n.org>
parents:
26389
diff
changeset
|
2999 oc = *p, len = 1; |
54213
29d4d158e5eb
(Ftranslate_region): Handle multibyte chars in the arg
Kenichi Handa <handa@m17n.org>
parents:
53819
diff
changeset
|
3000 if (oc < size) |
305 | 3001 { |
57644
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
3002 if (tt) |
54213
29d4d158e5eb
(Ftranslate_region): Handle multibyte chars in the arg
Kenichi Handa <handa@m17n.org>
parents:
53819
diff
changeset
|
3003 { |
65455
51d3a3f03a8a
(Ftranslate_region_internal): Reload `tt' after
Kim F. Storm <storm@cua.dk>
parents:
65324
diff
changeset
|
3004 /* Reload as signal_after_change in last iteration may GC. */ |
51d3a3f03a8a
(Ftranslate_region_internal): Reload `tt' after
Kim F. Storm <storm@cua.dk>
parents:
65324
diff
changeset
|
3005 tt = SDATA (table); |
57644
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
3006 if (string_multibyte) |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
3007 { |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
3008 str = tt + string_char_to_byte (table, oc); |
90050
1df66cb75f66
(Ftranslate_region_internal): Don't convert unibyte
Kenichi Handa <handa@m17n.org>
parents:
90044
diff
changeset
|
3009 nc = STRING_CHAR_AND_LENGTH (str, MAX_MULTIBYTE_LENGTH, |
57644
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
3010 str_len); |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
3011 } |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
3012 else |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
3013 { |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
3014 nc = tt[oc]; |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
3015 if (! ASCII_BYTE_P (nc) && multibyte) |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
3016 { |
90050
1df66cb75f66
(Ftranslate_region_internal): Don't convert unibyte
Kenichi Handa <handa@m17n.org>
parents:
90044
diff
changeset
|
3017 str_len = BYTE8_STRING (nc, buf); |
57644
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
3018 str = buf; |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
3019 } |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
3020 else |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
3021 { |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
3022 str_len = 1; |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
3023 str = tt + oc; |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
3024 } |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
3025 } |
54213
29d4d158e5eb
(Ftranslate_region): Handle multibyte chars in the arg
Kenichi Handa <handa@m17n.org>
parents:
53819
diff
changeset
|
3026 } |
29d4d158e5eb
(Ftranslate_region): Handle multibyte chars in the arg
Kenichi Handa <handa@m17n.org>
parents:
53819
diff
changeset
|
3027 else |
29d4d158e5eb
(Ftranslate_region): Handle multibyte chars in the arg
Kenichi Handa <handa@m17n.org>
parents:
53819
diff
changeset
|
3028 { |
57644
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
3029 int c; |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
3030 |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
3031 nc = oc; |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
3032 val = CHAR_TABLE_REF (table, oc); |
90050
1df66cb75f66
(Ftranslate_region_internal): Don't convert unibyte
Kenichi Handa <handa@m17n.org>
parents:
90044
diff
changeset
|
3033 if (CHARACTERP (val) |
57644
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
3034 && (c = XINT (val), CHAR_VALID_P (c, 0))) |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
3035 { |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
3036 nc = c; |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
3037 str_len = CHAR_STRING (nc, buf); |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
3038 str = buf; |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
3039 } |
90050
1df66cb75f66
(Ftranslate_region_internal): Don't convert unibyte
Kenichi Handa <handa@m17n.org>
parents:
90044
diff
changeset
|
3040 else if (VECTORP (val) || (CONSP (val))) |
1df66cb75f66
(Ftranslate_region_internal): Don't convert unibyte
Kenichi Handa <handa@m17n.org>
parents:
90044
diff
changeset
|
3041 { |
1df66cb75f66
(Ftranslate_region_internal): Don't convert unibyte
Kenichi Handa <handa@m17n.org>
parents:
90044
diff
changeset
|
3042 /* VAL is [TO_CHAR ...] or (([FROM-CHAR ...] . TO) ...) |
1df66cb75f66
(Ftranslate_region_internal): Don't convert unibyte
Kenichi Handa <handa@m17n.org>
parents:
90044
diff
changeset
|
3043 where TO is TO-CHAR or [TO-CHAR ...]. */ |
1df66cb75f66
(Ftranslate_region_internal): Don't convert unibyte
Kenichi Handa <handa@m17n.org>
parents:
90044
diff
changeset
|
3044 nc = -1; |
1df66cb75f66
(Ftranslate_region_internal): Don't convert unibyte
Kenichi Handa <handa@m17n.org>
parents:
90044
diff
changeset
|
3045 } |
54213
29d4d158e5eb
(Ftranslate_region): Handle multibyte chars in the arg
Kenichi Handa <handa@m17n.org>
parents:
53819
diff
changeset
|
3046 } |
57644
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
3047 |
90050
1df66cb75f66
(Ftranslate_region_internal): Don't convert unibyte
Kenichi Handa <handa@m17n.org>
parents:
90044
diff
changeset
|
3048 if (nc != oc && nc >= 0) |
305 | 3049 { |
89878 | 3050 /* Simple one char to one char translation. */ |
54214
a2f5ab3b6d1b
(Ftranslate_region): Fix previous change
Kenichi Handa <handa@m17n.org>
parents:
54213
diff
changeset
|
3051 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
|
3052 { |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
3053 Lisp_Object string; |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
3054 |
54214
a2f5ab3b6d1b
(Ftranslate_region): Fix previous change
Kenichi Handa <handa@m17n.org>
parents:
54213
diff
changeset
|
3055 /* This is less efficient, because it moves the gap, |
89878 | 3056 but it should handle multibyte characters correctly. */ |
54213
29d4d158e5eb
(Ftranslate_region): Handle multibyte chars in the arg
Kenichi Handa <handa@m17n.org>
parents:
53819
diff
changeset
|
3057 string = make_multibyte_string (str, 1, str_len); |
54214
a2f5ab3b6d1b
(Ftranslate_region): Fix previous change
Kenichi Handa <handa@m17n.org>
parents:
54213
diff
changeset
|
3058 replace_range (pos, pos + 1, string, 1, 0, 1); |
a2f5ab3b6d1b
(Ftranslate_region): Fix previous change
Kenichi Handa <handa@m17n.org>
parents:
54213
diff
changeset
|
3059 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
|
3060 } |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
3061 else |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
3062 { |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
3063 record_change (pos, 1); |
54213
29d4d158e5eb
(Ftranslate_region): Handle multibyte chars in the arg
Kenichi Handa <handa@m17n.org>
parents:
53819
diff
changeset
|
3064 while (str_len-- > 0) |
29d4d158e5eb
(Ftranslate_region): Handle multibyte chars in the arg
Kenichi Handa <handa@m17n.org>
parents:
53819
diff
changeset
|
3065 *p++ = *str++; |
22895
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
3066 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
|
3067 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
|
3068 } |
305 | 3069 ++cnt; |
3070 } | |
90050
1df66cb75f66
(Ftranslate_region_internal): Don't convert unibyte
Kenichi Handa <handa@m17n.org>
parents:
90044
diff
changeset
|
3071 else if (nc < 0) |
89840
c49eea8699c8
(Ftranslate_region_internal): Renamed from
Kenichi Handa <handa@m17n.org>
parents:
89601
diff
changeset
|
3072 { |
89878 | 3073 Lisp_Object string; |
3074 | |
3075 if (CONSP (val)) | |
3076 { | |
3077 val = check_translation (pos, pos_byte, end_pos, val); | |
3078 if (NILP (val)) | |
3079 { | |
3080 pos_byte += len; | |
3081 pos++; | |
3082 continue; | |
3083 } | |
3084 /* VAL is ([FROM-CHAR ...] . TO). */ | |
3085 len = ASIZE (XCAR (val)); | |
3086 val = XCDR (val); | |
3087 } | |
3088 else | |
3089 len = 1; | |
3090 | |
3091 if (VECTORP (val)) | |
3092 { | |
3093 int i; | |
3094 | |
3095 string = Fmake_string (make_number (ASIZE (val)), | |
3096 AREF (val, 0)); | |
3097 for (i = 1; i < ASIZE (val); i++) | |
3098 Faset (string, make_number (i), AREF (val, i)); | |
3099 } | |
3100 else | |
3101 { | |
3102 string = Fmake_string (make_number (1), val); | |
3103 } | |
3104 replace_range (pos, pos + len, string, 1, 0, 1); | |
3105 pos_byte += SBYTES (string); | |
3106 pos += SCHARS (string); | |
3107 cnt += SCHARS (string); | |
3108 end_pos += SCHARS (string) - len; | |
3109 continue; | |
89840
c49eea8699c8
(Ftranslate_region_internal): Renamed from
Kenichi Handa <handa@m17n.org>
parents:
89601
diff
changeset
|
3110 } |
305 | 3111 } |
54214
a2f5ab3b6d1b
(Ftranslate_region): Fix previous change
Kenichi Handa <handa@m17n.org>
parents:
54213
diff
changeset
|
3112 pos_byte += len; |
23565
077655e1e014
(Fsubst_char_in_region): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23554
diff
changeset
|
3113 pos++; |
305 | 3114 } |
3115 | |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3116 return make_number (cnt); |
305 | 3117 } |
3118 | |
3119 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
|
3120 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
|
3121 |
39966
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3122 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
|
3123 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
|
3124 (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
|
3125 Lisp_Object start, end; |
305 | 3126 { |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
3127 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
|
3128 del_range (XINT (start), XINT (end)); |
305 | 3129 return Qnil; |
3130 } | |
26742
936b39bd05b4
* editfns.c (Fdelete_and_extract_region): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
26699
diff
changeset
|
3131 |
936b39bd05b4
* editfns.c (Fdelete_and_extract_region): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
26699
diff
changeset
|
3132 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
|
3133 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
|
3134 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
|
3135 (start, end) |
26742
936b39bd05b4
* editfns.c (Fdelete_and_extract_region): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
26699
diff
changeset
|
3136 Lisp_Object start, end; |
936b39bd05b4
* editfns.c (Fdelete_and_extract_region): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
26699
diff
changeset
|
3137 { |
936b39bd05b4
* editfns.c (Fdelete_and_extract_region): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
26699
diff
changeset
|
3138 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
|
3139 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
|
3140 return build_string (""); |
26742
936b39bd05b4
* editfns.c (Fdelete_and_extract_region): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
26699
diff
changeset
|
3141 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
|
3142 } |
305 | 3143 |
3144 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
|
3145 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
|
3146 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
|
3147 () |
305 | 3148 { |
19207
be370e94fb42
(Fwiden, Fnarrow_to_region, save_restriction_restore):
Richard M. Stallman <rms@gnu.org>
parents:
19032
diff
changeset
|
3149 if (BEG != BEGV || Z != ZV) |
be370e94fb42
(Fwiden, Fnarrow_to_region, save_restriction_restore):
Richard M. Stallman <rms@gnu.org>
parents:
19032
diff
changeset
|
3150 current_buffer->clip_changed = 1; |
305 | 3151 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
|
3152 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
|
3153 SET_BUF_ZV_BOTH (current_buffer, Z, Z_BYTE); |
330 | 3154 /* Changing the buffer bounds invalidates any recorded current column. */ |
3155 invalidate_current_column (); | |
305 | 3156 return Qnil; |
3157 } | |
3158 | |
3159 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
|
3160 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
|
3161 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
|
3162 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
|
3163 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
|
3164 See also `save-restriction'. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3165 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3166 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
|
3167 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
|
3168 (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
|
3169 register Lisp_Object start, end; |
305 | 3170 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
3171 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
|
3172 CHECK_NUMBER_COERCE_MARKER (end); |
305 | 3173 |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
3174 if (XINT (start) > XINT (end)) |
305 | 3175 { |
10383
a7fe0fb11314
(Fnarrow_to_region): Swap using temp Lisp_Object, not int.
Karl Heuer <kwzh@gnu.org>
parents:
10382
diff
changeset
|
3176 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
|
3177 tem = start; start = end; end = tem; |
305 | 3178 } |
3179 | |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
3180 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
|
3181 args_out_of_range (start, end); |
305 | 3182 |
19207
be370e94fb42
(Fwiden, Fnarrow_to_region, save_restriction_restore):
Richard M. Stallman <rms@gnu.org>
parents:
19032
diff
changeset
|
3183 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
|
3184 current_buffer->clip_changed = 1; |
be370e94fb42
(Fwiden, Fnarrow_to_region, save_restriction_restore):
Richard M. Stallman <rms@gnu.org>
parents:
19032
diff
changeset
|
3185 |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3186 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
|
3187 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
|
3188 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
|
3189 SET_PT (XFASTINT (start)); |
16039
855c8d8ba0f0
Change all references from point to PT.
Karl Heuer <kwzh@gnu.org>
parents:
15910
diff
changeset
|
3190 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
|
3191 SET_PT (XFASTINT (end)); |
330 | 3192 /* Changing the buffer bounds invalidates any recorded current column. */ |
3193 invalidate_current_column (); | |
305 | 3194 return Qnil; |
3195 } | |
3196 | |
3197 Lisp_Object | |
3198 save_restriction_save () | |
3199 { | |
30931
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3200 if (BEGV == BEG && ZV == Z) |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3201 /* 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
|
3202 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
|
3203 recognizes as meaning `no restriction'. */ |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3204 return Fcurrent_buffer (); |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3205 else |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3206 /* 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
|
3207 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
|
3208 { |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3209 Lisp_Object beg, end; |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3210 |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3211 beg = buildmark (BEGV, BEGV_BYTE); |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3212 end = buildmark (ZV, ZV_BYTE); |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3213 |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3214 /* 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
|
3215 XMARKER(end)->insertion_type = 1; |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3216 |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3217 return Fcons (beg, end); |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3218 } |
305 | 3219 } |
3220 | |
3221 Lisp_Object | |
3222 save_restriction_restore (data) | |
3223 Lisp_Object data; | |
3224 { | |
30931
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3225 if (CONSP (data)) |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3226 /* A pair of marks bounding a saved restriction. */ |
305 | 3227 { |
30931
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3228 struct Lisp_Marker *beg = XMARKER (XCAR (data)); |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3229 struct Lisp_Marker *end = XMARKER (XCDR (data)); |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3230 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
|
3231 |
46921
40c8bb63c063
(save_restriction_restore): Defend from unchained marker.
Richard M. Stallman <rms@gnu.org>
parents:
46639
diff
changeset
|
3232 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
|
3233 && (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
|
3234 /* 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
|
3235 the saved restriction. */ |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3236 { |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3237 int pt = BUF_PT (buf); |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3238 |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3239 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
|
3240 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
|
3241 |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3242 if (pt < beg->charpos || pt > end->charpos) |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3243 /* 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
|
3244 SET_BUF_PT_BOTH (buf, |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3245 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
|
3246 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
|
3247 end->bytepos)); |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49472
diff
changeset
|
3248 |
30931
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3249 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
|
3250 } |
305 | 3251 } |
30931
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3252 else |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3253 /* 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
|
3254 { |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3255 struct buffer *buf = XBUFFER (data); |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3256 |
46921
40c8bb63c063
(save_restriction_restore): Defend from unchained marker.
Richard M. Stallman <rms@gnu.org>
parents:
46639
diff
changeset
|
3257 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
|
3258 && (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
|
3259 /* 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
|
3260 { |
46921
40c8bb63c063
(save_restriction_restore): Defend from unchained marker.
Richard M. Stallman <rms@gnu.org>
parents:
46639
diff
changeset
|
3261 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
|
3262 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
|
3263 |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3264 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
|
3265 } |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3266 } |
305 | 3267 |
3268 return Qnil; | |
3269 } | |
3270 | |
3271 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
|
3272 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
|
3273 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
|
3274 (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
|
3275 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
|
3276 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
|
3277 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
|
3278 The old restrictions settings are restored |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3279 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
|
3280 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3281 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
|
3282 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3283 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
|
3284 use `save-excursion' outermost: |
40140
9bf80d5fff41
(Fsave_excursion, Fsave_current_buffer)
Miles Bader <miles@gnu.org>
parents:
40131
diff
changeset
|
3285 (save-excursion (save-restriction ...)) |
9bf80d5fff41
(Fsave_excursion, Fsave_current_buffer)
Miles Bader <miles@gnu.org>
parents:
40131
diff
changeset
|
3286 |
9bf80d5fff41
(Fsave_excursion, Fsave_current_buffer)
Miles Bader <miles@gnu.org>
parents:
40131
diff
changeset
|
3287 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
|
3288 (body) |
305 | 3289 Lisp_Object body; |
3290 { | |
3291 register Lisp_Object val; | |
46293
1fb8f75062c6
Use macro SPECPDL_INDEX.
Juanma Barranquero <lekktu@gmail.com>
parents:
45398
diff
changeset
|
3292 int count = SPECPDL_INDEX (); |
305 | 3293 |
3294 record_unwind_protect (save_restriction_restore, save_restriction_save ()); | |
3295 val = Fprogn (body); | |
3296 return unbind_to (count, val); | |
3297 } | |
3298 | |
38059
0b34b024286d
(Fmessage_box): If the frame is not under a window
Eli Zaretskii <eliz@gnu.org>
parents:
37916
diff
changeset
|
3299 /* 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
|
3300 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
|
3301 |
d02095ea13a5
(Fmessage): Copy the text to be displayed into a malloc'd buffer.
Karl Heuer <kwzh@gnu.org>
parents:
5882
diff
changeset
|
3302 /* 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
|
3303 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
|
3304 |
305 | 3305 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
|
3306 doc: /* Print a one-line message at the bottom of the screen. |
57736 | 3307 The message also goes into the `*Messages*' buffer. |
3308 \(In keyboard macros, that's all it does.) | |
3309 | |
39966
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3310 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
|
3311 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
|
3312 |
65455
51d3a3f03a8a
(Ftranslate_region_internal): Reload `tt' after
Kim F. Storm <storm@cua.dk>
parents:
65324
diff
changeset
|
3313 If the first argument is nil or the empty string, the function clears |
51d3a3f03a8a
(Ftranslate_region_internal): Reload `tt' after
Kim F. Storm <storm@cua.dk>
parents:
65324
diff
changeset
|
3314 any existing message; this lets the minibuffer contents show. See |
51d3a3f03a8a
(Ftranslate_region_internal): Reload `tt' after
Kim F. Storm <storm@cua.dk>
parents:
65324
diff
changeset
|
3315 also `current-message'. |
40131
de086e415fa2
(Finsert, Finsert_and_inherit, Finsert_before_markers, Fmessage)
Miles Bader <miles@gnu.org>
parents:
40046
diff
changeset
|
3316 |
65739
83ce839858fb
(Fmessage, Fmessage_box, Fmessage_or_box):
Juri Linkov <juri@jurta.org>
parents:
65659
diff
changeset
|
3317 usage: (message FORMAT-STRING &rest ARGS) */) |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
3318 (nargs, args) |
305 | 3319 int nargs; |
3320 Lisp_Object *args; | |
3321 { | |
46639
8587dd21917c
(Fmessage): Treat "" like nil.
Richard M. Stallman <rms@gnu.org>
parents:
46464
diff
changeset
|
3322 if (NILP (args[0]) |
8587dd21917c
(Fmessage): Treat "" like nil.
Richard M. Stallman <rms@gnu.org>
parents:
46464
diff
changeset
|
3323 || (STRINGP (args[0]) |
8587dd21917c
(Fmessage): Treat "" like nil.
Richard M. Stallman <rms@gnu.org>
parents:
46464
diff
changeset
|
3324 && 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
|
3325 { |
e21c1f3e37cb
* editfns.c (Fmessage): Don't forget to return a value when
Jim Blandy <jimb@redhat.com>
parents:
1854
diff
changeset
|
3326 message (0); |
59662
c140948a6044
(Fmessage): If arg is "", return "" (as before).
Richard M. Stallman <rms@gnu.org>
parents:
59658
diff
changeset
|
3327 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
|
3328 } |
1426
67fd35416ba3
* * editfns.c (Fmessage): With no arguments, clear any active
Jim Blandy <jimb@redhat.com>
parents:
1285
diff
changeset
|
3329 else |
67fd35416ba3
* * editfns.c (Fmessage): With no arguments, clear any active
Jim Blandy <jimb@redhat.com>
parents:
1285
diff
changeset
|
3330 { |
67fd35416ba3
* * editfns.c (Fmessage): With no arguments, clear any active
Jim Blandy <jimb@redhat.com>
parents:
1285
diff
changeset
|
3331 register Lisp_Object val; |
48115
72f8d789f551
(Fmessage): Revert last change to properly handle %% format.
Andreas Schwab <schwab@suse.de>
parents:
48111
diff
changeset
|
3332 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
|
3333 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
|
3334 return val; |
67fd35416ba3
* * editfns.c (Fmessage): With no arguments, clear any active
Jim Blandy <jimb@redhat.com>
parents:
1285
diff
changeset
|
3335 } |
305 | 3336 } |
3337 | |
8975
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3338 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
|
3339 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
|
3340 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
|
3341 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
|
3342 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
|
3343 |
65455
51d3a3f03a8a
(Ftranslate_region_internal): Reload `tt' after
Kim F. Storm <storm@cua.dk>
parents:
65324
diff
changeset
|
3344 If the first argument is nil or the empty string, clear any existing |
51d3a3f03a8a
(Ftranslate_region_internal): Reload `tt' after
Kim F. Storm <storm@cua.dk>
parents:
65324
diff
changeset
|
3345 message; let the minibuffer contents show. |
40131
de086e415fa2
(Finsert, Finsert_and_inherit, Finsert_before_markers, Fmessage)
Miles Bader <miles@gnu.org>
parents:
40046
diff
changeset
|
3346 |
65739
83ce839858fb
(Fmessage, Fmessage_box, Fmessage_or_box):
Juri Linkov <juri@jurta.org>
parents:
65659
diff
changeset
|
3347 usage: (message-box FORMAT-STRING &rest ARGS) */) |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
3348 (nargs, args) |
8975
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3349 int nargs; |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3350 Lisp_Object *args; |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3351 { |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3352 if (NILP (args[0])) |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3353 { |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3354 message (0); |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3355 return Qnil; |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3356 } |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3357 else |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3358 { |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3359 register Lisp_Object val; |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3360 val = Fformat (nargs, args); |
13878
2a71500dfb93
(Fmessage_box, Fmessage_or_box):
Richard M. Stallman <rms@gnu.org>
parents:
13767
diff
changeset
|
3361 #ifdef HAVE_MENUS |
38059
0b34b024286d
(Fmessage_box): If the frame is not under a window
Eli Zaretskii <eliz@gnu.org>
parents:
37916
diff
changeset
|
3362 /* 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
|
3363 not FRAME_WINDOW_P. */ |
0b34b024286d
(Fmessage_box): If the frame is not under a window
Eli Zaretskii <eliz@gnu.org>
parents:
37916
diff
changeset
|
3364 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
|
3365 || FRAME_MSDOS_P (XFRAME (selected_frame))) |
8975
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3366 { |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3367 Lisp_Object pane, menu, obj; |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3368 struct gcpro gcpro1; |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3369 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
|
3370 GCPRO1 (pane); |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3371 menu = Fcons (val, pane); |
62662
9733e98a93e4
(Fmessage_box): Use "Information" for frame title.
Nick Roberts <nickrob@snap.net.nz>
parents:
61700
diff
changeset
|
3372 obj = Fx_popup_dialog (Qt, menu, Qt); |
8975
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3373 UNGCPRO; |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3374 return val; |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3375 } |
38059
0b34b024286d
(Fmessage_box): If the frame is not under a window
Eli Zaretskii <eliz@gnu.org>
parents:
37916
diff
changeset
|
3376 #endif /* HAVE_MENUS */ |
8975
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3377 /* 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
|
3378 if (! message_text) |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3379 { |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3380 message_text = (char *)xmalloc (80); |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3381 message_length = 80; |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3382 } |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
3383 if (SBYTES (val) > message_length) |
8975
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3384 { |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
3385 message_length = SBYTES (val); |
8975
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3386 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
|
3387 } |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
3388 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
|
3389 message2 (message_text, SBYTES (val), |
21358
e9f7d8708bae
(Fmessage_box): Pass the missing third argument
Richard M. Stallman <rms@gnu.org>
parents:
21257
diff
changeset
|
3390 STRING_MULTIBYTE (val)); |
8975
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3391 return val; |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3392 } |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3393 } |
13878
2a71500dfb93
(Fmessage_box, Fmessage_or_box):
Richard M. Stallman <rms@gnu.org>
parents:
13767
diff
changeset
|
3394 #ifdef HAVE_MENUS |
8975
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3395 extern Lisp_Object last_nonmenu_event; |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3396 #endif |
13878
2a71500dfb93
(Fmessage_box, Fmessage_or_box):
Richard M. Stallman <rms@gnu.org>
parents:
13767
diff
changeset
|
3397 |
8975
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3398 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
|
3399 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
|
3400 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
|
3401 `use-dialog-box' is non-nil. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3402 Otherwise, use the echo area. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3403 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
|
3404 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
|
3405 |
65455
51d3a3f03a8a
(Ftranslate_region_internal): Reload `tt' after
Kim F. Storm <storm@cua.dk>
parents:
65324
diff
changeset
|
3406 If the first argument is nil or the empty string, clear any existing |
51d3a3f03a8a
(Ftranslate_region_internal): Reload `tt' after
Kim F. Storm <storm@cua.dk>
parents:
65324
diff
changeset
|
3407 message; let the minibuffer contents show. |
40131
de086e415fa2
(Finsert, Finsert_and_inherit, Finsert_before_markers, Fmessage)
Miles Bader <miles@gnu.org>
parents:
40046
diff
changeset
|
3408 |
65739
83ce839858fb
(Fmessage, Fmessage_box, Fmessage_or_box):
Juri Linkov <juri@jurta.org>
parents:
65659
diff
changeset
|
3409 usage: (message-or-box FORMAT-STRING &rest ARGS) */) |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
3410 (nargs, args) |
8975
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3411 int nargs; |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3412 Lisp_Object *args; |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3413 { |
13878
2a71500dfb93
(Fmessage_box, Fmessage_or_box):
Richard M. Stallman <rms@gnu.org>
parents:
13767
diff
changeset
|
3414 #ifdef HAVE_MENUS |
26699
ed4ab9d24450
(Fmessage_or_box): Use use_dialog_box.
Dave Love <fx@gnu.org>
parents:
26629
diff
changeset
|
3415 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
|
3416 && use_dialog_box) |
8981
6e1a5ff3d795
(Fmessage_or_box): Use Fmessage_box with new name.
Richard M. Stallman <rms@gnu.org>
parents:
8975
diff
changeset
|
3417 return Fmessage_box (nargs, args); |
8975
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3418 #endif |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3419 return Fmessage (nargs, args); |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3420 } |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3421 |
18937
ddb91108a9d2
(Fcurrent_message): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18756
diff
changeset
|
3422 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
|
3423 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
|
3424 () |
18937
ddb91108a9d2
(Fcurrent_message): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18756
diff
changeset
|
3425 { |
25346
15ec35852b48
Remove conditional compilation on NO_PROMPT_IN_BUFFER.
Gerd Moellmann <gerd@gnu.org>
parents:
25018
diff
changeset
|
3426 return current_message (); |
18937
ddb91108a9d2
(Fcurrent_message): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18756
diff
changeset
|
3427 } |
ddb91108a9d2
(Fcurrent_message): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18756
diff
changeset
|
3428 |
25815 | 3429 |
41062
07a4ff5f0909
(Fpropertize): Allow call with 1 arg.
Richard M. Stallman <rms@gnu.org>
parents:
40981
diff
changeset
|
3430 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
|
3431 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
|
3432 First argument is the string to copy. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3433 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
|
3434 properties to add to the result. |
de086e415fa2
(Finsert, Finsert_and_inherit, Finsert_before_markers, Fmessage)
Miles Bader <miles@gnu.org>
parents:
40046
diff
changeset
|
3435 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
|
3436 (nargs, args) |
25815 | 3437 int nargs; |
3438 Lisp_Object *args; | |
3439 { | |
3440 Lisp_Object properties, string; | |
3441 struct gcpro gcpro1, gcpro2; | |
3442 int i; | |
3443 | |
3444 /* Number of args must be odd. */ | |
41062
07a4ff5f0909
(Fpropertize): Allow call with 1 arg.
Richard M. Stallman <rms@gnu.org>
parents:
40981
diff
changeset
|
3445 if ((nargs & 1) == 0 || nargs < 1) |
25815 | 3446 error ("Wrong number of arguments"); |
3447 | |
3448 properties = string = Qnil; | |
3449 GCPRO2 (properties, string); | |
30480 | 3450 |
25815 | 3451 /* 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
|
3452 CHECK_STRING (args[0]); |
25815 | 3453 string = Fcopy_sequence (args[0]); |
3454 | |
3455 for (i = 1; i < nargs; i += 2) | |
65324
3c228c69b2e5
(Fpropertize): Don't insist that properties be symbols.
Richard M. Stallman <rms@gnu.org>
parents:
64770
diff
changeset
|
3456 properties = Fcons (args[i], Fcons (args[i + 1], properties)); |
25815 | 3457 |
3458 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
|
3459 make_number (SCHARS (string)), |
25815 | 3460 properties, string); |
3461 RETURN_UNGCPRO (string); | |
3462 } | |
3463 | |
3464 | |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3465 /* 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
|
3466 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
|
3467 |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3468 #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
|
3469 (((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
|
3470 ? 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
|
3471 : SBYTES (STRING)) |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3472 |
305 | 3473 DEFUN ("format", Fformat, Sformat, 1, MANY, 0, |
65739
83ce839858fb
(Fmessage, Fmessage_box, Fmessage_or_box):
Juri Linkov <juri@jurta.org>
parents:
65659
diff
changeset
|
3474 doc: /* Format a string out of a format-string and arguments. |
83ce839858fb
(Fmessage, Fmessage_box, Fmessage_or_box):
Juri Linkov <juri@jurta.org>
parents:
65659
diff
changeset
|
3475 The first argument is a format control string. |
39966
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3476 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
|
3477 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
|
3478 %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
|
3479 %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
|
3480 %X is like %x, but uses upper case. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3481 %e means print a number in exponential notation. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3482 %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
|
3483 %g means print a number in exponential notation |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3484 or decimal-point notation, whichever uses fewer characters. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3485 %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
|
3486 %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
|
3487 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
|
3488 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
|
3489 |
53687
4f06a8a0e7a6
For `format', make source and documentation match.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53541
diff
changeset
|
3490 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
|
3491 % <flags> <width> <precision> character |
4f06a8a0e7a6
For `format', make source and documentation match.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53541
diff
changeset
|
3492 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
|
3493 |
40131
de086e415fa2
(Finsert, Finsert_and_inherit, Finsert_before_markers, Fmessage)
Miles Bader <miles@gnu.org>
parents:
40046
diff
changeset
|
3494 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
|
3495 (nargs, args) |
305 | 3496 int nargs; |
3497 register Lisp_Object *args; | |
3498 { | |
3499 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
|
3500 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
|
3501 char *buf, *p; |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3502 register unsigned char *format, *end, *format_start; |
25782
8f59abd3a02b
(init_editfns): Remove unused variables.
Gerd Moellmann <gerd@gnu.org>
parents:
25662
diff
changeset
|
3503 int nchars; |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3504 /* 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
|
3505 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
|
3506 int multibyte = 0; |
22698
ea6ef56295b4
(Fformat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents:
22669
diff
changeset
|
3507 /* 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
|
3508 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
|
3509 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
|
3510 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
|
3511 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
|
3512 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
|
3513 /* 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
|
3514 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
|
3515 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
|
3516 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
|
3517 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
|
3518 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
|
3519 int longest_format; |
20804
14fa73136e64
(CONVERTED_BYTE_SIZE): Fix the logic.
Kenichi Handa <handa@m17n.org>
parents:
20706
diff
changeset
|
3520 Lisp_Object val; |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3521 int arg_intervals = 0; |
56194
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
3522 USE_SAFE_ALLOCA; |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3523 |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3524 /* 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
|
3525 string was not copied into the output. |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3526 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
|
3527 char *discarded = 0; |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3528 |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3529 /* Each element records, for one argument, |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3530 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
|
3531 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
|
3532 info[0] is unused. Unused elements have -1 for start. */ |
25018 | 3533 struct info |
3534 { | |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3535 int start, end, intervals; |
25018 | 3536 } *info = 0; |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3537 |
305 | 3538 /* It should not be necessary to GCPRO ARGS, because |
3539 the caller in the interpreter should take care of that. */ | |
3540 | |
20826
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3541 /* 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
|
3542 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
|
3543 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
|
3544 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
|
3545 for (n = 0; n < nargs; n++) |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3546 { |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3547 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
|
3548 multibyte = 1; |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3549 /* 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
|
3550 precision[n] = -1; |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3551 } |
56560
1a84eb100ef3
(Fformat): Allocated extra (dummy) element in info.
Kim F. Storm <storm@cua.dk>
parents:
56386
diff
changeset
|
3552 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
|
3553 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
3554 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
|
3555 /* 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
|
3556 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
|
3557 |
50746
2a57a6e6b390
(Fformat): Set abort_on_gc during first scan of format.
Richard M. Stallman <rms@gnu.org>
parents:
50555
diff
changeset
|
3558 /* 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
|
3559 abort_on_gc++; |
2a57a6e6b390
(Fformat): Set abort_on_gc during first scan of format.
Richard M. Stallman <rms@gnu.org>
parents:
50555
diff
changeset
|
3560 |
20826
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3561 /* 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
|
3562 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
|
3563 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
|
3564 retry: |
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3565 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
3566 format = SDATA (args[0]); |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3567 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
|
3568 end = format + SBYTES (args[0]); |
20826
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3569 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
|
3570 |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3571 /* 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
|
3572 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
|
3573 |
54846
e8865bfda38b
(Fformat): Fix allocation size of precision array.
Kim F. Storm <storm@cua.dk>
parents:
54655
diff
changeset
|
3574 /* Allocate the info and discarded tables. */ |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3575 { |
56560
1a84eb100ef3
(Fformat): Allocated extra (dummy) element in info.
Kim F. Storm <storm@cua.dk>
parents:
56386
diff
changeset
|
3576 int nbytes = (nargs+1) * sizeof *info; |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3577 int i; |
57725
c0675c413aa3
(Fformat): Allocate discarded table with SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
57644
diff
changeset
|
3578 if (!info) |
c0675c413aa3
(Fformat): Allocate discarded table with SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
57644
diff
changeset
|
3579 info = (struct info *) alloca (nbytes); |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3580 bzero (info, nbytes); |
56560
1a84eb100ef3
(Fformat): Allocated extra (dummy) element in info.
Kim F. Storm <storm@cua.dk>
parents:
56386
diff
changeset
|
3581 for (i = 0; i <= nargs; i++) |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3582 info[i].start = -1; |
57725
c0675c413aa3
(Fformat): Allocate discarded table with SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
57644
diff
changeset
|
3583 if (!discarded) |
c0675c413aa3
(Fformat): Allocate discarded table with SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
57644
diff
changeset
|
3584 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
|
3585 bzero (discarded, SBYTES (args[0])); |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3586 } |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3587 |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3588 /* Add to TOTAL enough space to hold the converted arguments. */ |
305 | 3589 |
3590 n = 0; | |
3591 while (format != end) | |
3592 if (*format++ == '%') | |
3593 { | |
34566
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3594 int thissize = 0; |
42484
717eee813b2c
(Fformat): Update thissize from field_width
Richard M. Stallman <rms@gnu.org>
parents:
42116
diff
changeset
|
3595 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
|
3596 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
|
3597 int field_width = 0; |
34566
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3598 |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3599 /* General format specifications look like |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3600 |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3601 '%' [flags] [field-width] [precision] format |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3602 |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3603 where |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3604 |
53687
4f06a8a0e7a6
For `format', make source and documentation match.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53541
diff
changeset
|
3605 flags ::= [- #0]+ |
34566
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3606 field-width ::= [0-9]+ |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3607 precision ::= '.' [0-9]* |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3608 |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3609 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
|
3610 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
|
3611 string is shorter than field-width. |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3612 |
48764
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3613 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
|
3614 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
|
3615 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
|
3616 |
65659
71ea8ba70056
(Fformat): Explicitly test for end of format string and don't use `index'.
Richard M. Stallman <rms@gnu.org>
parents:
65608
diff
changeset
|
3617 while (format != end |
71ea8ba70056
(Fformat): Explicitly test for end of format string and don't use `index'.
Richard M. Stallman <rms@gnu.org>
parents:
65608
diff
changeset
|
3618 && (*format == '-' || *format == '0' || *format == '#' |
71ea8ba70056
(Fformat): Explicitly test for end of format string and don't use `index'.
Richard M. Stallman <rms@gnu.org>
parents:
65608
diff
changeset
|
3619 || * format == ' ')) |
34566
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3620 ++format; |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3621 |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3622 if (*format >= '0' && *format <= '9') |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3623 { |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3624 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
|
3625 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
|
3626 } |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3627 |
48764
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3628 /* 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
|
3629 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
|
3630 if (*format == '.') |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3631 { |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3632 ++format; |
48764
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3633 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
|
3634 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
|
3635 } |
305 | 3636 |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3637 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
|
3638 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
|
3639 |
23197
0d3baa5514b7
(Fformat): Detect incomplete format spec at string's end.
Karl Heuer <kwzh@gnu.org>
parents:
23166
diff
changeset
|
3640 if (format == end) |
0d3baa5514b7
(Fformat): Detect incomplete format spec at string's end.
Karl Heuer <kwzh@gnu.org>
parents:
23166
diff
changeset
|
3641 error ("Format string ends in middle of format specifier"); |
305 | 3642 if (*format == '%') |
3643 format++; | |
3644 else if (++n >= nargs) | |
12831
3917c5d131d3
(Fformat): Limit minlen to avoid stack overflow.
Richard M. Stallman <rms@gnu.org>
parents:
12623
diff
changeset
|
3645 error ("Not enough arguments for format string"); |
305 | 3646 else if (*format == 'S') |
3647 { | |
3648 /* For `S', prin1 the argument and then treat like a string. */ | |
3649 register Lisp_Object tem; | |
3650 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
|
3651 if (STRING_MULTIBYTE (tem) && ! multibyte) |
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3652 { |
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3653 multibyte = 1; |
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3654 goto retry; |
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3655 } |
305 | 3656 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
|
3657 /* 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
|
3658 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
|
3659 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
|
3660 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
|
3661 *format = 's'; |
305 | 3662 goto string; |
3663 } | |
9163
41fe5f636879
(lisp_time_argument, Finsert, Finsert_and_inherit, Finsert_before_markers,
Karl Heuer <kwzh@gnu.org>
parents:
9154
diff
changeset
|
3664 else if (SYMBOLP (args[n])) |
305 | 3665 { |
46447
8e01c92219ab
(Fstring_to_char): Don't use XSTRING/XSETSTRING to copy a lisp value.
Ken Raeburn <raeburn@raeburn.org>
parents:
46443
diff
changeset
|
3666 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
|
3667 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
|
3668 { |
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
3669 multibyte = 1; |
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
3670 goto retry; |
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
3671 } |
305 | 3672 goto string; |
3673 } | |
9163
41fe5f636879
(lisp_time_argument, Finsert, Finsert_and_inherit, Finsert_before_markers,
Karl Heuer <kwzh@gnu.org>
parents:
9154
diff
changeset
|
3674 else if (STRINGP (args[n])) |
305 | 3675 { |
3676 string: | |
6528
d0f6a386b7cb
(Fformat): Validate number and type of arguments.
Karl Heuer <kwzh@gnu.org>
parents:
6206
diff
changeset
|
3677 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
|
3678 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
|
3679 /* 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
|
3680 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
|
3681 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
|
3682 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
|
3683 actual_width = lisp_string_width (args[n], -1, NULL, NULL); |
305 | 3684 } |
3685 /* 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
|
3686 else if (INTEGERP (args[n]) && *format != 's') |
305 | 3687 { |
3591
507f64624555
Apply typo patches from Paul Eggert.
Jim Blandy <jimb@redhat.com>
parents:
3522
diff
changeset
|
3688 /* The following loop assumes the Lisp type indicates |
305 | 3689 the proper way to pass the argument. |
3690 So make sure we have a flonum if the argument should | |
3691 be a double. */ | |
3692 if (*format == 'e' || *format == 'f' || *format == 'g') | |
3693 args[n] = Ffloat (args[n]); | |
23326
df3f641c9ca1
(Fformat): Check format control characters.
Kenichi Handa <handa@m17n.org>
parents:
23292
diff
changeset
|
3694 else |
df3f641c9ca1
(Fformat): Check format control characters.
Kenichi Handa <handa@m17n.org>
parents:
23292
diff
changeset
|
3695 if (*format != 'd' && *format != 'o' && *format != 'x' |
24505 | 3696 && *format != 'i' && *format != 'X' && *format != 'c') |
23326
df3f641c9ca1
(Fformat): Check format control characters.
Kenichi Handa <handa@m17n.org>
parents:
23292
diff
changeset
|
3697 error ("Invalid format operation %%%c", *format); |
df3f641c9ca1
(Fformat): Check format control characters.
Kenichi Handa <handa@m17n.org>
parents:
23292
diff
changeset
|
3698 |
30480 | 3699 thissize = 30; |
49285
7ec1335b6d36
(Fformat): Convert an unibyte char argument that is
Kenichi Handa <handa@m17n.org>
parents:
48908
diff
changeset
|
3700 if (*format == 'c') |
21064
90bdbe2754c8
(Fformat): Format multibyte characters by "%c"
Kenichi Handa <handa@m17n.org>
parents:
21052
diff
changeset
|
3701 { |
89483 | 3702 if (! ASCII_CHAR_P (XINT (args[n])) |
49472
3fd3c5521557
(Fformat): Add comment about the treatment of 0 as a multibyte
Kenichi Handa <handa@m17n.org>
parents:
49443
diff
changeset
|
3703 /* Note: No one can remeber why we have to treat |
3fd3c5521557
(Fformat): Add comment about the treatment of 0 as a multibyte
Kenichi Handa <handa@m17n.org>
parents:
49443
diff
changeset
|
3704 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
|
3705 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
|
3706 don't change it. */ |
49285
7ec1335b6d36
(Fformat): Convert an unibyte char argument that is
Kenichi Handa <handa@m17n.org>
parents:
48908
diff
changeset
|
3707 || XINT (args[n]) == 0) |
21064
90bdbe2754c8
(Fformat): Format multibyte characters by "%c"
Kenichi Handa <handa@m17n.org>
parents:
21052
diff
changeset
|
3708 { |
49285
7ec1335b6d36
(Fformat): Convert an unibyte char argument that is
Kenichi Handa <handa@m17n.org>
parents:
48908
diff
changeset
|
3709 if (! multibyte) |
7ec1335b6d36
(Fformat): Convert an unibyte char argument that is
Kenichi Handa <handa@m17n.org>
parents:
48908
diff
changeset
|
3710 { |
7ec1335b6d36
(Fformat): Convert an unibyte char argument that is
Kenichi Handa <handa@m17n.org>
parents:
48908
diff
changeset
|
3711 multibyte = 1; |
7ec1335b6d36
(Fformat): Convert an unibyte char argument that is
Kenichi Handa <handa@m17n.org>
parents:
48908
diff
changeset
|
3712 goto retry; |
7ec1335b6d36
(Fformat): Convert an unibyte char argument that is
Kenichi Handa <handa@m17n.org>
parents:
48908
diff
changeset
|
3713 } |
7ec1335b6d36
(Fformat): Convert an unibyte char argument that is
Kenichi Handa <handa@m17n.org>
parents:
48908
diff
changeset
|
3714 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
|
3715 thissize = SBYTES (args[n]); |
21064
90bdbe2754c8
(Fformat): Format multibyte characters by "%c"
Kenichi Handa <handa@m17n.org>
parents:
21052
diff
changeset
|
3716 } |
49285
7ec1335b6d36
(Fformat): Convert an unibyte char argument that is
Kenichi Handa <handa@m17n.org>
parents:
48908
diff
changeset
|
3717 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
|
3718 { |
7ec1335b6d36
(Fformat): Convert an unibyte char argument that is
Kenichi Handa <handa@m17n.org>
parents:
48908
diff
changeset
|
3719 args[n] |
7ec1335b6d36
(Fformat): Convert an unibyte char argument that is
Kenichi Handa <handa@m17n.org>
parents:
48908
diff
changeset
|
3720 = 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
|
3721 thissize = SBYTES (args[n]); |
7ec1335b6d36
(Fformat): Convert an unibyte char argument that is
Kenichi Handa <handa@m17n.org>
parents:
48908
diff
changeset
|
3722 } |
21064
90bdbe2754c8
(Fformat): Format multibyte characters by "%c"
Kenichi Handa <handa@m17n.org>
parents:
21052
diff
changeset
|
3723 } |
305 | 3724 } |
9163
41fe5f636879
(lisp_time_argument, Finsert, Finsert_and_inherit, Finsert_before_markers,
Karl Heuer <kwzh@gnu.org>
parents:
9154
diff
changeset
|
3725 else if (FLOATP (args[n]) && *format != 's') |
305 | 3726 { |
3727 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
|
3728 { |
7ac7ca5ac550
(Fformat): Detect invalid format letters for floats.
Richard M. Stallman <rms@gnu.org>
parents:
47763
diff
changeset
|
3729 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
|
3730 && *format != 'i' && *format != 'X' && *format != 'c') |
7ac7ca5ac550
(Fformat): Detect invalid format letters for floats.
Richard M. Stallman <rms@gnu.org>
parents:
47763
diff
changeset
|
3731 error ("Invalid format operation %%%c", *format); |
7ac7ca5ac550
(Fformat): Detect invalid format letters for floats.
Richard M. Stallman <rms@gnu.org>
parents:
47763
diff
changeset
|
3732 args[n] = Ftruncate (args[n], Qnil); |
7ac7ca5ac550
(Fformat): Detect invalid format letters for floats.
Richard M. Stallman <rms@gnu.org>
parents:
47763
diff
changeset
|
3733 } |
34566
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3734 |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3735 /* 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
|
3736 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
|
3737 prints. */ |
48782
b02bdb795a5c
(Fformat): Use alloca, not _alloca.
Juanma Barranquero <lekktu@gmail.com>
parents:
48781
diff
changeset
|
3738 /* Filter out flag value of -1. */ |
48908 | 3739 thissize = (MAX_10_EXP + 100 |
3740 + (precision[n] > 0 ? precision[n] : 0)); | |
305 | 3741 } |
3742 else | |
3743 { | |
3744 /* Anything but a string, convert to a string using princ. */ | |
3745 register Lisp_Object tem; | |
3746 tem = Fprin1_to_string (args[n], Qt); | |
53541
41ceb9298a4e
(Fformat): Fix '&' to '&&'.
Kenichi Handa <handa@m17n.org>
parents:
52451
diff
changeset
|
3747 if (STRING_MULTIBYTE (tem) && ! multibyte) |
20826
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3748 { |
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3749 multibyte = 1; |
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3750 goto retry; |
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3751 } |
305 | 3752 args[n] = tem; |
3753 goto string; | |
3754 } | |
30480 | 3755 |
42484
717eee813b2c
(Fformat): Update thissize from field_width
Richard M. Stallman <rms@gnu.org>
parents:
42116
diff
changeset
|
3756 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
|
3757 total += thissize + 4; |
305 | 3758 } |
3759 | |
50746
2a57a6e6b390
(Fformat): Set abort_on_gc during first scan of format.
Richard M. Stallman <rms@gnu.org>
parents:
50555
diff
changeset
|
3760 abort_on_gc--; |
2a57a6e6b390
(Fformat): Set abort_on_gc during first scan of format.
Richard M. Stallman <rms@gnu.org>
parents:
50555
diff
changeset
|
3761 |
20826
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3762 /* 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
|
3763 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
|
3764 |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3765 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
|
3766 |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3767 /* 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
|
3768 Note that TOTAL is an overestimate. */ |
56194
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
3769 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
|
3770 |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3771 p = buf; |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3772 nchars = 0; |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3773 n = 0; |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3774 |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3775 /* 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
|
3776 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
|
3777 format_start = format; |
2a57a6e6b390
(Fformat): Set abort_on_gc during first scan of format.
Richard M. Stallman <rms@gnu.org>
parents:
50555
diff
changeset
|
3778 end = format + SBYTES (args[0]); |
22698
ea6ef56295b4
(Fformat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents:
22669
diff
changeset
|
3779 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
|
3780 while (format != end) |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3781 { |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3782 if (*format == '%') |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3783 { |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3784 int minlen; |
21225
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3785 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
|
3786 unsigned char *this_format_start = format; |
305 | 3787 |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3788 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
|
3789 format++; |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3790 |
53687
4f06a8a0e7a6
For `format', make source and documentation match.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53541
diff
changeset
|
3791 while (index("-0# ", *format)) |
4f06a8a0e7a6
For `format', make source and documentation match.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53541
diff
changeset
|
3792 { |
4f06a8a0e7a6
For `format', make source and documentation match.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53541
diff
changeset
|
3793 if (*format == '-') |
4f06a8a0e7a6
For `format', make source and documentation match.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53541
diff
changeset
|
3794 { |
4f06a8a0e7a6
For `format', make source and documentation match.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53541
diff
changeset
|
3795 negative = 1; |
4f06a8a0e7a6
For `format', make source and documentation match.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53541
diff
changeset
|
3796 } |
4f06a8a0e7a6
For `format', make source and documentation match.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53541
diff
changeset
|
3797 discarded[format - format_start] = 1; |
4f06a8a0e7a6
For `format', make source and documentation match.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53541
diff
changeset
|
3798 ++format; |
4f06a8a0e7a6
For `format', make source and documentation match.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53541
diff
changeset
|
3799 } |
4f06a8a0e7a6
For `format', make source and documentation match.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53541
diff
changeset
|
3800 |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3801 minlen = atoi (format); |
53687
4f06a8a0e7a6
For `format', make source and documentation match.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53541
diff
changeset
|
3802 |
4f06a8a0e7a6
For `format', make source and documentation match.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53541
diff
changeset
|
3803 while ((*format >= '0' && *format <= '9') || *format == '.') |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3804 { |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3805 discarded[format - format_start] = 1; |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3806 format++; |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3807 } |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3808 |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3809 if (*format++ == '%') |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3810 { |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3811 *p++ = '%'; |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3812 nchars++; |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3813 continue; |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3814 } |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3815 |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3816 ++n; |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3817 |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3818 discarded[format - format_start - 1] = 1; |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3819 info[n].start = nchars; |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3820 |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3821 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
|
3822 { |
48764
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3823 /* 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
|
3824 |
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3825 int width, padding; |
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3826 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
|
3827 int nchars_string; |
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3828 |
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3829 /* 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
|
3830 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
|
3831 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
|
3832 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
|
3833 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
|
3834 |
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3835 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
|
3836 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
|
3837 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
|
3838 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
|
3839 else |
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3840 { /* 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
|
3841 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
|
3842 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
|
3843 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
|
3844 } |
21225
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3845 |
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3846 /* 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
|
3847 padding = minlen - width; |
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3848 if (! negative) |
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3849 while (padding-- > 0) |
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3850 { |
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3851 *p++ = ' '; |
35461
f0f0e9179ed6
(Fformat): Don't extend text properties from arguments
Gerd Moellmann <gerd@gnu.org>
parents:
35440
diff
changeset
|
3852 ++nchars; |
21225
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3853 } |
305 | 3854 |
66500
8392b2926dd8
(Fformat): Don't include string padding
Richard M. Stallman <rms@gnu.org>
parents:
66379
diff
changeset
|
3855 info[n].start = start = nchars; |
48764
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3856 nchars += nchars_string; |
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3857 end = nchars; |
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3858 |
22698
ea6ef56295b4
(Fformat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents:
22669
diff
changeset
|
3859 if (p > buf |
ea6ef56295b4
(Fformat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents:
22669
diff
changeset
|
3860 && multibyte |
22712
6f129ed55108
(Fformat): Replace explicit numeric constants with proper macros.
Kenichi Handa <handa@m17n.org>
parents:
22698
diff
changeset
|
3861 && !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
|
3862 && 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
|
3863 && !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
|
3864 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
|
3865 |
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3866 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
|
3867 nbytes, |
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3868 STRING_MULTIBYTE (args[n]), multibyte); |
305 | 3869 |
66500
8392b2926dd8
(Fformat): Don't include string padding
Richard M. Stallman <rms@gnu.org>
parents:
66379
diff
changeset
|
3870 info[n].end = nchars; |
8392b2926dd8
(Fformat): Don't include string padding
Richard M. Stallman <rms@gnu.org>
parents:
66379
diff
changeset
|
3871 |
21225
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3872 if (negative) |
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3873 while (padding-- > 0) |
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3874 { |
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3875 *p++ = ' '; |
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3876 nchars++; |
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3877 } |
25018 | 3878 |
3879 /* If this argument has text properties, record where | |
3880 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
|
3881 if (STRING_INTERVALS (args[n])) |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3882 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
|
3883 } |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3884 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
|
3885 { |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3886 int this_nchars; |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3887 |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3888 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
|
3889 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
|
3890 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
|
3891 |
21202
ef954087e7b9
(Fformat): Properly print floats.
Richard M. Stallman <rms@gnu.org>
parents:
21200
diff
changeset
|
3892 if (INTEGERP (args[n])) |
72584
ad48859287a7
(Fformat): Don't sign-extend for %o or %x.
Richard M. Stallman <rms@gnu.org>
parents:
72531
diff
changeset
|
3893 { |
ad48859287a7
(Fformat): Don't sign-extend for %o or %x.
Richard M. Stallman <rms@gnu.org>
parents:
72531
diff
changeset
|
3894 if (format[-1] == 'd') |
ad48859287a7
(Fformat): Don't sign-extend for %o or %x.
Richard M. Stallman <rms@gnu.org>
parents:
72531
diff
changeset
|
3895 sprintf (p, this_format, XINT (args[n])); |
ad48859287a7
(Fformat): Don't sign-extend for %o or %x.
Richard M. Stallman <rms@gnu.org>
parents:
72531
diff
changeset
|
3896 /* Don't sign-extend for octal or hex printing. */ |
ad48859287a7
(Fformat): Don't sign-extend for %o or %x.
Richard M. Stallman <rms@gnu.org>
parents:
72531
diff
changeset
|
3897 else |
ad48859287a7
(Fformat): Don't sign-extend for %o or %x.
Richard M. Stallman <rms@gnu.org>
parents:
72531
diff
changeset
|
3898 sprintf (p, this_format, XUINT (args[n])); |
ad48859287a7
(Fformat): Don't sign-extend for %o or %x.
Richard M. Stallman <rms@gnu.org>
parents:
72531
diff
changeset
|
3899 } |
21202
ef954087e7b9
(Fformat): Properly print floats.
Richard M. Stallman <rms@gnu.org>
parents:
21200
diff
changeset
|
3900 else |
25662
0a7261c1d487
Use XCAR, XCDR, and XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25656
diff
changeset
|
3901 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
|
3902 |
22698
ea6ef56295b4
(Fformat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents:
22669
diff
changeset
|
3903 if (p > buf |
ea6ef56295b4
(Fformat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents:
22669
diff
changeset
|
3904 && multibyte |
22712
6f129ed55108
(Fformat): Replace explicit numeric constants with proper macros.
Kenichi Handa <handa@m17n.org>
parents:
22698
diff
changeset
|
3905 && !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
|
3906 && !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
|
3907 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
|
3908 this_nchars = strlen (p); |
29008
939760ef7379
(Fformat): Be sure to convert 8-bit characters to
Kenichi Handa <handa@m17n.org>
parents:
28545
diff
changeset
|
3909 if (multibyte) |
56194
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
3910 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
|
3911 else |
939760ef7379
(Fformat): Be sure to convert 8-bit characters to
Kenichi Handa <handa@m17n.org>
parents:
28545
diff
changeset
|
3912 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
|
3913 nchars += this_nchars; |
66500
8392b2926dd8
(Fformat): Don't include string padding
Richard M. Stallman <rms@gnu.org>
parents:
66379
diff
changeset
|
3914 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
|
3915 } |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3916 |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3917 } |
20861
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
3918 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
|
3919 { |
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
3920 /* Copy a whole multibyte character. */ |
22698
ea6ef56295b4
(Fformat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents:
22669
diff
changeset
|
3921 if (p > buf |
ea6ef56295b4
(Fformat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents:
22669
diff
changeset
|
3922 && multibyte |
22712
6f129ed55108
(Fformat): Replace explicit numeric constants with proper macros.
Kenichi Handa <handa@m17n.org>
parents:
22698
diff
changeset
|
3923 && !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
|
3924 && !CHAR_HEAD_P (*format)) |
22698
ea6ef56295b4
(Fformat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents:
22669
diff
changeset
|
3925 maybe_combine_byte = 1; |
20861
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
3926 *p++ = *format++; |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3927 while (! CHAR_HEAD_P (*format)) |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3928 { |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3929 discarded[format - format_start] = 2; |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3930 *p++ = *format++; |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3931 } |
20861
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
3932 nchars++; |
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
3933 } |
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
3934 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
|
3935 { |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3936 /* 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
|
3937 int len = copy_text (format, p, 1, 0, 1); |
305 | 3938 |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3939 p += len; |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3940 format++; |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3941 nchars++; |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3942 } |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3943 else |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3944 *p++ = *format++, nchars++; |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3945 } |
305 | 3946 |
56194
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
3947 if (p > buf + total) |
34566
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3948 abort (); |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3949 |
22698
ea6ef56295b4
(Fformat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents:
22669
diff
changeset
|
3950 if (maybe_combine_byte) |
ea6ef56295b4
(Fformat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents:
22669
diff
changeset
|
3951 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
|
3952 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
|
3953 |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3954 /* 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
|
3955 SAFE_FREE (); |
305 | 3956 |
25018 | 3957 /* If the format string has text properties, or any of the string |
3958 arguments has text properties, set up text properties of the | |
3959 result string. */ | |
30480 | 3960 |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3961 if (STRING_INTERVALS (args[0]) || arg_intervals) |
25018 | 3962 { |
3963 Lisp_Object len, new_len, props; | |
3964 struct gcpro gcpro1; | |
30480 | 3965 |
25018 | 3966 /* 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
|
3967 len = make_number (SCHARS (args[0])); |
25018 | 3968 props = text_property_list (args[0], make_number (0), len, Qnil); |
3969 GCPRO1 (props); | |
30480 | 3970 |
25018 | 3971 if (CONSP (props)) |
3972 { | |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3973 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
|
3974 Lisp_Object list; |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3975 |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3976 /* Adjust the bounds of each text property |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3977 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
|
3978 |
d2baef38bbd7
(Fformat): Handle format strings with multiple text
Kim F. Storm <storm@cua.dk>
parents:
56560
diff
changeset
|
3979 /* 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
|
3980 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
|
3981 space of the format string. */ |
d2baef38bbd7
(Fformat): Handle format strings with multiple text
Kim F. Storm <storm@cua.dk>
parents:
56560
diff
changeset
|
3982 props = Fnreverse (props); |
d2baef38bbd7
(Fformat): Handle format strings with multiple text
Kim F. Storm <storm@cua.dk>
parents:
56560
diff
changeset
|
3983 |
d2baef38bbd7
(Fformat): Handle format strings with multiple text
Kim F. Storm <storm@cua.dk>
parents:
56560
diff
changeset
|
3984 /* 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
|
3985 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
|
3986 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
|
3987 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
|
3988 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
|
3989 { |
50555
37d227b879ad
(Fformat): Lisp_Object/int mixup.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50499
diff
changeset
|
3990 Lisp_Object item; |
37d227b879ad
(Fformat): Lisp_Object/int mixup.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50499
diff
changeset
|
3991 int pos; |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3992 |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3993 item = XCAR (list); |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3994 |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3995 /* First adjust the property start position. */ |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3996 pos = XINT (XCAR (item)); |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3997 |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3998 /* Advance BYTEPOS, POSITION, TRANSLATED and ARGN |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3999 up to this position. */ |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4000 for (; position < pos; bytepos++) |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4001 { |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4002 if (! discarded[bytepos]) |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4003 position++, translated++; |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4004 else if (discarded[bytepos] == 1) |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4005 { |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4006 position++; |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4007 if (translated == info[argn].start) |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4008 { |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4009 translated += info[argn].end - info[argn].start; |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4010 argn++; |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4011 } |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4012 } |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4013 } |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4014 |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4015 XSETCAR (item, make_number (translated)); |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4016 |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4017 /* Likewise adjust the property end position. */ |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4018 pos = XINT (XCAR (XCDR (item))); |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4019 |
71865
47930f9fbcdf
(Fformat): Fix calculation of text property positions
Kenichi Handa <handa@m17n.org>
parents:
71832
diff
changeset
|
4020 for (; position < pos; bytepos++) |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4021 { |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4022 if (! discarded[bytepos]) |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4023 position++, translated++; |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4024 else if (discarded[bytepos] == 1) |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4025 { |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4026 position++; |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4027 if (translated == info[argn].start) |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4028 { |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4029 translated += info[argn].end - info[argn].start; |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4030 argn++; |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4031 } |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4032 } |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4033 } |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4034 |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4035 XSETCAR (XCDR (item), make_number (translated)); |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4036 } |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4037 |
25018 | 4038 add_text_properties_from_list (val, props, make_number (0)); |
4039 } | |
4040 | |
4041 /* Add text properties from arguments. */ | |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4042 if (arg_intervals) |
25018 | 4043 for (n = 1; n < nargs; ++n) |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4044 if (info[n].intervals) |
25018 | 4045 { |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
4046 len = make_number (SCHARS (args[n])); |
25018 | 4047 new_len = make_number (info[n].end - info[n].start); |
4048 props = text_property_list (args[n], make_number (0), len, Qnil); | |
4049 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
|
4050 /* 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
|
4051 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
|
4052 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
|
4053 make_composition_value_copy (props); |
25018 | 4054 add_text_properties_from_list (val, props, |
4055 make_number (info[n].start)); | |
4056 } | |
4057 | |
4058 UNGCPRO; | |
4059 } | |
4060 | |
20804
14fa73136e64
(CONVERTED_BYTE_SIZE): Fix the logic.
Kenichi Handa <handa@m17n.org>
parents:
20706
diff
changeset
|
4061 return val; |
305 | 4062 } |
4063 | |
4064 Lisp_Object | |
49443
f9f7612c767a
(format2): New function, replaces format1
Richard M. Stallman <rms@gnu.org>
parents:
49293
diff
changeset
|
4065 format2 (string1, arg0, arg1) |
305 | 4066 char *string1; |
49443
f9f7612c767a
(format2): New function, replaces format1
Richard M. Stallman <rms@gnu.org>
parents:
49293
diff
changeset
|
4067 Lisp_Object arg0, arg1; |
305 | 4068 { |
49443
f9f7612c767a
(format2): New function, replaces format1
Richard M. Stallman <rms@gnu.org>
parents:
49293
diff
changeset
|
4069 Lisp_Object args[3]; |
f9f7612c767a
(format2): New function, replaces format1
Richard M. Stallman <rms@gnu.org>
parents:
49293
diff
changeset
|
4070 args[0] = build_string (string1); |
f9f7612c767a
(format2): New function, replaces format1
Richard M. Stallman <rms@gnu.org>
parents:
49293
diff
changeset
|
4071 args[1] = arg0; |
f9f7612c767a
(format2): New function, replaces format1
Richard M. Stallman <rms@gnu.org>
parents:
49293
diff
changeset
|
4072 args[2] = arg1; |
f9f7612c767a
(format2): New function, replaces format1
Richard M. Stallman <rms@gnu.org>
parents:
49293
diff
changeset
|
4073 return Fformat (3, args); |
305 | 4074 } |
4075 | |
4076 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
|
4077 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
|
4078 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
|
4079 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
|
4080 (c1, c2) |
305 | 4081 register Lisp_Object c1, c2; |
4082 { | |
20688
16c458803c32
(Fchar_equal): Fix case-conversion code.
Richard M. Stallman <rms@gnu.org>
parents:
20606
diff
changeset
|
4083 int i1, i2; |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
4084 CHECK_NUMBER (c1); |
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
4085 CHECK_NUMBER (c2); |
305 | 4086 |
20688
16c458803c32
(Fchar_equal): Fix case-conversion code.
Richard M. Stallman <rms@gnu.org>
parents:
20606
diff
changeset
|
4087 if (XINT (c1) == XINT (c2)) |
305 | 4088 return Qt; |
20688
16c458803c32
(Fchar_equal): Fix case-conversion code.
Richard M. Stallman <rms@gnu.org>
parents:
20606
diff
changeset
|
4089 if (NILP (current_buffer->case_fold_search)) |
16c458803c32
(Fchar_equal): Fix case-conversion code.
Richard M. Stallman <rms@gnu.org>
parents:
20606
diff
changeset
|
4090 return Qnil; |
16c458803c32
(Fchar_equal): Fix case-conversion code.
Richard M. Stallman <rms@gnu.org>
parents:
20606
diff
changeset
|
4091 |
16c458803c32
(Fchar_equal): Fix case-conversion code.
Richard M. Stallman <rms@gnu.org>
parents:
20606
diff
changeset
|
4092 /* Do these in separate statements, |
16c458803c32
(Fchar_equal): Fix case-conversion code.
Richard M. Stallman <rms@gnu.org>
parents:
20606
diff
changeset
|
4093 then compare the variables. |
16c458803c32
(Fchar_equal): Fix case-conversion code.
Richard M. Stallman <rms@gnu.org>
parents:
20606
diff
changeset
|
4094 because of the way DOWNCASE uses temp variables. */ |
89025
1c45126c0974
(Fchar_equal): Fix for the unibyte case.
Kenichi Handa <handa@m17n.org>
parents:
89009
diff
changeset
|
4095 i1 = XFASTINT (c1); |
1c45126c0974
(Fchar_equal): Fix for the unibyte case.
Kenichi Handa <handa@m17n.org>
parents:
89009
diff
changeset
|
4096 if (NILP (current_buffer->enable_multibyte_characters) |
1c45126c0974
(Fchar_equal): Fix for the unibyte case.
Kenichi Handa <handa@m17n.org>
parents:
89009
diff
changeset
|
4097 && ! ASCII_CHAR_P (i1)) |
1c45126c0974
(Fchar_equal): Fix for the unibyte case.
Kenichi Handa <handa@m17n.org>
parents:
89009
diff
changeset
|
4098 { |
1c45126c0974
(Fchar_equal): Fix for the unibyte case.
Kenichi Handa <handa@m17n.org>
parents:
89009
diff
changeset
|
4099 MAKE_CHAR_MULTIBYTE (i1); |
1c45126c0974
(Fchar_equal): Fix for the unibyte case.
Kenichi Handa <handa@m17n.org>
parents:
89009
diff
changeset
|
4100 } |
1c45126c0974
(Fchar_equal): Fix for the unibyte case.
Kenichi Handa <handa@m17n.org>
parents:
89009
diff
changeset
|
4101 i2 = XFASTINT (c2); |
1c45126c0974
(Fchar_equal): Fix for the unibyte case.
Kenichi Handa <handa@m17n.org>
parents:
89009
diff
changeset
|
4102 if (NILP (current_buffer->enable_multibyte_characters) |
1c45126c0974
(Fchar_equal): Fix for the unibyte case.
Kenichi Handa <handa@m17n.org>
parents:
89009
diff
changeset
|
4103 && ! ASCII_CHAR_P (i2)) |
1c45126c0974
(Fchar_equal): Fix for the unibyte case.
Kenichi Handa <handa@m17n.org>
parents:
89009
diff
changeset
|
4104 { |
1c45126c0974
(Fchar_equal): Fix for the unibyte case.
Kenichi Handa <handa@m17n.org>
parents:
89009
diff
changeset
|
4105 MAKE_CHAR_MULTIBYTE (i2); |
1c45126c0974
(Fchar_equal): Fix for the unibyte case.
Kenichi Handa <handa@m17n.org>
parents:
89009
diff
changeset
|
4106 } |
1c45126c0974
(Fchar_equal): Fix for the unibyte case.
Kenichi Handa <handa@m17n.org>
parents:
89009
diff
changeset
|
4107 i1 = DOWNCASE (i1); |
1c45126c0974
(Fchar_equal): Fix for the unibyte case.
Kenichi Handa <handa@m17n.org>
parents:
89009
diff
changeset
|
4108 i2 = DOWNCASE (i2); |
20688
16c458803c32
(Fchar_equal): Fix case-conversion code.
Richard M. Stallman <rms@gnu.org>
parents:
20606
diff
changeset
|
4109 return (i1 == i2 ? Qt : Qnil); |
305 | 4110 } |
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 /* 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
|
4113 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
|
4114 differ in size). |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4115 |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
4116 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
|
4117 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
|
4118 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
|
4119 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
|
4120 |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4121 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
|
4122 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
|
4123 rest untouched. Most of this is copied from adjust_markers in insdel.c. |
30480 | 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 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
|
4126 |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
4127 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
|
4128 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
|
4129 start1_byte, end1_byte, start2_byte, end2_byte) |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4130 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
|
4131 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
|
4132 { |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
4133 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
|
4134 register struct Lisp_Marker *marker; |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4135 |
7862
0b6f46029ea2
(transpose_markers): Allow for gap at start of region.
Karl Heuer <kwzh@gnu.org>
parents:
7710
diff
changeset
|
4136 /* 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
|
4137 if (PT < start1) |
987ab382275c
(Ftranspose_regions): Fix overlays after moving markers.
Karl Heuer <kwzh@gnu.org>
parents:
7506
diff
changeset
|
4138 ; |
987ab382275c
(Ftranspose_regions): Fix overlays after moving markers.
Karl Heuer <kwzh@gnu.org>
parents:
7506
diff
changeset
|
4139 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
|
4140 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
|
4141 PT_BYTE + (end2_byte - end1_byte)); |
7519
987ab382275c
(Ftranspose_regions): Fix overlays after moving markers.
Karl Heuer <kwzh@gnu.org>
parents:
7506
diff
changeset
|
4142 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
|
4143 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
|
4144 (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
|
4145 - (end1_byte - start1_byte))); |
7519
987ab382275c
(Ftranspose_regions): Fix overlays after moving markers.
Karl Heuer <kwzh@gnu.org>
parents:
7506
diff
changeset
|
4146 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
|
4147 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
|
4148 PT_BYTE - (start2_byte - start1_byte)); |
7519
987ab382275c
(Ftranspose_regions): Fix overlays after moving markers.
Karl Heuer <kwzh@gnu.org>
parents:
7506
diff
changeset
|
4149 |
7862
0b6f46029ea2
(transpose_markers): Allow for gap at start of region.
Karl Heuer <kwzh@gnu.org>
parents:
7710
diff
changeset
|
4150 /* 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
|
4151 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
|
4152 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
|
4153 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
|
4154 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
|
4155 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
|
4156 the dirty work to Fmarker_position, below. */ |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4157 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4158 /* The difference between the region's lengths */ |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4159 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
|
4160 diff_byte = (end2_byte - start2_byte) - (end1_byte - start1_byte); |
30480 | 4161 |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4162 /* 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
|
4163 region plus the distance between the regions. */ |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4164 amt1 = (end2 - start2) + (start2 - end1); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4165 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
|
4166 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
|
4167 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
|
4168 |
51670
beceb827c1ce
(save_excursion_restore, transpose_markers): Update for new types.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
51042
diff
changeset
|
4169 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
|
4170 { |
51670
beceb827c1ce
(save_excursion_restore, transpose_markers): Update for new types.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
51042
diff
changeset
|
4171 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
|
4172 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
|
4173 { |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
4174 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
|
4175 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
|
4176 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
|
4177 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
|
4178 else |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
4179 mpos -= amt2_byte; |
51670
beceb827c1ce
(save_excursion_restore, transpose_markers): Update for new types.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
51042
diff
changeset
|
4180 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
|
4181 } |
51670
beceb827c1ce
(save_excursion_restore, transpose_markers): Update for new types.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
51042
diff
changeset
|
4182 mpos = marker->charpos; |
7862
0b6f46029ea2
(transpose_markers): Allow for gap at start of region.
Karl Heuer <kwzh@gnu.org>
parents:
7710
diff
changeset
|
4183 if (mpos >= start1 && mpos < end2) |
0b6f46029ea2
(transpose_markers): Allow for gap at start of region.
Karl Heuer <kwzh@gnu.org>
parents:
7710
diff
changeset
|
4184 { |
0b6f46029ea2
(transpose_markers): Allow for gap at start of region.
Karl Heuer <kwzh@gnu.org>
parents:
7710
diff
changeset
|
4185 if (mpos < end1) |
0b6f46029ea2
(transpose_markers): Allow for gap at start of region.
Karl Heuer <kwzh@gnu.org>
parents:
7710
diff
changeset
|
4186 mpos += amt1; |
0b6f46029ea2
(transpose_markers): Allow for gap at start of region.
Karl Heuer <kwzh@gnu.org>
parents:
7710
diff
changeset
|
4187 else if (mpos < start2) |
0b6f46029ea2
(transpose_markers): Allow for gap at start of region.
Karl Heuer <kwzh@gnu.org>
parents:
7710
diff
changeset
|
4188 mpos += diff; |
0b6f46029ea2
(transpose_markers): Allow for gap at start of region.
Karl Heuer <kwzh@gnu.org>
parents:
7710
diff
changeset
|
4189 else |
0b6f46029ea2
(transpose_markers): Allow for gap at start of region.
Karl Heuer <kwzh@gnu.org>
parents:
7710
diff
changeset
|
4190 mpos -= amt2; |
0b6f46029ea2
(transpose_markers): Allow for gap at start of region.
Karl Heuer <kwzh@gnu.org>
parents:
7710
diff
changeset
|
4191 } |
51670
beceb827c1ce
(save_excursion_restore, transpose_markers): Update for new types.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
51042
diff
changeset
|
4192 marker->charpos = mpos; |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4193 } |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4194 } |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4195 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4196 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
|
4197 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
|
4198 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
|
4199 never changed in a transposition. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
4200 |
55972
db2480202623
(Fuser_login_name, Ffloat_time, Fencode_time, Fcurrent_time_string)
Juanma Barranquero <lekktu@gmail.com>
parents:
55424
diff
changeset
|
4201 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
|
4202 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
|
4203 |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
4204 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
|
4205 (startr1, endr1, startr2, endr2, leave_markers) |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4206 Lisp_Object startr1, endr1, startr2, endr2, leave_markers; |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4207 { |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
4208 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
|
4209 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
|
4210 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
|
4211 unsigned char *start1_addr, *start2_addr, *temp; |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4212 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4213 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
|
4214 cur_intv = BUF_INTERVALS (current_buffer); |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4215 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4216 validate_region (&startr1, &endr1); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4217 validate_region (&startr2, &endr2); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4218 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4219 start1 = XFASTINT (startr1); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4220 end1 = XFASTINT (endr1); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4221 start2 = XFASTINT (startr2); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4222 end2 = XFASTINT (endr2); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4223 gap = GPT; |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4224 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4225 /* Swap the regions if they're reversed. */ |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4226 if (start2 < end1) |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4227 { |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4228 register int glumph = start1; |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4229 start1 = start2; |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4230 start2 = glumph; |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4231 glumph = end1; |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4232 end1 = end2; |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4233 end2 = glumph; |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4234 } |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4235 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4236 len1 = end1 - start1; |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4237 len2 = end2 - start2; |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4238 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4239 if (start2 < end1) |
21245
6cde55b7c9de
Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents:
21235
diff
changeset
|
4240 error ("Transposed regions overlap"); |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4241 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
|
4242 error ("Transposed region has length 0"); |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4243 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4244 /* The possibilities are: |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4245 1. Adjacent (contiguous) regions, or separate but equal regions |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4246 (no, really equal, in this case!), or |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4247 2. Separate regions of unequal size. |
30480 | 4248 |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4249 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
|
4250 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
|
4251 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
|
4252 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
|
4253 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4254 /* 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
|
4255 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
|
4256 around it if necessary. This would be extremely efficient, |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4257 especially considering that people are likely to do |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4258 transpositions near where they are working interactively, which |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4259 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
|
4260 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
|
4261 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
|
4262 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
|
4263 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
|
4264 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
|
4265 |
67bb3bb1b62d
(Ftranspose_regions): Take addresses only after move gap.
Richard M. Stallman <rms@gnu.org>
parents:
7207
diff
changeset
|
4266 /* 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
|
4267 we will operate on. */ |
67bb3bb1b62d
(Ftranspose_regions): Take addresses only after move gap.
Richard M. Stallman <rms@gnu.org>
parents:
7207
diff
changeset
|
4268 if (start1 < gap && gap < end2) |
67bb3bb1b62d
(Ftranspose_regions): Take addresses only after move gap.
Richard M. Stallman <rms@gnu.org>
parents:
7207
diff
changeset
|
4269 { |
67bb3bb1b62d
(Ftranspose_regions): Take addresses only after move gap.
Richard M. Stallman <rms@gnu.org>
parents:
7207
diff
changeset
|
4270 if (gap - start1 < end2 - gap) |
67bb3bb1b62d
(Ftranspose_regions): Take addresses only after move gap.
Richard M. Stallman <rms@gnu.org>
parents:
7207
diff
changeset
|
4271 move_gap (start1); |
67bb3bb1b62d
(Ftranspose_regions): Take addresses only after move gap.
Richard M. Stallman <rms@gnu.org>
parents:
7207
diff
changeset
|
4272 else |
67bb3bb1b62d
(Ftranspose_regions): Take addresses only after move gap.
Richard M. Stallman <rms@gnu.org>
parents:
7207
diff
changeset
|
4273 move_gap (end2); |
67bb3bb1b62d
(Ftranspose_regions): Take addresses only after move gap.
Richard M. Stallman <rms@gnu.org>
parents:
7207
diff
changeset
|
4274 } |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
4275 |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
4276 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
|
4277 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
|
4278 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
|
4279 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
|
4280 |
29008
939760ef7379
(Fformat): Be sure to convert 8-bit characters to
Kenichi Handa <handa@m17n.org>
parents:
28545
diff
changeset
|
4281 #ifdef BYTE_COMBINING_DEBUG |
21245
6cde55b7c9de
Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents:
21235
diff
changeset
|
4282 if (end1 == start2) |
6cde55b7c9de
Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents:
21235
diff
changeset
|
4283 { |
29008
939760ef7379
(Fformat): Be sure to convert 8-bit characters to
Kenichi Handa <handa@m17n.org>
parents:
28545
diff
changeset
|
4284 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
|
4285 len2_byte, start1, start1_byte) |
939760ef7379
(Fformat): Be sure to convert 8-bit characters to
Kenichi Handa <handa@m17n.org>
parents:
28545
diff
changeset
|
4286 || 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
|
4287 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
|
4288 || 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
|
4289 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
|
4290 abort (); |
21245
6cde55b7c9de
Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents:
21235
diff
changeset
|
4291 } |
6cde55b7c9de
Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents:
21235
diff
changeset
|
4292 else |
6cde55b7c9de
Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents:
21235
diff
changeset
|
4293 { |
29008
939760ef7379
(Fformat): Be sure to convert 8-bit characters to
Kenichi Handa <handa@m17n.org>
parents:
28545
diff
changeset
|
4294 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
|
4295 len2_byte, start1, start1_byte) |
939760ef7379
(Fformat): Be sure to convert 8-bit characters to
Kenichi Handa <handa@m17n.org>
parents:
28545
diff
changeset
|
4296 || 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
|
4297 len1_byte, start2, start2_byte) |
939760ef7379
(Fformat): Be sure to convert 8-bit characters to
Kenichi Handa <handa@m17n.org>
parents:
28545
diff
changeset
|
4298 || 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
|
4299 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
|
4300 || 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
|
4301 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
|
4302 abort (); |
21245
6cde55b7c9de
Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents:
21235
diff
changeset
|
4303 } |
29008
939760ef7379
(Fformat): Be sure to convert 8-bit characters to
Kenichi Handa <handa@m17n.org>
parents:
28545
diff
changeset
|
4304 #endif |
939760ef7379
(Fformat): Be sure to convert 8-bit characters to
Kenichi Handa <handa@m17n.org>
parents:
28545
diff
changeset
|
4305 |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4306 /* 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
|
4307 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
|
4308 allocation... interesting. Later, don't fool with it now. */ |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4309 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4310 /* Working without memmove, for portability (sigh), so must be |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4311 careful of overlapping subsections of the array... */ |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4312 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4313 if (end1 == start2) /* adjacent regions */ |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4314 { |
72592
f6de516bbb4b
* buffer.h (struct buffer_text): New field chars_modiff.
Chong Yidong <cyd@stupidchicken.com>
parents:
72584
diff
changeset
|
4315 modify_region (current_buffer, start1, end2, 0); |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4316 record_change (start1, len1 + len2); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4317 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4318 tmp_interval1 = copy_intervals (cur_intv, start1, len1); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4319 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
|
4320 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
|
4321 Qnil, Qnil); |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4322 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4323 /* 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
|
4324 if (len1_byte < len2_byte) |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4325 { |
56194
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
4326 USE_SAFE_ALLOCA; |
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
4327 |
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
4328 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
|
4329 |
0b6f46029ea2
(transpose_markers): Allow for gap at start of region.
Karl Heuer <kwzh@gnu.org>
parents:
7710
diff
changeset
|
4330 /* 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
|
4331 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
|
4332 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
|
4333 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
|
4334 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
|
4335 |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
4336 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
|
4337 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
|
4338 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
|
4339 SAFE_FREE (); |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4340 } |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4341 else |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4342 /* First region not smaller than second. */ |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4343 { |
56194
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
4344 USE_SAFE_ALLOCA; |
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
4345 |
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
4346 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
|
4347 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
|
4348 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
|
4349 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
|
4350 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
|
4351 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
|
4352 SAFE_FREE (); |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4353 } |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4354 graft_intervals_into_buffer (tmp_interval1, start1 + len2, |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4355 len1, current_buffer, 0); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4356 graft_intervals_into_buffer (tmp_interval2, start1, |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4357 len2, current_buffer, 0); |
26853
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
4358 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
|
4359 update_compositions (start1 + len2, end2, CHECK_TAIL); |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4360 } |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4361 /* Non-adjacent regions, because end1 != start2, bleagh... */ |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4362 else |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4363 { |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
4364 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
|
4365 |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
4366 if (len1_byte == len2_byte) |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4367 /* Regions are same size, though, how nice. */ |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4368 { |
56194
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
4369 USE_SAFE_ALLOCA; |
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
4370 |
72592
f6de516bbb4b
* buffer.h (struct buffer_text): New field chars_modiff.
Chong Yidong <cyd@stupidchicken.com>
parents:
72584
diff
changeset
|
4371 modify_region (current_buffer, start1, end1, 0); |
f6de516bbb4b
* buffer.h (struct buffer_text): New field chars_modiff.
Chong Yidong <cyd@stupidchicken.com>
parents:
72584
diff
changeset
|
4372 modify_region (current_buffer, start2, end2, 0); |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4373 record_change (start1, len1); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4374 record_change (start2, len2); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4375 tmp_interval1 = copy_intervals (cur_intv, start1, len1); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4376 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
|
4377 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
|
4378 Qnil, Qnil); |
192b3ebd108e
(Fcurrent_time_zone): Convert Fmake_list argument to Lisp_Integer.
Richard M. Stallman <rms@gnu.org>
parents:
18661
diff
changeset
|
4379 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
|
4380 Qnil, Qnil); |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4381 |
56194
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
4382 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
|
4383 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
|
4384 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
|
4385 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
|
4386 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
|
4387 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
|
4388 SAFE_FREE (); |
56194
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
4389 |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4390 graft_intervals_into_buffer (tmp_interval1, start2, |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4391 len1, current_buffer, 0); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4392 graft_intervals_into_buffer (tmp_interval2, start1, |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4393 len2, current_buffer, 0); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4394 } |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4395 |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
4396 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
|
4397 /* 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
|
4398 { |
56194
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
4399 USE_SAFE_ALLOCA; |
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
4400 |
72592
f6de516bbb4b
* buffer.h (struct buffer_text): New field chars_modiff.
Chong Yidong <cyd@stupidchicken.com>
parents:
72584
diff
changeset
|
4401 modify_region (current_buffer, start1, end2, 0); |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4402 record_change (start1, (end2 - start1)); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4403 tmp_interval1 = copy_intervals (cur_intv, start1, len1); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4404 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
|
4405 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
|
4406 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
|
4407 Qnil, Qnil); |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4408 |
7250
67bb3bb1b62d
(Ftranspose_regions): Take addresses only after move gap.
Richard M. Stallman <rms@gnu.org>
parents:
7207
diff
changeset
|
4409 /* holds region 2 */ |
56194
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
4410 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
|
4411 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
|
4412 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
|
4413 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
|
4414 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
|
4415 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
|
4416 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
|
4417 SAFE_FREE (); |
56194
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
4418 |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4419 graft_intervals_into_buffer (tmp_interval1, end2 - len1, |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4420 len1, current_buffer, 0); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4421 graft_intervals_into_buffer (tmp_interval_mid, start1 + len2, |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4422 len_mid, current_buffer, 0); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4423 graft_intervals_into_buffer (tmp_interval2, start1, |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4424 len2, current_buffer, 0); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4425 } |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4426 else |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4427 /* Second region smaller than first. */ |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4428 { |
56194
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
4429 USE_SAFE_ALLOCA; |
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
4430 |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4431 record_change (start1, (end2 - start1)); |
72592
f6de516bbb4b
* buffer.h (struct buffer_text): New field chars_modiff.
Chong Yidong <cyd@stupidchicken.com>
parents:
72584
diff
changeset
|
4432 modify_region (current_buffer, start1, end2, 0); |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4433 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4434 tmp_interval1 = copy_intervals (cur_intv, start1, len1); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4435 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
|
4436 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
|
4437 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
|
4438 Qnil, Qnil); |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4439 |
7250
67bb3bb1b62d
(Ftranspose_regions): Take addresses only after move gap.
Richard M. Stallman <rms@gnu.org>
parents:
7207
diff
changeset
|
4440 /* holds region 1 */ |
56194
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
4441 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
|
4442 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
|
4443 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
|
4444 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
|
4445 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
|
4446 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
|
4447 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
|
4448 SAFE_FREE (); |
56194
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
4449 |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4450 graft_intervals_into_buffer (tmp_interval1, end2 - len1, |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4451 len1, current_buffer, 0); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4452 graft_intervals_into_buffer (tmp_interval_mid, start1 + len2, |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4453 len_mid, current_buffer, 0); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4454 graft_intervals_into_buffer (tmp_interval2, start1, |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4455 len2, current_buffer, 0); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4456 } |
26853
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
4457 |
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
4458 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
|
4459 update_compositions (end2 - len1, end2, CHECK_BORDER); |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4460 } |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4461 |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
4462 /* 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
|
4463 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
|
4464 should be organized in some sorted data tree. */ |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4465 if (NILP (leave_markers)) |
7519
987ab382275c
(Ftranspose_regions): Fix overlays after moving markers.
Karl Heuer <kwzh@gnu.org>
parents:
7506
diff
changeset
|
4466 { |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
4467 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
|
4468 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
|
4469 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
|
4470 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
|
4471 } |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4472 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4473 return Qnil; |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4474 } |
305 | 4475 |
4476 | |
4477 void | |
4478 syms_of_editfns () | |
4479 { | |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
4480 environbuf = 0; |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
4481 |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
4482 Qbuffer_access_fontify_functions |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
4483 = intern ("buffer-access-fontify-functions"); |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
4484 staticpro (&Qbuffer_access_fontify_functions); |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
4485 |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
4486 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
|
4487 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
|
4488 Vinhibit_field_text_motion = Qnil; |
19a664c654ab
(Vinhibit_field_text_motion): New variable.
Gerd Moellmann <gerd@gnu.org>
parents:
26853
diff
changeset
|
4489 |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
4490 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
|
4491 &Vbuffer_access_fontify_functions, |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
4492 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
|
4493 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
|
4494 of the buffer being accessed. */); |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
4495 Vbuffer_access_fontify_functions = Qnil; |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
4496 |
14440
e99b3302c154
(syms_of_editfns): Make buffer-access-fontify-functions
Richard M. Stallman <rms@gnu.org>
parents:
14391
diff
changeset
|
4497 { |
e99b3302c154
(syms_of_editfns): Make buffer-access-fontify-functions
Richard M. Stallman <rms@gnu.org>
parents:
14391
diff
changeset
|
4498 Lisp_Object obuf; |
e99b3302c154
(syms_of_editfns): Make buffer-access-fontify-functions
Richard M. Stallman <rms@gnu.org>
parents:
14391
diff
changeset
|
4499 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
|
4500 obuf = Fcurrent_buffer (); |
e99b3302c154
(syms_of_editfns): Make buffer-access-fontify-functions
Richard M. Stallman <rms@gnu.org>
parents:
14391
diff
changeset
|
4501 /* 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
|
4502 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
|
4503 /* 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
|
4504 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
|
4505 Qnil); |
e99b3302c154
(syms_of_editfns): Make buffer-access-fontify-functions
Richard M. Stallman <rms@gnu.org>
parents:
14391
diff
changeset
|
4506 Fset_buffer (obuf); |
e99b3302c154
(syms_of_editfns): Make buffer-access-fontify-functions
Richard M. Stallman <rms@gnu.org>
parents:
14391
diff
changeset
|
4507 } |
e99b3302c154
(syms_of_editfns): Make buffer-access-fontify-functions
Richard M. Stallman <rms@gnu.org>
parents:
14391
diff
changeset
|
4508 |
14220 | 4509 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
|
4510 &Vbuffer_access_fontified_property, |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
4511 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
|
4512 `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
|
4513 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
|
4514 Vbuffer_access_fontified_property = Qnil; |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
4515 |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
4516 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
|
4517 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
|
4518 |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
4519 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
|
4520 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
|
4521 |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
4522 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
|
4523 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
|
4524 |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
4525 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
|
4526 doc: /* The user's name, based upon the real uid only. */); |
305 | 4527 |
59644
d8d85276ffed
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
58029
diff
changeset
|
4528 DEFVAR_LISP ("operating-system-release", &Voperating_system_release, |
d8d85276ffed
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
58029
diff
changeset
|
4529 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
|
4530 |
25833
65cab65c4a28
(Fpropertize): Renamed from Fproperties.
Gerd Moellmann <gerd@gnu.org>
parents:
25815
diff
changeset
|
4531 defsubr (&Spropertize); |
305 | 4532 defsubr (&Schar_equal); |
4533 defsubr (&Sgoto_char); | |
4534 defsubr (&Sstring_to_char); | |
4535 defsubr (&Schar_to_string); | |
4536 defsubr (&Sbuffer_substring); | |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
4537 defsubr (&Sbuffer_substring_no_properties); |
305 | 4538 defsubr (&Sbuffer_string); |
4539 | |
4540 defsubr (&Spoint_marker); | |
4541 defsubr (&Smark_marker); | |
4542 defsubr (&Spoint); | |
4543 defsubr (&Sregion_beginning); | |
4544 defsubr (&Sregion_end); | |
20861
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
4545 |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
4546 staticpro (&Qfield); |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
4547 Qfield = intern ("field"); |
30439
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
4548 staticpro (&Qboundary); |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
4549 Qboundary = intern ("boundary"); |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
4550 defsubr (&Sfield_beginning); |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
4551 defsubr (&Sfield_end); |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
4552 defsubr (&Sfield_string); |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
4553 defsubr (&Sfield_string_no_properties); |
26347
7fd9f4ecdd29
(Fdelete_field): Renamed from Ferase_field.
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
4554 defsubr (&Sdelete_field); |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
4555 defsubr (&Sconstrain_to_field); |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
4556 |
20861
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
4557 defsubr (&Sline_beginning_position); |
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
4558 defsubr (&Sline_end_position); |
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
4559 |
305 | 4560 /* defsubr (&Smark); */ |
4561 /* defsubr (&Sset_mark); */ | |
4562 defsubr (&Ssave_excursion); | |
16298
17304eb73f97
(Fsave_current_buffer): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16269
diff
changeset
|
4563 defsubr (&Ssave_current_buffer); |
305 | 4564 |
4565 defsubr (&Sbufsize); | |
4566 defsubr (&Spoint_max); | |
4567 defsubr (&Spoint_min); | |
4568 defsubr (&Spoint_min_marker); | |
4569 defsubr (&Spoint_max_marker); | |
21821
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
4570 defsubr (&Sgap_position); |
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
4571 defsubr (&Sgap_size); |
20861
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
4572 defsubr (&Sposition_bytes); |
22645
e5b201634497
(Fbyte_to_position): New function.
Richard M. Stallman <rms@gnu.org>
parents:
22199
diff
changeset
|
4573 defsubr (&Sbyte_to_position); |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
4574 |
305 | 4575 defsubr (&Sbobp); |
4576 defsubr (&Seobp); | |
4577 defsubr (&Sbolp); | |
4578 defsubr (&Seolp); | |
512 | 4579 defsubr (&Sfollowing_char); |
4580 defsubr (&Sprevious_char); | |
305 | 4581 defsubr (&Schar_after); |
17031 | 4582 defsubr (&Schar_before); |
305 | 4583 defsubr (&Sinsert); |
4584 defsubr (&Sinsert_before_markers); | |
4714
350231e38e68
(Finsert_and_inherit): New function.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
4585 defsubr (&Sinsert_and_inherit); |
350231e38e68
(Finsert_and_inherit): New function.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
4586 defsubr (&Sinsert_and_inherit_before_markers); |
305 | 4587 defsubr (&Sinsert_char); |
89034
63f566c131d7
(Finsert_byte): New function.
Kenichi Handa <handa@m17n.org>
parents:
89025
diff
changeset
|
4588 defsubr (&Sinsert_byte); |
305 | 4589 |
4590 defsubr (&Suser_login_name); | |
4591 defsubr (&Suser_real_login_name); | |
4592 defsubr (&Suser_uid); | |
4593 defsubr (&Suser_real_uid); | |
4594 defsubr (&Suser_full_name); | |
5373
a70b89d2d6bb
(Femacs_pid): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5242
diff
changeset
|
4595 defsubr (&Semacs_pid); |
448 | 4596 defsubr (&Scurrent_time); |
57987
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
4597 defsubr (&Sget_internal_run_time); |
9154
b4739bcefc44
(Fformat_time_string): Mostly rewritten, to handle
Richard M. Stallman <rms@gnu.org>
parents:
8981
diff
changeset
|
4598 defsubr (&Sformat_time_string); |
30480 | 4599 defsubr (&Sfloat_time); |
9801
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
4600 defsubr (&Sdecode_time); |
11402
66d935214d8e
(Fencode_time): Use XINT to examine `zone'.
Richard M. Stallman <rms@gnu.org>
parents:
11263
diff
changeset
|
4601 defsubr (&Sencode_time); |
305 | 4602 defsubr (&Scurrent_time_string); |
962
3533821d6edc
* editfns.c (Fcurrent_time_zone): Doc fix.
Jim Blandy <jimb@redhat.com>
parents:
690
diff
changeset
|
4603 defsubr (&Scurrent_time_zone); |
13019
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
4604 defsubr (&Sset_time_zone_rule); |
305 | 4605 defsubr (&Ssystem_name); |
4606 defsubr (&Smessage); | |
8975
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
4607 defsubr (&Smessage_box); |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
4608 defsubr (&Smessage_or_box); |
18937
ddb91108a9d2
(Fcurrent_message): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18756
diff
changeset
|
4609 defsubr (&Scurrent_message); |
305 | 4610 defsubr (&Sformat); |
4611 | |
4612 defsubr (&Sinsert_buffer_substring); | |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
4613 defsubr (&Scompare_buffer_substrings); |
305 | 4614 defsubr (&Ssubst_char_in_region); |
57644
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
4615 defsubr (&Stranslate_region_internal); |
305 | 4616 defsubr (&Sdelete_region); |
26742
936b39bd05b4
* editfns.c (Fdelete_and_extract_region): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
26699
diff
changeset
|
4617 defsubr (&Sdelete_and_extract_region); |
305 | 4618 defsubr (&Swiden); |
4619 defsubr (&Snarrow_to_region); | |
4620 defsubr (&Ssave_restriction); | |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4621 defsubr (&Stranspose_regions); |
305 | 4622 } |
52401 | 4623 |
4624 /* arch-tag: fc3827d8-6f60-4067-b11e-c3218031b018 | |
4625 (do not change this comment) */ |