Mercurial > emacs
annotate src/editfns.c @ 99492:ee792794d888
(isearch-search-fun): Compare the length of the
current search string with the length of the string from the
previous search state to detect the situation when the user
adds or removes characters in the search string.
Use word-search-forward-lax and word-search-backward-lax in this
case, and otherwise word-search-forward and word-search-backward.
author | Juri Linkov <juri@jurta.org> |
---|---|
date | Tue, 11 Nov 2008 19:43:09 +0000 |
parents | 287457e9bac1 |
children | e038c1a8307c |
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, |
79759 | 4 2005, 2006, 2007, 2008 Free Software Foundation, Inc. |
305 | 5 |
6 This file is part of GNU Emacs. | |
7 | |
94963
8971ddf55736
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93921
diff
changeset
|
8 GNU Emacs is free software: you can redistribute it and/or modify |
305 | 9 it under the terms of the GNU General Public License as published by |
94963
8971ddf55736
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93921
diff
changeset
|
10 the Free Software Foundation, either version 3 of the License, or |
8971ddf55736
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93921
diff
changeset
|
11 (at your option) any later version. |
305 | 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 | |
94963
8971ddf55736
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93921
diff
changeset
|
19 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ |
305 | 20 |
21 | |
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
parents:
26058
diff
changeset
|
22 #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
|
23 #include <sys/types.h> |
58029
46a652255057
Move #include "systime.h" before <sys/resource.h>.
Eli Zaretskii <eliz@gnu.org>
parents:
58011
diff
changeset
|
24 #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
|
25 |
61700
8a54ce1fae6a
Remove reference to defunct vms-pwd.h.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
61017
diff
changeset
|
26 #ifdef HAVE_PWD_H |
305 | 27 #include <pwd.h> |
372 | 28 #endif |
29 | |
21514 | 30 #ifdef HAVE_UNISTD_H |
31 #include <unistd.h> | |
32 #endif | |
33 | |
59644
d8d85276ffed
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
58029
diff
changeset
|
34 #ifdef HAVE_SYS_UTSNAME_H |
d8d85276ffed
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
58029
diff
changeset
|
35 #include <sys/utsname.h> |
d8d85276ffed
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
58029
diff
changeset
|
36 #endif |
d8d85276ffed
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
58029
diff
changeset
|
37 |
65763
1a50ac5aaa75
Move systime.h include after lisp.h.
Dan Nicolaescu <dann@ics.uci.edu>
parents:
65739
diff
changeset
|
38 #include "lisp.h" |
1a50ac5aaa75
Move systime.h include after lisp.h.
Dan Nicolaescu <dann@ics.uci.edu>
parents:
65739
diff
changeset
|
39 |
58029
46a652255057
Move #include "systime.h" before <sys/resource.h>.
Eli Zaretskii <eliz@gnu.org>
parents:
58011
diff
changeset
|
40 /* systime.h includes <sys/time.h> which, on some systems, is required |
46a652255057
Move #include "systime.h" before <sys/resource.h>.
Eli Zaretskii <eliz@gnu.org>
parents:
58011
diff
changeset
|
41 for <sys/resource.h>; thus systime.h must be included before |
46a652255057
Move #include "systime.h" before <sys/resource.h>.
Eli Zaretskii <eliz@gnu.org>
parents:
58011
diff
changeset
|
42 <sys/resource.h> */ |
46a652255057
Move #include "systime.h" before <sys/resource.h>.
Eli Zaretskii <eliz@gnu.org>
parents:
58011
diff
changeset
|
43 #include "systime.h" |
58011
79614f2016d5
editfns.c: Adding in better patch
Steven Tamm <steventamm@mac.com>
parents:
58010
diff
changeset
|
44 |
79614f2016d5
editfns.c: Adding in better patch
Steven Tamm <steventamm@mac.com>
parents:
58010
diff
changeset
|
45 #if defined HAVE_SYS_RESOURCE_H |
57987
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
46 #include <sys/resource.h> |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
47 #endif |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
48 |
40699
d51d2fa675d0
Move the include of ctype.h after unistd.h.
Richard M. Stallman <rms@gnu.org>
parents:
40656
diff
changeset
|
49 #include <ctype.h> |
d51d2fa675d0
Move the include of ctype.h after unistd.h.
Richard M. Stallman <rms@gnu.org>
parents:
40656
diff
changeset
|
50 |
1285
d50533e23dff
* editfns.c (make_buffer_string): Call copy_intervals_to_string().
Joseph Arceneaux <jla@gnu.org>
parents:
1254
diff
changeset
|
51 #include "intervals.h" |
305 | 52 #include "buffer.h" |
88372
7d0adc8c7f07
Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents:
43042
diff
changeset
|
53 #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
|
54 #include "coding.h" |
38059
0b34b024286d
(Fmessage_box): If the frame is not under a window
Eli Zaretskii <eliz@gnu.org>
parents:
37916
diff
changeset
|
55 #include "frame.h" |
305 | 56 #include "window.h" |
71817
fb57c1830788
Include blockinput.h.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents:
71498
diff
changeset
|
57 #include "blockinput.h" |
305 | 58 |
38519
200c049178cc
(toplevel) [STDC_HEADERS]: Include float.h.
Gerd Moellmann <gerd@gnu.org>
parents:
38059
diff
changeset
|
59 #ifdef STDC_HEADERS |
200c049178cc
(toplevel) [STDC_HEADERS]: Include float.h.
Gerd Moellmann <gerd@gnu.org>
parents:
38059
diff
changeset
|
60 #include <float.h> |
200c049178cc
(toplevel) [STDC_HEADERS]: Include float.h.
Gerd Moellmann <gerd@gnu.org>
parents:
38059
diff
changeset
|
61 #define MAX_10_EXP DBL_MAX_10_EXP |
200c049178cc
(toplevel) [STDC_HEADERS]: Include float.h.
Gerd Moellmann <gerd@gnu.org>
parents:
38059
diff
changeset
|
62 #else |
200c049178cc
(toplevel) [STDC_HEADERS]: Include float.h.
Gerd Moellmann <gerd@gnu.org>
parents:
38059
diff
changeset
|
63 #define MAX_10_EXP 310 |
200c049178cc
(toplevel) [STDC_HEADERS]: Include float.h.
Gerd Moellmann <gerd@gnu.org>
parents:
38059
diff
changeset
|
64 #endif |
200c049178cc
(toplevel) [STDC_HEADERS]: Include float.h.
Gerd Moellmann <gerd@gnu.org>
parents:
38059
diff
changeset
|
65 |
19441
2e2b54ae9b9d
(NULL): Define, if not defined.
Richard M. Stallman <rms@gnu.org>
parents:
19416
diff
changeset
|
66 #ifndef NULL |
2e2b54ae9b9d
(NULL): Define, if not defined.
Richard M. Stallman <rms@gnu.org>
parents:
19416
diff
changeset
|
67 #define NULL 0 |
2e2b54ae9b9d
(NULL): Define, if not defined.
Richard M. Stallman <rms@gnu.org>
parents:
19416
diff
changeset
|
68 #endif |
2e2b54ae9b9d
(NULL): Define, if not defined.
Richard M. Stallman <rms@gnu.org>
parents:
19416
diff
changeset
|
69 |
97655
287457e9bac1
(USER_FULL_NAME): Define to pw->pw_gecos if undefined.
Eli Zaretskii <eliz@gnu.org>
parents:
96718
diff
changeset
|
70 #ifndef USER_FULL_NAME |
287457e9bac1
(USER_FULL_NAME): Define to pw->pw_gecos if undefined.
Eli Zaretskii <eliz@gnu.org>
parents:
96718
diff
changeset
|
71 #define USER_FULL_NAME pw->pw_gecos |
287457e9bac1
(USER_FULL_NAME): Define to pw->pw_gecos if undefined.
Eli Zaretskii <eliz@gnu.org>
parents:
96718
diff
changeset
|
72 #endif |
287457e9bac1
(USER_FULL_NAME): Define to pw->pw_gecos if undefined.
Eli Zaretskii <eliz@gnu.org>
parents:
96718
diff
changeset
|
73 |
31095
e19d38e14720
[USE_CRT_DLL]: Remove unnecessary extern, which screws
Andrew Innes <andrewi@gnu.org>
parents:
31016
diff
changeset
|
74 #ifndef USE_CRT_DLL |
13025
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
75 extern char **environ; |
31095
e19d38e14720
[USE_CRT_DLL]: Remove unnecessary extern, which screws
Andrew Innes <andrewi@gnu.org>
parents:
31016
diff
changeset
|
76 #endif |
e19d38e14720
[USE_CRT_DLL]: Remove unnecessary extern, which screws
Andrew Innes <andrewi@gnu.org>
parents:
31016
diff
changeset
|
77 |
69664
55e66496ae1a
* editfns.c: (TM_YEAR_BASE): Move up.
Paul Eggert <eggert@twinsun.com>
parents:
68669
diff
changeset
|
78 #define TM_YEAR_BASE 1900 |
55e66496ae1a
* editfns.c: (TM_YEAR_BASE): Move up.
Paul Eggert <eggert@twinsun.com>
parents:
68669
diff
changeset
|
79 |
69790
1e68e7f3b824
* lib-src/b2m.c (main): Don't include <limits.h>.
Paul Eggert <eggert@twinsun.com>
parents:
69673
diff
changeset
|
80 /* 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
|
81 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
|
82 #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
|
83 # 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
|
84 (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
|
85 #endif |
1e68e7f3b824
* lib-src/b2m.c (main): Don't include <limits.h>.
Paul Eggert <eggert@twinsun.com>
parents:
69673
diff
changeset
|
86 |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
87 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
|
88 const struct tm *, int)); |
81422
9086f0548bdc
(Fget_internal_run_time) [WINDOWSNT]: Use w32_get_internal_run_time.
Jason Rumney <jasonr@gnu.org>
parents:
81286
diff
changeset
|
89 |
9086f0548bdc
(Fget_internal_run_time) [WINDOWSNT]: Use w32_get_internal_run_time.
Jason Rumney <jasonr@gnu.org>
parents:
81286
diff
changeset
|
90 #ifdef WINDOWSNT |
9086f0548bdc
(Fget_internal_run_time) [WINDOWSNT]: Use w32_get_internal_run_time.
Jason Rumney <jasonr@gnu.org>
parents:
81286
diff
changeset
|
91 extern Lisp_Object w32_get_internal_run_time (); |
9086f0548bdc
(Fget_internal_run_time) [WINDOWSNT]: Use w32_get_internal_run_time.
Jason Rumney <jasonr@gnu.org>
parents:
81286
diff
changeset
|
92 #endif |
9086f0548bdc
(Fget_internal_run_time) [WINDOWSNT]: Use w32_get_internal_run_time.
Jason Rumney <jasonr@gnu.org>
parents:
81286
diff
changeset
|
93 |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
94 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
|
95 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
|
96 static void update_buffer_properties P_ ((int, int)); |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
97 static Lisp_Object region_limit P_ ((int)); |
55193
1b09eb24ab02
(lisp_time_argument): Provide externally.
Eli Zaretskii <eliz@gnu.org>
parents:
54846
diff
changeset
|
98 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
|
99 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
|
100 size_t, const struct tm *, int)); |
46464
e05dd5b81fc7
(general_insert_function): Insertion function now
Ken Raeburn <raeburn@raeburn.org>
parents:
46447
diff
changeset
|
101 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
|
102 void (*) (Lisp_Object, int, int, int, |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
103 int, int), |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
104 int, int, Lisp_Object *)); |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
105 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
|
106 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
|
107 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
|
108 |
31336 | 109 #ifdef HAVE_INDEX |
110 extern char *index P_ ((const char *, int)); | |
111 #endif | |
112 | |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
113 Lisp_Object Vbuffer_access_fontify_functions; |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
114 Lisp_Object Qbuffer_access_fontify_functions; |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
115 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
|
116 |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
117 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
|
118 |
27077
19a664c654ab
(Vinhibit_field_text_motion): New variable.
Gerd Moellmann <gerd@gnu.org>
parents:
26853
diff
changeset
|
119 /* 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
|
120 |
19a664c654ab
(Vinhibit_field_text_motion): New variable.
Gerd Moellmann <gerd@gnu.org>
parents:
26853
diff
changeset
|
121 Lisp_Object Vinhibit_field_text_motion; |
19a664c654ab
(Vinhibit_field_text_motion): New variable.
Gerd Moellmann <gerd@gnu.org>
parents:
26853
diff
changeset
|
122 |
305 | 123 /* Some static data, and a function to initialize it for each run */ |
124 | |
125 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
|
126 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
|
127 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
|
128 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
|
129 Lisp_Object Voperating_system_release; /* Operating System Release */ |
305 | 130 |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
131 /* Symbol for the text property used to mark fields. */ |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
132 |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
133 Lisp_Object Qfield; |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
134 |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
135 /* A special value for Qfield properties. */ |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
136 |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
137 Lisp_Object Qboundary; |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
138 |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
139 |
305 | 140 void |
141 init_editfns () | |
142 { | |
330 | 143 char *user_name; |
25782
8f59abd3a02b
(init_editfns): Remove unused variables.
Gerd Moellmann <gerd@gnu.org>
parents:
25662
diff
changeset
|
144 register unsigned char *p; |
305 | 145 struct passwd *pw; /* password entry for the current user */ |
146 Lisp_Object tem; | |
147 | |
148 /* 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
|
149 init_system_name (); |
305 | 150 |
151 #ifndef CANNOT_DUMP | |
152 /* Don't bother with this on initial start when just dumping out */ | |
153 if (!initialized) | |
154 return; | |
155 #endif /* not CANNOT_DUMP */ | |
156 | |
157 pw = (struct passwd *) getpwuid (getuid ()); | |
9572 | 158 #ifdef MSDOS |
159 /* We let the real user name default to "root" because that's quite | |
160 accurate on MSDOG and because it lets Emacs find the init file. | |
161 (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
|
162 Vuser_real_login_name = build_string (pw ? pw->pw_name : "root"); |
9572 | 163 #else |
12026
505a894d943e
(syms_of_editfns): user-login-name renamed from user-name.
Karl Heuer <kwzh@gnu.org>
parents:
11912
diff
changeset
|
164 Vuser_real_login_name = build_string (pw ? pw->pw_name : "unknown"); |
9572 | 165 #endif |
305 | 166 |
330 | 167 /* Get the effective user name, by consulting environment variables, |
168 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
|
169 user_name = (char *) getenv ("LOGNAME"); |
330 | 170 if (!user_name) |
9801
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
171 #ifdef WINDOWSNT |
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
172 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
|
173 #else /* WINDOWSNT */ |
5907
5fdb226fe9a4
(init_editfns): Look at LOGNAME before USER.
Karl Heuer <kwzh@gnu.org>
parents:
5884
diff
changeset
|
174 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
|
175 #endif /* WINDOWSNT */ |
305 | 176 if (!user_name) |
330 | 177 { |
178 pw = (struct passwd *) getpwuid (geteuid ()); | |
179 user_name = (char *) (pw ? pw->pw_name : "unknown"); | |
180 } | |
12026
505a894d943e
(syms_of_editfns): user-login-name renamed from user-name.
Karl Heuer <kwzh@gnu.org>
parents:
11912
diff
changeset
|
181 Vuser_login_name = build_string (user_name); |
305 | 182 |
330 | 183 /* If the user name claimed in the environment vars differs from |
184 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
|
185 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
|
186 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
|
187 : Vuser_login_name); |
30480 | 188 |
11447
d51e912495be
(init_editfns): Add casts.
Richard M. Stallman <rms@gnu.org>
parents:
11433
diff
changeset
|
189 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
|
190 if (p) |
9ab21ef32537
(init_editfns): Use NAME envvar to init user-full-name.
Richard M. Stallman <rms@gnu.org>
parents:
10480
diff
changeset
|
191 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
|
192 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
|
193 Vuser_full_name = build_string ("unknown"); |
59644
d8d85276ffed
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
58029
diff
changeset
|
194 |
d8d85276ffed
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
58029
diff
changeset
|
195 #ifdef HAVE_SYS_UTSNAME_H |
d8d85276ffed
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
58029
diff
changeset
|
196 { |
d8d85276ffed
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
58029
diff
changeset
|
197 struct utsname uts; |
d8d85276ffed
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
58029
diff
changeset
|
198 uname (&uts); |
d8d85276ffed
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
58029
diff
changeset
|
199 Voperating_system_release = build_string (uts.release); |
d8d85276ffed
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
58029
diff
changeset
|
200 } |
d8d85276ffed
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
58029
diff
changeset
|
201 #else |
d8d85276ffed
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
58029
diff
changeset
|
202 Voperating_system_release = Qnil; |
d8d85276ffed
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
58029
diff
changeset
|
203 #endif |
305 | 204 } |
205 | |
206 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
|
207 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
|
208 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
|
209 (character) |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
210 Lisp_Object character; |
305 | 211 { |
17031 | 212 int len; |
26853
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
213 unsigned char str[MAX_MULTIBYTE_LENGTH]; |
17031 | 214 |
90800
37b19435acef
(Fchar_to_string): Use CHARACTERP, not INTEGERP.
Kenichi Handa <handa@m17n.org>
parents:
90796
diff
changeset
|
215 CHECK_CHARACTER (character); |
305 | 216 |
88372
7d0adc8c7f07
Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents:
43042
diff
changeset
|
217 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
|
218 return make_string_from_bytes (str, 1, len); |
305 | 219 } |
220 | |
221 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
|
222 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
|
223 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
|
224 (string) |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
225 register Lisp_Object string; |
305 | 226 { |
227 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
|
228 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
|
229 if (SCHARS (string)) |
23650
3cc42e65f25b
(Fstring_to_char): Don't return a multibyte character
Kenichi Handa <handa@m17n.org>
parents:
23596
diff
changeset
|
230 { |
3cc42e65f25b
(Fstring_to_char): Don't return a multibyte character
Kenichi Handa <handa@m17n.org>
parents:
23596
diff
changeset
|
231 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
|
232 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
|
233 else |
46443
b612fecce4cc
(Fstring_to_char): Use string macros instead of Lisp_String fields.
Ken Raeburn <raeburn@raeburn.org>
parents:
46370
diff
changeset
|
234 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
|
235 } |
305 | 236 else |
9305
ac077e2a75f1
(Fstring_to_char, Fpoint, Fbufsize, Fpoint_min, Fpoint_max, Ffollowing_char,
Karl Heuer <kwzh@gnu.org>
parents:
9265
diff
changeset
|
237 XSETFASTINT (val, 0); |
305 | 238 return val; |
239 } | |
240 | |
241 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
|
242 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
|
243 int charpos, bytepos; |
305 | 244 { |
245 register Lisp_Object mark; | |
246 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
|
247 set_marker_both (mark, Qnil, charpos, bytepos); |
305 | 248 return mark; |
249 } | |
250 | |
251 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
|
252 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
|
253 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
|
254 () |
305 | 255 { |
256 Lisp_Object temp; | |
16039
855c8d8ba0f0
Change all references from point to PT.
Karl Heuer <kwzh@gnu.org>
parents:
15910
diff
changeset
|
257 XSETFASTINT (temp, PT); |
305 | 258 return temp; |
259 } | |
260 | |
261 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
|
262 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
|
263 () |
305 | 264 { |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
265 return buildmark (PT, PT_BYTE); |
305 | 266 } |
267 | |
268 int | |
269 clip_to_bounds (lower, num, upper) | |
270 int lower, num, upper; | |
271 { | |
272 if (num < lower) | |
273 return lower; | |
274 else if (num > upper) | |
275 return upper; | |
276 else | |
277 return num; | |
278 } | |
279 | |
280 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
|
281 doc: /* Set point to POSITION, a number or marker. |
76709 | 282 Beginning of buffer is position (point-min), end is (point-max). |
283 | |
284 The return value is POSITION. */) | |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
285 (position) |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
286 register Lisp_Object position; |
305 | 287 { |
17031 | 288 int pos; |
289 | |
21226
c8d0df2cbd3d
(Fgoto_char): If POSITION is a marker pointing a
Richard M. Stallman <rms@gnu.org>
parents:
21225
diff
changeset
|
290 if (MARKERP (position) |
c8d0df2cbd3d
(Fgoto_char): If POSITION is a marker pointing a
Richard M. Stallman <rms@gnu.org>
parents:
21225
diff
changeset
|
291 && 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
|
292 { |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
293 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
|
294 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
|
295 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
|
296 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
|
297 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
|
298 else |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
299 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
|
300 |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
301 return position; |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
302 } |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
303 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
304 CHECK_NUMBER_COERCE_MARKER (position); |
305 | 305 |
17031 | 306 pos = clip_to_bounds (BEGV, XINT (position), ZV); |
307 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
|
308 return position; |
305 | 309 } |
310 | |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
311 |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
312 /* Return the start or end position of the region. |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
313 BEGINNINGP non-zero means return the start. |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
314 If there is no region active, signal an error. */ |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
315 |
305 | 316 static Lisp_Object |
317 region_limit (beginningp) | |
318 int beginningp; | |
319 { | |
4047
e950abdc9ed2
(region_limit): Declare Vmark_even_if_inactive.
Roland McGrath <roland@gnu.org>
parents:
4038
diff
changeset
|
320 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
|
321 Lisp_Object m; |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49472
diff
changeset
|
322 |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
323 if (!NILP (Vtransient_mark_mode) |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
324 && 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
|
325 && 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
|
326 xsignal0 (Qmark_inactive); |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49472
diff
changeset
|
327 |
305 | 328 m = Fmarker_position (current_buffer->mark); |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
329 if (NILP (m)) |
43042
63639e690611
(region_limit): Nicer error message.
Richard M. Stallman <rms@gnu.org>
parents:
42484
diff
changeset
|
330 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
|
331 |
52451
c7860e5cc982
(region_limit): Support any non-zero value of BEGINNINGP.
Eli Zaretskii <eliz@gnu.org>
parents:
52401
diff
changeset
|
332 if ((PT < XFASTINT (m)) == (beginningp != 0)) |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
333 m = make_number (PT); |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
334 return m; |
305 | 335 } |
336 | |
337 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
|
338 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
|
339 () |
305 | 340 { |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
341 return region_limit (1); |
305 | 342 } |
343 | |
344 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
|
345 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
|
346 () |
305 | 347 { |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
348 return region_limit (0); |
305 | 349 } |
350 | |
351 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
|
352 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
|
353 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
|
354 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
|
355 () |
305 | 356 { |
357 return current_buffer->mark; | |
358 } | |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
359 |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
360 |
48094
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
361 /* 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
|
362 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
|
363 of length LEN. */ |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
364 |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
365 static int |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
366 overlays_around (pos, vec, len) |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
367 int pos; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
368 Lisp_Object *vec; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
369 int len; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
370 { |
51841
59ba1f5d0a16
(overlays_around): Use new type for overlays_(before|after).
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
51670
diff
changeset
|
371 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
|
372 struct Lisp_Overlay *tail; |
48094
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
373 int startpos, endpos; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
374 int idx = 0; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
375 |
51841
59ba1f5d0a16
(overlays_around): Use new type for overlays_(before|after).
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
51670
diff
changeset
|
376 for (tail = current_buffer->overlays_before; tail; tail = tail->next) |
48094
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
377 { |
51841
59ba1f5d0a16
(overlays_around): Use new type for overlays_(before|after).
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
51670
diff
changeset
|
378 XSETMISC (overlay, tail); |
48094
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
379 |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
380 end = OVERLAY_END (overlay); |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
381 endpos = OVERLAY_POSITION (end); |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
382 if (endpos < pos) |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
383 break; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
384 start = OVERLAY_START (overlay); |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
385 startpos = OVERLAY_POSITION (start); |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
386 if (startpos <= pos) |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
387 { |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
388 if (idx < len) |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
389 vec[idx] = overlay; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
390 /* 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
|
391 idx++; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
392 } |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
393 } |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
394 |
51841
59ba1f5d0a16
(overlays_around): Use new type for overlays_(before|after).
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
51670
diff
changeset
|
395 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
|
396 { |
51841
59ba1f5d0a16
(overlays_around): Use new type for overlays_(before|after).
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
51670
diff
changeset
|
397 XSETMISC (overlay, tail); |
48094
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
398 |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
399 start = OVERLAY_START (overlay); |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
400 startpos = OVERLAY_POSITION (start); |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
401 if (pos < startpos) |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
402 break; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
403 end = OVERLAY_END (overlay); |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
404 endpos = OVERLAY_POSITION (end); |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
405 if (pos <= endpos) |
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 if (idx < len) |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
408 vec[idx] = overlay; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
409 idx++; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
410 } |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
411 } |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
412 |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
413 return idx; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
414 } |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
415 |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
416 /* 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
|
417 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
|
418 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
|
419 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
|
420 text properties. |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
421 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
|
422 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
|
423 with OBJECT. */ |
48134
ef2b87569c38
(get_pos_property): Don't hardcode Qfield.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48115
diff
changeset
|
424 Lisp_Object |
48094
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
425 get_pos_property (position, prop, object) |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
426 Lisp_Object position, object; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
427 register Lisp_Object prop; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
428 { |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
429 CHECK_NUMBER_COERCE_MARKER (position); |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
430 |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
431 if (NILP (object)) |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
432 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
|
433 else if (WINDOWP (object)) |
edeae7524de9
(get_pos_property): Don't assume that `object' = nil.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50746
diff
changeset
|
434 object = XWINDOW (object)->buffer; |
edeae7524de9
(get_pos_property): Don't assume that `object' = nil.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50746
diff
changeset
|
435 |
edeae7524de9
(get_pos_property): Don't assume that `object' = nil.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50746
diff
changeset
|
436 if (!BUFFERP (object)) |
edeae7524de9
(get_pos_property): Don't assume that `object' = nil.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50746
diff
changeset
|
437 /* 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
|
438 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
|
439 could be obeyed. */ |
edeae7524de9
(get_pos_property): Don't assume that `object' = nil.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50746
diff
changeset
|
440 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
|
441 else |
48094
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
442 { |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
443 int posn = XINT (position); |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
444 int noverlays; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
445 Lisp_Object *overlay_vec, tem; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
446 struct buffer *obuf = current_buffer; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
447 |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
448 set_buffer_temp (XBUFFER (object)); |
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 /* 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
|
451 noverlays = 40; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
452 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
|
453 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
|
454 |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
455 /* If there are more than 40, |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
456 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
|
457 if (noverlays > 40) |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
458 { |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
459 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
|
460 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
|
461 } |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
462 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
|
463 |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
464 set_buffer_temp (obuf); |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
465 |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
466 /* 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
|
467 while (--noverlays >= 0) |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
468 { |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
469 Lisp_Object ol = overlay_vec[noverlays]; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
470 tem = Foverlay_get (ol, prop); |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
471 if (!NILP (tem)) |
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 /* 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
|
474 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
|
475 if ((OVERLAY_POSITION (start) == posn |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
476 && XMARKER (start)->insertion_type == 1) |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
477 || (OVERLAY_POSITION (finish) == posn |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
478 && XMARKER (finish)->insertion_type == 0)) |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
479 ; /* 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
|
480 else |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
481 { |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
482 return tem; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
483 } |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
484 } |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
485 } |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49472
diff
changeset
|
486 |
93921
f7d6d03d8ceb
(Ffield_string_no_properties): Fix typo in docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
93038
diff
changeset
|
487 { /* Now check the text properties. */ |
51042
edeae7524de9
(get_pos_property): Don't assume that `object' = nil.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50746
diff
changeset
|
488 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
|
489 if (stickiness > 0) |
edeae7524de9
(get_pos_property): Don't assume that `object' = nil.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50746
diff
changeset
|
490 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
|
491 else if (stickiness < 0 |
edeae7524de9
(get_pos_property): Don't assume that `object' = nil.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50746
diff
changeset
|
492 && 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
|
493 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
|
494 prop, object); |
edeae7524de9
(get_pos_property): Don't assume that `object' = nil.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50746
diff
changeset
|
495 else |
edeae7524de9
(get_pos_property): Don't assume that `object' = nil.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50746
diff
changeset
|
496 return Qnil; |
edeae7524de9
(get_pos_property): Don't assume that `object' = nil.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50746
diff
changeset
|
497 } |
48094
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
498 } |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
499 } |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
500 |
26389
e2acf63b5403
(Fline_beginning_position): If N is not 1,
Richard M. Stallman <rms@gnu.org>
parents:
26372
diff
changeset
|
501 /* Find the field surrounding POS in *BEG and *END. If POS is nil, |
70188 | 502 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
|
503 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
|
504 |
41065
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
505 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
|
506 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
|
507 |
70213
e9ea7c53ddc7
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-245
Miles Bader <miles@gnu.org>
parents:
70188
diff
changeset
|
508 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
|
509 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
|
510 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
|
511 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
|
512 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
|
513 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
|
514 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
|
515 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
|
516 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
|
517 |
e9ea7c53ddc7
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-245
Miles Bader <miles@gnu.org>
parents:
70188
diff
changeset
|
518 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
|
519 is not stored. */ |
26389
e2acf63b5403
(Fline_beginning_position): If N is not 1,
Richard M. Stallman <rms@gnu.org>
parents:
26372
diff
changeset
|
520 |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
521 static void |
41065
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
522 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
|
523 Lisp_Object pos; |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
524 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
|
525 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
|
526 int *beg, *end; |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
527 { |
30439
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
528 /* Fields right before and after the point. */ |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
529 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
|
530 /* 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
|
531 int at_field_start = 0; |
e2acf63b5403
(Fline_beginning_position): If N is not 1,
Richard M. Stallman <rms@gnu.org>
parents:
26372
diff
changeset
|
532 /* 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
|
533 int at_field_end = 0; |
30439
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
534 |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
535 if (NILP (pos)) |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
536 XSETFASTINT (pos, PT); |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
537 else |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
538 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
|
539 |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
540 after_field |
48094
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
541 = get_char_property_and_overlay (pos, Qfield, Qnil, NULL); |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
542 before_field |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
543 = (XFASTINT (pos) > BEGV |
32850 | 544 ? 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
|
545 Qfield, Qnil, NULL) |
68394
0b6d0aad4517
(Fconstrain_to_field): Fix behaviour on field boundaries.
Károly Lőrentey <lorentey@elte.hu>
parents:
68392
diff
changeset
|
546 /* 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
|
547 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
|
548 : after_field); |
30439
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
549 |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
550 /* 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
|
551 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
|
552 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
|
553 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
|
554 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
|
555 specially. */ |
48094
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
556 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
|
557 { |
48094
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
558 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
|
559 if (!EQ (field, after_field)) |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
560 at_field_end = 1; |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
561 if (!EQ (field, before_field)) |
30439
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
562 at_field_start = 1; |
48111
7103ad01172d
(find_field): Make an exception for nil fields.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48094
diff
changeset
|
563 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
|
564 /* 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
|
565 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
|
566 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
|
567 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
|
568 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
|
569 } |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
570 |
30439
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
571 /* Note about special `boundary' fields: |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
572 |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
573 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
|
574 |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
575 xxxx.yyyy |
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 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
|
578 `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
|
579 of the field is the end of `y'. |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
580 |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
581 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
|
582 (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
|
583 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
|
584 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
|
585 |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
586 xxx.BBBByyyy |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
587 |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
588 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
|
589 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
|
590 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
|
591 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
|
592 |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
593 if (beg) |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
594 { |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
595 if (at_field_start) |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
596 /* POS is at the edge of a field, and we should consider it as |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
597 the beginning of the following field. */ |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
598 *beg = XFASTINT (pos); |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
599 else |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
600 /* Find the previous field boundary. */ |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
601 { |
48094
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
602 Lisp_Object p = pos; |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
603 if (!NILP (merge_at_boundary) && EQ (before_field, Qboundary)) |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
604 /* Skip a `boundary' field. */ |
48094
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
605 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
|
606 beg_limit); |
48094
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
607 |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
608 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
|
609 beg_limit); |
2a8ba962e34d
(overlays_around, get_pos_property): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48020
diff
changeset
|
610 *beg = NILP (p) ? BEGV : XFASTINT (p); |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
611 } |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
612 } |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
613 |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
614 if (end) |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
615 { |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
616 if (at_field_end) |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
617 /* 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
|
618 the end of the previous field. */ |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
619 *end = XFASTINT (pos); |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
620 else |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
621 /* Find the next field boundary. */ |
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 if (!NILP (merge_at_boundary) && EQ (after_field, Qboundary)) |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
624 /* Skip a `boundary' field. */ |
41065
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
625 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
|
626 end_limit); |
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
627 |
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
628 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
|
629 end_limit); |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
630 *end = NILP (pos) ? ZV : XFASTINT (pos); |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
631 } |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
632 } |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
633 } |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
634 |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
635 |
26629
05dcbc266797
(Fdelete_field): Make it noninteractive. Return nil.
Richard M. Stallman <rms@gnu.org>
parents:
26526
diff
changeset
|
636 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
|
637 doc: /* Delete the field surrounding POS. |
39966
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
638 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
|
639 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
|
640 (pos) |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
641 Lisp_Object pos; |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
642 { |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
643 int beg, end; |
41065
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
644 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
|
645 if (beg != end) |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
646 del_range (beg, end); |
26629
05dcbc266797
(Fdelete_field): Make it noninteractive. Return nil.
Richard M. Stallman <rms@gnu.org>
parents:
26526
diff
changeset
|
647 return Qnil; |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
648 } |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
649 |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
650 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
|
651 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
|
652 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
|
653 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
|
654 (pos) |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
655 Lisp_Object pos; |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
656 { |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
657 int beg, end; |
41065
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
658 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
|
659 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
|
660 } |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
661 |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
662 DEFUN ("field-string-no-properties", Ffield_string_no_properties, Sfield_string_no_properties, 0, 1, 0, |
93921
f7d6d03d8ceb
(Ffield_string_no_properties): Fix typo in docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
93038
diff
changeset
|
663 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
|
664 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
|
665 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
|
666 (pos) |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
667 Lisp_Object pos; |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
668 { |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
669 int beg, end; |
41065
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
670 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
|
671 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
|
672 } |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
673 |
41065
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
674 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
|
675 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
|
676 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
|
677 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
|
678 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
|
679 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
|
680 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
|
681 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
|
682 (pos, escape_from_edge, limit) |
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
683 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
|
684 { |
70213
e9ea7c53ddc7
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-245
Miles Bader <miles@gnu.org>
parents:
70188
diff
changeset
|
685 int beg; |
e9ea7c53ddc7
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-245
Miles Bader <miles@gnu.org>
parents:
70188
diff
changeset
|
686 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
|
687 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
|
688 } |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
689 |
41065
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
690 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
|
691 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
|
692 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
|
693 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
|
694 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
|
695 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
|
696 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
|
697 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
|
698 (pos, escape_from_edge, limit) |
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
699 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
|
700 { |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
701 int end; |
41065
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
702 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
|
703 return make_number (end); |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
704 } |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
705 |
30439
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
706 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
|
707 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
|
708 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
709 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
|
710 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
|
711 constrained position if that is different. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
712 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
713 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
|
714 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
|
715 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
|
716 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
|
717 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
|
718 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
|
719 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
|
720 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
|
721 also considered to be `on the boundary'. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
722 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
723 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
|
724 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
|
725 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
|
726 \\[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
|
727 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
|
728 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
729 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
|
730 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
|
731 |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
732 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
|
733 (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
|
734 Lisp_Object new_pos, old_pos; |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
735 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
|
736 { |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
737 /* 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
|
738 int orig_point = 0; |
68626
ee9f9dd4337d
(Fconstrain_to_field): Fix int/Lisp_Object mixup.
Ken Raeburn <raeburn@raeburn.org>
parents:
68394
diff
changeset
|
739 int fwd; |
ee9f9dd4337d
(Fconstrain_to_field): Fix int/Lisp_Object mixup.
Ken Raeburn <raeburn@raeburn.org>
parents:
68394
diff
changeset
|
740 Lisp_Object prev_old, prev_new; |
69664
55e66496ae1a
* editfns.c: (TM_YEAR_BASE): Move up.
Paul Eggert <eggert@twinsun.com>
parents:
68669
diff
changeset
|
741 |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
742 if (NILP (new_pos)) |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
743 /* 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
|
744 { |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
745 orig_point = PT; |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
746 XSETFASTINT (new_pos, PT); |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
747 } |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
748 |
68394
0b6d0aad4517
(Fconstrain_to_field): Fix behaviour on field boundaries.
Károly Lőrentey <lorentey@elte.hu>
parents:
68392
diff
changeset
|
749 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
|
750 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
|
751 |
0b6d0aad4517
(Fconstrain_to_field): Fix behaviour on field boundaries.
Károly Lőrentey <lorentey@elte.hu>
parents:
68392
diff
changeset
|
752 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
|
753 |
0b6d0aad4517
(Fconstrain_to_field): Fix behaviour on field boundaries.
Károly Lőrentey <lorentey@elte.hu>
parents:
68392
diff
changeset
|
754 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
|
755 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
|
756 |
27081
f068649f1c28
(Fconstrain_to_field): Don't constrain if
Gerd Moellmann <gerd@gnu.org>
parents:
27077
diff
changeset
|
757 if (NILP (Vinhibit_field_text_motion) |
f068649f1c28
(Fconstrain_to_field): Don't constrain if
Gerd Moellmann <gerd@gnu.org>
parents:
27077
diff
changeset
|
758 && !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
|
759 && (!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
|
760 || !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
|
761 /* 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
|
762 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
|
763 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
|
764 fields (like comint prompts). */ |
0b6d0aad4517
(Fconstrain_to_field): Fix behaviour on field boundaries.
Károly Lőrentey <lorentey@elte.hu>
parents:
68392
diff
changeset
|
765 || (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
|
766 && !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
|
767 || (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
|
768 && !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
|
769 && (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
|
770 /* 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
|
771 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
|
772 `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
|
773 || (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
|
774 && (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
|
775 || 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
|
776 || 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
|
777 /* 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
|
778 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
|
779 { |
68394
0b6d0aad4517
(Fconstrain_to_field): Fix behaviour on field boundaries.
Károly Lőrentey <lorentey@elte.hu>
parents:
68392
diff
changeset
|
780 int shortage; |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
781 Lisp_Object field_bound; |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
782 |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
783 if (fwd) |
41065
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
784 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
|
785 else |
41065
af0215d05281
(find_field): Add BEG_LIMIT and END_LIMIT parameters.
Miles Bader <miles@gnu.org>
parents:
41062
diff
changeset
|
786 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
|
787 |
30550
73040724e653
(Fconstrain_to_field): Fix the conditions for deciding when to constrain
Miles Bader <miles@gnu.org>
parents:
30503
diff
changeset
|
788 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
|
789 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
|
790 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
|
791 to FIELD_BOUND. */ |
73040724e653
(Fconstrain_to_field): Fix the conditions for deciding when to constrain
Miles Bader <miles@gnu.org>
parents:
30503
diff
changeset
|
792 ((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
|
793 /* 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
|
794 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
|
795 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
|
796 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
|
797 && (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
|
798 /* 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
|
799 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
|
800 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
|
801 || (scan_buffer ('\n', |
73040724e653
(Fconstrain_to_field): Fix the conditions for deciding when to constrain
Miles Bader <miles@gnu.org>
parents:
30503
diff
changeset
|
802 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
|
803 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
|
804 shortage != 0))) |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
805 /* 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
|
806 new_pos = field_bound; |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
807 |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
808 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
|
809 /* 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
|
810 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
|
811 } |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
812 |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
813 return new_pos; |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
814 } |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
815 |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
816 |
40042
c9ad5da1f79d
(Fline_beginning_position, Fline_end_position): Clarify documentation.
Miles Bader <miles@gnu.org>
parents:
39988
diff
changeset
|
817 DEFUN ("line-beginning-position", |
c9ad5da1f79d
(Fline_beginning_position, Fline_end_position): Clarify documentation.
Miles Bader <miles@gnu.org>
parents:
39988
diff
changeset
|
818 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
|
819 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
|
820 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
|
821 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
|
822 |
68392
a0208539b9a3
(Fconstrain_to_field): Use get_pos_property, not Fget_char_property,
Károly Lőrentey <lorentey@elte.hu>
parents:
66500
diff
changeset
|
823 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
|
824 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
|
825 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
|
826 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
|
827 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
|
828 |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
829 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
|
830 (n) |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
831 Lisp_Object n; |
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
832 { |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
833 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
|
834 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
|
835 specbind (Qinhibit_point_motion_hooks, Qt); |
305 | 836 |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
837 if (NILP (n)) |
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
838 XSETFASTINT (n, 1); |
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
839 else |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
840 CHECK_NUMBER (n); |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
841 |
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
842 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
|
843 orig_byte = PT_BYTE; |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
844 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
|
845 end = PT; |
25647
947cb0e32a1d
(Fline_beginning_position): Handle minibuffer prompt here.
Richard M. Stallman <rms@gnu.org>
parents:
25609
diff
changeset
|
846 |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
847 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
|
848 |
70619
f5917c21d187
* intervals.c (set_point_both): Fix mixup before before and after
Chong Yidong <cyd@stupidchicken.com>
parents:
70213
diff
changeset
|
849 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
|
850 |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
851 /* 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
|
852 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
|
853 XINT (n) != 1 ? Qt : Qnil, |
30439
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
854 Qt, Qnil); |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
855 } |
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
856 |
40042
c9ad5da1f79d
(Fline_beginning_position, Fline_end_position): Clarify documentation.
Miles Bader <miles@gnu.org>
parents:
39988
diff
changeset
|
857 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
|
858 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
|
859 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
|
860 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
|
861 |
68392
a0208539b9a3
(Fconstrain_to_field): Use get_pos_property, not Fget_char_property,
Károly Lőrentey <lorentey@elte.hu>
parents:
66500
diff
changeset
|
862 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
|
863 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
|
864 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
|
865 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
|
866 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
|
867 |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
868 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
|
869 (n) |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
870 Lisp_Object n; |
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
871 { |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
872 int end_pos; |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
873 int orig = PT; |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
874 |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
875 if (NILP (n)) |
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
876 XSETFASTINT (n, 1); |
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
877 else |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
878 CHECK_NUMBER (n); |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
879 |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
880 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
|
881 |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
882 /* 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
|
883 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
|
884 Qnil, Qt, Qnil); |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
885 } |
40042
c9ad5da1f79d
(Fline_beginning_position, Fline_end_position): Clarify documentation.
Miles Bader <miles@gnu.org>
parents:
39988
diff
changeset
|
886 |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
887 |
305 | 888 Lisp_Object |
889 save_excursion_save () | |
890 { | |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
891 int visible = (XBUFFER (XWINDOW (selected_window)->buffer) |
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
892 == current_buffer); |
305 | 893 |
894 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
|
895 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
|
896 Fcons (visible ? Qt : Qnil, |
32420
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
897 Fcons (current_buffer->mark_active, |
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
898 selected_window)))); |
305 | 899 } |
900 | |
901 Lisp_Object | |
902 save_excursion_restore (info) | |
15075
e8613675066c
(save_excursion_restore): Add gcpros.
Richard M. Stallman <rms@gnu.org>
parents:
15015
diff
changeset
|
903 Lisp_Object info; |
305 | 904 { |
15075
e8613675066c
(save_excursion_restore): Add gcpros.
Richard M. Stallman <rms@gnu.org>
parents:
15015
diff
changeset
|
905 Lisp_Object tem, tem1, omark, nmark; |
e8613675066c
(save_excursion_restore): Add gcpros.
Richard M. Stallman <rms@gnu.org>
parents:
15015
diff
changeset
|
906 struct gcpro gcpro1, gcpro2, gcpro3; |
32420
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
907 int visible_p; |
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
908 |
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
909 tem = Fmarker_buffer (XCAR (info)); |
305 | 910 /* If buffer being returned to is now deleted, avoid error */ |
911 /* Otherwise could get error here while unwinding to top level | |
912 and crash */ | |
913 /* In that case, Fmarker_buffer returns nil now. */ | |
488 | 914 if (NILP (tem)) |
305 | 915 return Qnil; |
15075
e8613675066c
(save_excursion_restore): Add gcpros.
Richard M. Stallman <rms@gnu.org>
parents:
15015
diff
changeset
|
916 |
e8613675066c
(save_excursion_restore): Add gcpros.
Richard M. Stallman <rms@gnu.org>
parents:
15015
diff
changeset
|
917 omark = nmark = Qnil; |
e8613675066c
(save_excursion_restore): Add gcpros.
Richard M. Stallman <rms@gnu.org>
parents:
15015
diff
changeset
|
918 GCPRO3 (info, omark, nmark); |
e8613675066c
(save_excursion_restore): Add gcpros.
Richard M. Stallman <rms@gnu.org>
parents:
15015
diff
changeset
|
919 |
305 | 920 Fset_buffer (tem); |
32420
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
921 |
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
922 /* Point marker. */ |
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
923 tem = XCAR (info); |
305 | 924 Fgoto_char (tem); |
51670
beceb827c1ce
(save_excursion_restore, transpose_markers): Update for new types.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
51042
diff
changeset
|
925 unchain_marker (XMARKER (tem)); |
32420
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
926 |
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
927 /* Mark marker. */ |
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
928 info = XCDR (info); |
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
929 tem = XCAR (info); |
7485
a1b7f72e0ea2
(save_excursion_restore): Don't run activate-mark-hook
Richard M. Stallman <rms@gnu.org>
parents:
7307
diff
changeset
|
930 omark = Fmarker_position (current_buffer->mark); |
305 | 931 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
|
932 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
|
933 unchain_marker (XMARKER (tem)); |
32420
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
934 |
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
935 /* visible */ |
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
936 info = XCDR (info); |
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
937 visible_p = !NILP (XCAR (info)); |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49472
diff
changeset
|
938 |
4420
8113d9ba472e
(save_excursion_restore): Never make the buffer visible.
Richard M. Stallman <rms@gnu.org>
parents:
4358
diff
changeset
|
939 #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
|
940 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
|
941 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
|
942 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
|
943 tem1 = Fcar (tem); |
a358c97a23e4
(save_excursion_save): Save mark_active of buffer.
Richard M. Stallman <rms@gnu.org>
parents:
1916
diff
changeset
|
944 if (!NILP (tem1) |
1254
c7e7e3438711
* editfns.c (save_excursion_save, save_excursion_restore):
Jim Blandy <jimb@redhat.com>
parents:
1117
diff
changeset
|
945 && current_buffer != XBUFFER (XWINDOW (selected_window)->buffer)) |
305 | 946 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
|
947 #endif /* 0 */ |
2049
a358c97a23e4
(save_excursion_save): Save mark_active of buffer.
Richard M. Stallman <rms@gnu.org>
parents:
1916
diff
changeset
|
948 |
32420
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
949 /* Mark active */ |
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
950 info = XCDR (info); |
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
951 tem = XCAR (info); |
2049
a358c97a23e4
(save_excursion_save): Save mark_active of buffer.
Richard M. Stallman <rms@gnu.org>
parents:
1916
diff
changeset
|
952 tem1 = current_buffer->mark_active; |
32420
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
953 current_buffer->mark_active = tem; |
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
954 |
6206
67c608b0e2f7
(save_excursion_restore): Don't call Vrun_hooks if nil.
Richard M. Stallman <rms@gnu.org>
parents:
5915
diff
changeset
|
955 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
|
956 { |
7485
a1b7f72e0ea2
(save_excursion_restore): Don't run activate-mark-hook
Richard M. Stallman <rms@gnu.org>
parents:
7307
diff
changeset
|
957 /* 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
|
958 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
|
959 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
|
960 { |
a1b7f72e0ea2
(save_excursion_restore): Don't run activate-mark-hook
Richard M. Stallman <rms@gnu.org>
parents:
7307
diff
changeset
|
961 if (! EQ (omark, nmark)) |
a1b7f72e0ea2
(save_excursion_restore): Don't run activate-mark-hook
Richard M. Stallman <rms@gnu.org>
parents:
7307
diff
changeset
|
962 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
|
963 } |
a1b7f72e0ea2
(save_excursion_restore): Don't run activate-mark-hook
Richard M. Stallman <rms@gnu.org>
parents:
7307
diff
changeset
|
964 /* 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
|
965 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
|
966 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
|
967 } |
32420
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
968 |
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
969 /* 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
|
970 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
|
971 buffer, restore point in that window. */ |
32420
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
972 tem = XCDR (info); |
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
973 if (visible_p |
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
974 && !EQ (tem, selected_window) |
37492
b9cea35cf91f
(save_excursion_restore): Don't use XBUFFER on
Gerd Moellmann <gerd@gnu.org>
parents:
37217
diff
changeset
|
975 && (tem1 = XWINDOW (tem)->buffer, |
b9cea35cf91f
(save_excursion_restore): Don't use XBUFFER on
Gerd Moellmann <gerd@gnu.org>
parents:
37217
diff
changeset
|
976 (/* Window is live... */ |
b9cea35cf91f
(save_excursion_restore): Don't use XBUFFER on
Gerd Moellmann <gerd@gnu.org>
parents:
37217
diff
changeset
|
977 BUFFERP (tem1) |
b9cea35cf91f
(save_excursion_restore): Don't use XBUFFER on
Gerd Moellmann <gerd@gnu.org>
parents:
37217
diff
changeset
|
978 /* ...and it shows the current buffer. */ |
b9cea35cf91f
(save_excursion_restore): Don't use XBUFFER on
Gerd Moellmann <gerd@gnu.org>
parents:
37217
diff
changeset
|
979 && XBUFFER (tem1) == current_buffer))) |
32420
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
980 Fset_window_point (tem, make_number (PT)); |
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
981 |
15075
e8613675066c
(save_excursion_restore): Add gcpros.
Richard M. Stallman <rms@gnu.org>
parents:
15015
diff
changeset
|
982 UNGCPRO; |
305 | 983 return Qnil; |
984 } | |
985 | |
986 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
|
987 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
|
988 Executes BODY just like `progn'. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
989 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
|
990 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
|
991 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
|
992 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
993 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
|
994 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
|
995 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
|
996 `deactivate-mark' with `let'. |
9bf80d5fff41
(Fsave_excursion, Fsave_current_buffer)
Miles Bader <miles@gnu.org>
parents:
40131
diff
changeset
|
997 |
9bf80d5fff41
(Fsave_excursion, Fsave_current_buffer)
Miles Bader <miles@gnu.org>
parents:
40131
diff
changeset
|
998 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
|
999 (args) |
305 | 1000 Lisp_Object args; |
1001 { | |
1002 register Lisp_Object val; | |
46293
1fb8f75062c6
Use macro SPECPDL_INDEX.
Juanma Barranquero <lekktu@gmail.com>
parents:
45398
diff
changeset
|
1003 int count = SPECPDL_INDEX (); |
305 | 1004 |
1005 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
|
1006 |
17304eb73f97
(Fsave_current_buffer): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16269
diff
changeset
|
1007 val = Fprogn (args); |
17304eb73f97
(Fsave_current_buffer): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16269
diff
changeset
|
1008 return unbind_to (count, val); |
17304eb73f97
(Fsave_current_buffer): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16269
diff
changeset
|
1009 } |
17304eb73f97
(Fsave_current_buffer): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16269
diff
changeset
|
1010 |
17304eb73f97
(Fsave_current_buffer): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16269
diff
changeset
|
1011 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
|
1012 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
|
1013 Executes BODY just like `progn'. |
9bf80d5fff41
(Fsave_excursion, Fsave_current_buffer)
Miles Bader <miles@gnu.org>
parents:
40131
diff
changeset
|
1014 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
|
1015 (args) |
16298
17304eb73f97
(Fsave_current_buffer): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16269
diff
changeset
|
1016 Lisp_Object args; |
17304eb73f97
(Fsave_current_buffer): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16269
diff
changeset
|
1017 { |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
1018 Lisp_Object val; |
46293
1fb8f75062c6
Use macro SPECPDL_INDEX.
Juanma Barranquero <lekktu@gmail.com>
parents:
45398
diff
changeset
|
1019 int count = SPECPDL_INDEX (); |
16298
17304eb73f97
(Fsave_current_buffer): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16269
diff
changeset
|
1020 |
20696
cdbe4824e7f1
(Fsave_current_buffer): Use set_buffer_if_live.
Richard M. Stallman <rms@gnu.org>
parents:
20688
diff
changeset
|
1021 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
|
1022 |
305 | 1023 val = Fprogn (args); |
1024 return unbind_to (count, val); | |
1025 } | |
1026 | |
25608
1cdab17df2b3
(Fbufsize): Accept an extra BUFFER parameter.
Richard M. Stallman <rms@gnu.org>
parents:
25507
diff
changeset
|
1027 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
|
1028 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
|
1029 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
|
1030 (buffer) |
25608
1cdab17df2b3
(Fbufsize): Accept an extra BUFFER parameter.
Richard M. Stallman <rms@gnu.org>
parents:
25507
diff
changeset
|
1031 Lisp_Object buffer; |
305 | 1032 { |
25608
1cdab17df2b3
(Fbufsize): Accept an extra BUFFER parameter.
Richard M. Stallman <rms@gnu.org>
parents:
25507
diff
changeset
|
1033 if (NILP (buffer)) |
1cdab17df2b3
(Fbufsize): Accept an extra BUFFER parameter.
Richard M. Stallman <rms@gnu.org>
parents:
25507
diff
changeset
|
1034 return make_number (Z - BEG); |
25609
157f0e91232e
Clear up previous change.
Richard M. Stallman <rms@gnu.org>
parents:
25608
diff
changeset
|
1035 else |
157f0e91232e
Clear up previous change.
Richard M. Stallman <rms@gnu.org>
parents:
25608
diff
changeset
|
1036 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
1037 CHECK_BUFFER (buffer); |
25609
157f0e91232e
Clear up previous change.
Richard M. Stallman <rms@gnu.org>
parents:
25608
diff
changeset
|
1038 return make_number (BUF_Z (XBUFFER (buffer)) |
157f0e91232e
Clear up previous change.
Richard M. Stallman <rms@gnu.org>
parents:
25608
diff
changeset
|
1039 - BUF_BEG (XBUFFER (buffer))); |
157f0e91232e
Clear up previous change.
Richard M. Stallman <rms@gnu.org>
parents:
25608
diff
changeset
|
1040 } |
305 | 1041 } |
1042 | |
1043 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
|
1044 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
|
1045 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
|
1046 () |
305 | 1047 { |
1048 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
|
1049 XSETFASTINT (temp, BEGV); |
305 | 1050 return temp; |
1051 } | |
1052 | |
1053 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
|
1054 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
|
1055 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
|
1056 () |
305 | 1057 { |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
1058 return buildmark (BEGV, BEGV_BYTE); |
305 | 1059 } |
1060 | |
1061 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
|
1062 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
|
1063 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
|
1064 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
|
1065 () |
305 | 1066 { |
1067 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
|
1068 XSETFASTINT (temp, ZV); |
305 | 1069 return temp; |
1070 } | |
1071 | |
1072 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
|
1073 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
|
1074 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
|
1075 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
|
1076 () |
305 | 1077 { |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
1078 return buildmark (ZV, ZV_BYTE); |
305 | 1079 } |
1080 | |
21821
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
1081 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
|
1082 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
|
1083 See also `gap-size'. */) |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1084 () |
21821
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
1085 { |
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
1086 Lisp_Object temp; |
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
1087 XSETFASTINT (temp, GPT); |
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
1088 return temp; |
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
1089 } |
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 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
|
1092 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
|
1093 See also `gap-position'. */) |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1094 () |
21821
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
1095 { |
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
1096 Lisp_Object temp; |
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
1097 XSETFASTINT (temp, GAP_SIZE); |
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
1098 return temp; |
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
1099 } |
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
1100 |
20861
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
1101 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
|
1102 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
|
1103 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
|
1104 (position) |
20879
64d2baa47498
(Fposition_bytes): Declare arg POSITION as Lips_Object.
Kenichi Handa <handa@m17n.org>
parents:
20878
diff
changeset
|
1105 Lisp_Object position; |
20861
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
1106 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
1107 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
|
1108 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
|
1109 return Qnil; |
20878
34e0c8eb49eb
(Fposition_bytes): Allow marker as arg POSITION. Use
Kenichi Handa <handa@m17n.org>
parents:
20861
diff
changeset
|
1110 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
|
1111 } |
22645
e5b201634497
(Fbyte_to_position): New function.
Richard M. Stallman <rms@gnu.org>
parents:
22199
diff
changeset
|
1112 |
e5b201634497
(Fbyte_to_position): New function.
Richard M. Stallman <rms@gnu.org>
parents:
22199
diff
changeset
|
1113 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
|
1114 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
|
1115 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
|
1116 (bytepos) |
22645
e5b201634497
(Fbyte_to_position): New function.
Richard M. Stallman <rms@gnu.org>
parents:
22199
diff
changeset
|
1117 Lisp_Object bytepos; |
e5b201634497
(Fbyte_to_position): New function.
Richard M. Stallman <rms@gnu.org>
parents:
22199
diff
changeset
|
1118 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
1119 CHECK_NUMBER (bytepos); |
23132
1c8e0e09aea1
(Fposition_bytes): If the arg POSITION is out of
Kenichi Handa <handa@m17n.org>
parents:
23063
diff
changeset
|
1120 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
|
1121 return Qnil; |
22645
e5b201634497
(Fbyte_to_position): New function.
Richard M. Stallman <rms@gnu.org>
parents:
22199
diff
changeset
|
1122 return make_number (BYTE_TO_CHAR (XINT (bytepos))); |
e5b201634497
(Fbyte_to_position): New function.
Richard M. Stallman <rms@gnu.org>
parents:
22199
diff
changeset
|
1123 } |
20861
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
1124 |
512 | 1125 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
|
1126 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
|
1127 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
|
1128 () |
305 | 1129 { |
1130 Lisp_Object temp; | |
16039
855c8d8ba0f0
Change all references from point to PT.
Karl Heuer <kwzh@gnu.org>
parents:
15910
diff
changeset
|
1131 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
|
1132 XSETFASTINT (temp, 0); |
512 | 1133 else |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
1134 XSETFASTINT (temp, FETCH_CHAR (PT_BYTE)); |
305 | 1135 return temp; |
1136 } | |
1137 | |
512 | 1138 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
|
1139 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
|
1140 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
|
1141 () |
305 | 1142 { |
1143 Lisp_Object temp; | |
16039
855c8d8ba0f0
Change all references from point to PT.
Karl Heuer <kwzh@gnu.org>
parents:
15910
diff
changeset
|
1144 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
|
1145 XSETFASTINT (temp, 0); |
17031 | 1146 else if (!NILP (current_buffer->enable_multibyte_characters)) |
1147 { | |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
1148 int pos = PT_BYTE; |
17031 | 1149 DEC_POS (pos); |
1150 XSETFASTINT (temp, FETCH_CHAR (pos)); | |
1151 } | |
305 | 1152 else |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
1153 XSETFASTINT (temp, FETCH_BYTE (PT_BYTE - 1)); |
305 | 1154 return temp; |
1155 } | |
1156 | |
1157 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
|
1158 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
|
1159 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
|
1160 () |
305 | 1161 { |
16039
855c8d8ba0f0
Change all references from point to PT.
Karl Heuer <kwzh@gnu.org>
parents:
15910
diff
changeset
|
1162 if (PT == BEGV) |
305 | 1163 return Qt; |
1164 return Qnil; | |
1165 } | |
1166 | |
1167 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
|
1168 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
|
1169 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
|
1170 () |
305 | 1171 { |
16039
855c8d8ba0f0
Change all references from point to PT.
Karl Heuer <kwzh@gnu.org>
parents:
15910
diff
changeset
|
1172 if (PT == ZV) |
305 | 1173 return Qt; |
1174 return Qnil; | |
1175 } | |
1176 | |
1177 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
|
1178 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
|
1179 () |
305 | 1180 { |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
1181 if (PT == BEGV || FETCH_BYTE (PT_BYTE - 1) == '\n') |
305 | 1182 return Qt; |
1183 return Qnil; | |
1184 } | |
1185 | |
1186 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
|
1187 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
|
1188 `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
|
1189 () |
305 | 1190 { |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
1191 if (PT == ZV || FETCH_BYTE (PT_BYTE) == '\n') |
305 | 1192 return Qt; |
1193 return Qnil; | |
1194 } | |
1195 | |
18252
9c4fb902b6eb
(Fchar_after, Fchar_before): Make arg optional.
Richard M. Stallman <rms@gnu.org>
parents:
18240
diff
changeset
|
1196 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
|
1197 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
|
1198 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
|
1199 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
|
1200 (pos) |
305 | 1201 Lisp_Object pos; |
1202 { | |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
1203 register int pos_byte; |
305 | 1204 |
18252
9c4fb902b6eb
(Fchar_after, Fchar_before): Make arg optional.
Richard M. Stallman <rms@gnu.org>
parents:
18240
diff
changeset
|
1205 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
|
1206 { |
edca9002c740
(Fchar_after): Make nil fully equivalent to (point) as arg.
Richard M. Stallman <rms@gnu.org>
parents:
21914
diff
changeset
|
1207 pos_byte = PT_BYTE; |
23577
36cccf1ba0a9
(Fchar_after): Fix type clashes.
Andreas Schwab <schwab@suse.de>
parents:
23565
diff
changeset
|
1208 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
|
1209 } |
edca9002c740
(Fchar_after): Make nil fully equivalent to (point) as arg.
Richard M. Stallman <rms@gnu.org>
parents:
21914
diff
changeset
|
1210 |
edca9002c740
(Fchar_after): Make nil fully equivalent to (point) as arg.
Richard M. Stallman <rms@gnu.org>
parents:
21914
diff
changeset
|
1211 if (MARKERP (pos)) |
21200
ea520c42a342
(Fchar_after, Fchar_before): Properly check arg type
Richard M. Stallman <rms@gnu.org>
parents:
21064
diff
changeset
|
1212 { |
ea520c42a342
(Fchar_after, Fchar_before): Properly check arg type
Richard M. Stallman <rms@gnu.org>
parents:
21064
diff
changeset
|
1213 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
|
1214 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
|
1215 return Qnil; |
ea520c42a342
(Fchar_after, Fchar_before): Properly check arg type
Richard M. Stallman <rms@gnu.org>
parents:
21064
diff
changeset
|
1216 } |
18252
9c4fb902b6eb
(Fchar_after, Fchar_before): Make arg optional.
Richard M. Stallman <rms@gnu.org>
parents:
18240
diff
changeset
|
1217 else |
9c4fb902b6eb
(Fchar_after, Fchar_before): Make arg optional.
Richard M. Stallman <rms@gnu.org>
parents:
18240
diff
changeset
|
1218 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
1219 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
|
1220 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
|
1221 return Qnil; |
30480 | 1222 |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
1223 pos_byte = CHAR_TO_BYTE (XINT (pos)); |
18252
9c4fb902b6eb
(Fchar_after, Fchar_before): Make arg optional.
Richard M. Stallman <rms@gnu.org>
parents:
18240
diff
changeset
|
1224 } |
305 | 1225 |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
1226 return make_number (FETCH_CHAR (pos_byte)); |
305 | 1227 } |
17031 | 1228 |
18252
9c4fb902b6eb
(Fchar_after, Fchar_before): Make arg optional.
Richard M. Stallman <rms@gnu.org>
parents:
18240
diff
changeset
|
1229 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
|
1230 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
|
1231 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
|
1232 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
|
1233 (pos) |
17031 | 1234 Lisp_Object pos; |
1235 { | |
1236 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
|
1237 register int pos_byte; |
17031 | 1238 |
18252
9c4fb902b6eb
(Fchar_after, Fchar_before): Make arg optional.
Richard M. Stallman <rms@gnu.org>
parents:
18240
diff
changeset
|
1239 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
|
1240 { |
edca9002c740
(Fchar_after): Make nil fully equivalent to (point) as arg.
Richard M. Stallman <rms@gnu.org>
parents:
21914
diff
changeset
|
1241 pos_byte = PT_BYTE; |
23577
36cccf1ba0a9
(Fchar_after): Fix type clashes.
Andreas Schwab <schwab@suse.de>
parents:
23565
diff
changeset
|
1242 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
|
1243 } |
edca9002c740
(Fchar_after): Make nil fully equivalent to (point) as arg.
Richard M. Stallman <rms@gnu.org>
parents:
21914
diff
changeset
|
1244 |
edca9002c740
(Fchar_after): Make nil fully equivalent to (point) as arg.
Richard M. Stallman <rms@gnu.org>
parents:
21914
diff
changeset
|
1245 if (MARKERP (pos)) |
21200
ea520c42a342
(Fchar_after, Fchar_before): Properly check arg type
Richard M. Stallman <rms@gnu.org>
parents:
21064
diff
changeset
|
1246 { |
ea520c42a342
(Fchar_after, Fchar_before): Properly check arg type
Richard M. Stallman <rms@gnu.org>
parents:
21064
diff
changeset
|
1247 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
|
1248 |
ea520c42a342
(Fchar_after, Fchar_before): Properly check arg type
Richard M. Stallman <rms@gnu.org>
parents:
21064
diff
changeset
|
1249 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
|
1250 return Qnil; |
ea520c42a342
(Fchar_after, Fchar_before): Properly check arg type
Richard M. Stallman <rms@gnu.org>
parents:
21064
diff
changeset
|
1251 } |
18252
9c4fb902b6eb
(Fchar_after, Fchar_before): Make arg optional.
Richard M. Stallman <rms@gnu.org>
parents:
18240
diff
changeset
|
1252 else |
9c4fb902b6eb
(Fchar_after, Fchar_before): Make arg optional.
Richard M. Stallman <rms@gnu.org>
parents:
18240
diff
changeset
|
1253 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
1254 CHECK_NUMBER_COERCE_MARKER (pos); |
17031 | 1255 |
21521
354a7085f1d7
(Fchar_after, Fchar_before): Fix mixing of Lisp_Object
Andreas Schwab <schwab@suse.de>
parents:
21514
diff
changeset
|
1256 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
|
1257 return Qnil; |
ea520c42a342
(Fchar_after, Fchar_before): Properly check arg type
Richard M. Stallman <rms@gnu.org>
parents:
21064
diff
changeset
|
1258 |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
1259 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
|
1260 } |
17031 | 1261 |
1262 if (!NILP (current_buffer->enable_multibyte_characters)) | |
1263 { | |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
1264 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
|
1265 XSETFASTINT (val, FETCH_CHAR (pos_byte)); |
17031 | 1266 } |
1267 else | |
1268 { | |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
1269 pos_byte--; |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
1270 XSETFASTINT (val, FETCH_BYTE (pos_byte)); |
17031 | 1271 } |
1272 return val; | |
1273 } | |
305 | 1274 |
9572 | 1275 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
|
1276 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
|
1277 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
|
1278 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
|
1279 that determines the value of this function. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1280 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1281 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
|
1282 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
|
1283 (uid) |
9572 | 1284 Lisp_Object uid; |
305 | 1285 { |
9572 | 1286 struct passwd *pw; |
1287 | |
9520
5187a4159d16
(Fuser_login_name, Fuser_real_login_name):
Richard M. Stallman <rms@gnu.org>
parents:
9305
diff
changeset
|
1288 /* 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
|
1289 (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
|
1290 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
|
1291 if (INTEGERP (Vuser_login_name)) |
9520
5187a4159d16
(Fuser_login_name, Fuser_real_login_name):
Richard M. Stallman <rms@gnu.org>
parents:
9305
diff
changeset
|
1292 init_editfns (); |
9572 | 1293 |
1294 if (NILP (uid)) | |
12026
505a894d943e
(syms_of_editfns): user-login-name renamed from user-name.
Karl Heuer <kwzh@gnu.org>
parents:
11912
diff
changeset
|
1295 return Vuser_login_name; |
9572 | 1296 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
1297 CHECK_NUMBER (uid); |
71817
fb57c1830788
Include blockinput.h.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents:
71498
diff
changeset
|
1298 BLOCK_INPUT; |
9572 | 1299 pw = (struct passwd *) getpwuid (XINT (uid)); |
71817
fb57c1830788
Include blockinput.h.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents:
71498
diff
changeset
|
1300 UNBLOCK_INPUT; |
9572 | 1301 return (pw ? build_string (pw->pw_name) : Qnil); |
305 | 1302 } |
1303 | |
1304 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
|
1305 0, 0, 0, |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1306 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
|
1307 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
|
1308 `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
|
1309 () |
305 | 1310 { |
9520
5187a4159d16
(Fuser_login_name, Fuser_real_login_name):
Richard M. Stallman <rms@gnu.org>
parents:
9305
diff
changeset
|
1311 /* 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
|
1312 (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
|
1313 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
|
1314 if (INTEGERP (Vuser_login_name)) |
9520
5187a4159d16
(Fuser_login_name, Fuser_real_login_name):
Richard M. Stallman <rms@gnu.org>
parents:
9305
diff
changeset
|
1315 init_editfns (); |
12026
505a894d943e
(syms_of_editfns): user-login-name renamed from user-name.
Karl Heuer <kwzh@gnu.org>
parents:
11912
diff
changeset
|
1316 return Vuser_real_login_name; |
305 | 1317 } |
1318 | |
1319 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
|
1320 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
|
1321 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
|
1322 () |
305 | 1323 { |
75217
9e5c071deb9f
(Fuser_uid, Fuser_real_uid): Copy values returned by geteuid and getuid
Eli Zaretskii <eliz@gnu.org>
parents:
75181
diff
changeset
|
1324 /* Assignment to EMACS_INT stops GCC whining about limited range of |
9e5c071deb9f
(Fuser_uid, Fuser_real_uid): Copy values returned by geteuid and getuid
Eli Zaretskii <eliz@gnu.org>
parents:
75181
diff
changeset
|
1325 data type. */ |
9e5c071deb9f
(Fuser_uid, Fuser_real_uid): Copy values returned by geteuid and getuid
Eli Zaretskii <eliz@gnu.org>
parents:
75181
diff
changeset
|
1326 EMACS_INT euid = geteuid (); |
9e5c071deb9f
(Fuser_uid, Fuser_real_uid): Copy values returned by geteuid and getuid
Eli Zaretskii <eliz@gnu.org>
parents:
75181
diff
changeset
|
1327 return make_fixnum_or_float (euid); |
305 | 1328 } |
1329 | |
1330 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
|
1331 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
|
1332 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
|
1333 () |
305 | 1334 { |
75217
9e5c071deb9f
(Fuser_uid, Fuser_real_uid): Copy values returned by geteuid and getuid
Eli Zaretskii <eliz@gnu.org>
parents:
75181
diff
changeset
|
1335 /* Assignment to EMACS_INT stops GCC whining about limited range of |
9e5c071deb9f
(Fuser_uid, Fuser_real_uid): Copy values returned by geteuid and getuid
Eli Zaretskii <eliz@gnu.org>
parents:
75181
diff
changeset
|
1336 data type. */ |
9e5c071deb9f
(Fuser_uid, Fuser_real_uid): Copy values returned by geteuid and getuid
Eli Zaretskii <eliz@gnu.org>
parents:
75181
diff
changeset
|
1337 EMACS_INT uid = getuid (); |
9e5c071deb9f
(Fuser_uid, Fuser_real_uid): Copy values returned by geteuid and getuid
Eli Zaretskii <eliz@gnu.org>
parents:
75181
diff
changeset
|
1338 return make_fixnum_or_float (uid); |
305 | 1339 } |
1340 | |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
1341 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
|
1342 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
|
1343 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
|
1344 return "unknown". |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1345 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1346 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
|
1347 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
|
1348 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
|
1349 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
|
1350 (uid) |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
1351 Lisp_Object uid; |
305 | 1352 { |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
1353 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
|
1354 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
|
1355 Lisp_Object full; |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
1356 |
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
1357 if (NILP (uid)) |
30480 | 1358 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
|
1359 else if (NUMBERP (uid)) |
71817
fb57c1830788
Include blockinput.h.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents:
71498
diff
changeset
|
1360 { |
fb57c1830788
Include blockinput.h.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents:
71498
diff
changeset
|
1361 BLOCK_INPUT; |
fb57c1830788
Include blockinput.h.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents:
71498
diff
changeset
|
1362 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
|
1363 UNBLOCK_INPUT; |
fb57c1830788
Include blockinput.h.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents:
71498
diff
changeset
|
1364 } |
30480 | 1365 else if (STRINGP (uid)) |
71817
fb57c1830788
Include blockinput.h.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents:
71498
diff
changeset
|
1366 { |
fb57c1830788
Include blockinput.h.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents:
71498
diff
changeset
|
1367 BLOCK_INPUT; |
fb57c1830788
Include blockinput.h.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents:
71498
diff
changeset
|
1368 pw = (struct passwd *) getpwnam (SDATA (uid)); |
fb57c1830788
Include blockinput.h.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents:
71498
diff
changeset
|
1369 UNBLOCK_INPUT; |
fb57c1830788
Include blockinput.h.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents:
71498
diff
changeset
|
1370 } |
16641
2103a88cc61f
(Fuser_full_name): Accept a string (the login name) as
Richard M. Stallman <rms@gnu.org>
parents:
16639
diff
changeset
|
1371 else |
2103a88cc61f
(Fuser_full_name): Accept a string (the login name) as
Richard M. Stallman <rms@gnu.org>
parents:
16639
diff
changeset
|
1372 error ("Invalid UID specification"); |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
1373 |
16641
2103a88cc61f
(Fuser_full_name): Accept a string (the login name) as
Richard M. Stallman <rms@gnu.org>
parents:
16639
diff
changeset
|
1374 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
|
1375 return Qnil; |
30480 | 1376 |
97655
287457e9bac1
(USER_FULL_NAME): Define to pw->pw_gecos if undefined.
Eli Zaretskii <eliz@gnu.org>
parents:
96718
diff
changeset
|
1377 p = (unsigned char *) USER_FULL_NAME; |
16641
2103a88cc61f
(Fuser_full_name): Accept a string (the login name) as
Richard M. Stallman <rms@gnu.org>
parents:
16639
diff
changeset
|
1378 /* 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
|
1379 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
|
1380 full = make_string (p, q ? q - p : strlen (p)); |
30480 | 1381 |
16641
2103a88cc61f
(Fuser_full_name): Accept a string (the login name) as
Richard M. Stallman <rms@gnu.org>
parents:
16639
diff
changeset
|
1382 #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
|
1383 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
|
1384 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
|
1385 /* 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
|
1386 if (q) |
2103a88cc61f
(Fuser_full_name): Accept a string (the login name) as
Richard M. Stallman <rms@gnu.org>
parents:
16639
diff
changeset
|
1387 { |
18661
537522d5e6d8
(Fuser_full_name): Declare p, q and r as unsigned char *.
Richard M. Stallman <rms@gnu.org>
parents:
18613
diff
changeset
|
1388 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
|
1389 Lisp_Object login; |
2103a88cc61f
(Fuser_full_name): Accept a string (the login name) as
Richard M. Stallman <rms@gnu.org>
parents:
16639
diff
changeset
|
1390 |
2103a88cc61f
(Fuser_full_name): Accept a string (the login name) as
Richard M. Stallman <rms@gnu.org>
parents:
16639
diff
changeset
|
1391 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
|
1392 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
|
1393 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
|
1394 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
|
1395 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
|
1396 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
|
1397 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
|
1398 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
|
1399 } |
2103a88cc61f
(Fuser_full_name): Accept a string (the login name) as
Richard M. Stallman <rms@gnu.org>
parents:
16639
diff
changeset
|
1400 #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
|
1401 |
2103a88cc61f
(Fuser_full_name): Accept a string (the login name) as
Richard M. Stallman <rms@gnu.org>
parents:
16639
diff
changeset
|
1402 return full; |
305 | 1403 } |
1404 | |
1405 DEFUN ("system-name", Fsystem_name, Ssystem_name, 0, 0, 0, | |
72751
9128a4531448
(Fsystem_name): Mention "host" in the doc string.
Eli Zaretskii <eliz@gnu.org>
parents:
72669
diff
changeset
|
1406 doc: /* Return the host name of the machine you are running on, as a string. */) |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1407 () |
305 | 1408 { |
1409 return Vsystem_name; | |
1410 } | |
1411 | |
7907
148ad20d6774
(init_editfns): Call init_system_name instead of get_system_name.
Karl Heuer <kwzh@gnu.org>
parents:
7862
diff
changeset
|
1412 /* 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
|
1413 |
7907
148ad20d6774
(init_editfns): Call init_system_name instead of get_system_name.
Karl Heuer <kwzh@gnu.org>
parents:
7862
diff
changeset
|
1414 char * |
148ad20d6774
(init_editfns): Call init_system_name instead of get_system_name.
Karl Heuer <kwzh@gnu.org>
parents:
7862
diff
changeset
|
1415 get_system_name () |
148ad20d6774
(init_editfns): Call init_system_name instead of get_system_name.
Karl Heuer <kwzh@gnu.org>
parents:
7862
diff
changeset
|
1416 { |
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
|
1417 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
|
1418 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
|
1419 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
|
1420 return ""; |
7907
148ad20d6774
(init_editfns): Call init_system_name instead of get_system_name.
Karl Heuer <kwzh@gnu.org>
parents:
7862
diff
changeset
|
1421 } |
148ad20d6774
(init_editfns): Call init_system_name instead of get_system_name.
Karl Heuer <kwzh@gnu.org>
parents:
7862
diff
changeset
|
1422 |
59658
45074d913d23
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
59644
diff
changeset
|
1423 char * |
45074d913d23
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
59644
diff
changeset
|
1424 get_operating_system_release() |
45074d913d23
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
59644
diff
changeset
|
1425 { |
45074d913d23
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
59644
diff
changeset
|
1426 if (STRINGP (Voperating_system_release)) |
45074d913d23
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
59644
diff
changeset
|
1427 return (char *) SDATA (Voperating_system_release); |
45074d913d23
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
59644
diff
changeset
|
1428 else |
45074d913d23
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
59644
diff
changeset
|
1429 return ""; |
45074d913d23
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
59644
diff
changeset
|
1430 } |
45074d913d23
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
59644
diff
changeset
|
1431 |
5373
a70b89d2d6bb
(Femacs_pid): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5242
diff
changeset
|
1432 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
|
1433 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
|
1434 () |
5373
a70b89d2d6bb
(Femacs_pid): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5242
diff
changeset
|
1435 { |
a70b89d2d6bb
(Femacs_pid): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5242
diff
changeset
|
1436 return make_number (getpid ()); |
a70b89d2d6bb
(Femacs_pid): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5242
diff
changeset
|
1437 } |
a70b89d2d6bb
(Femacs_pid): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5242
diff
changeset
|
1438 |
448 | 1439 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
|
1440 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
|
1441 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
|
1442 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
|
1443 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
|
1444 count. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1445 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1446 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
|
1447 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
|
1448 () |
448 | 1449 { |
577 | 1450 EMACS_TIME t; |
1451 | |
1452 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
|
1453 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
|
1454 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
|
1455 make_number (EMACS_USECS (t))); |
448 | 1456 } |
57987
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1457 |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1458 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
|
1459 0, 0, 0, |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1460 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
|
1461 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
|
1462 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
|
1463 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
|
1464 count. |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1465 |
75387
41b2aae64f85
(Finsert_char): Doc fix.
Juanma Barranquero <lekktu@gmail.com>
parents:
75217
diff
changeset
|
1466 On systems that can't determine the run time, `get-internal-run-time' |
41b2aae64f85
(Finsert_char): Doc fix.
Juanma Barranquero <lekktu@gmail.com>
parents:
75217
diff
changeset
|
1467 does the same thing as `current-time'. The microsecond count is zero |
41b2aae64f85
(Finsert_char): Doc fix.
Juanma Barranquero <lekktu@gmail.com>
parents:
75217
diff
changeset
|
1468 on systems that do not provide resolution finer than a second. */) |
57987
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1469 () |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1470 { |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1471 #ifdef HAVE_GETRUSAGE |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1472 struct rusage usage; |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1473 int secs, usecs; |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1474 |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1475 if (getrusage (RUSAGE_SELF, &usage) < 0) |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1476 /* 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
|
1477 xsignal0 (Qerror); |
57987
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1478 |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1479 /* Sum up user time and system time. */ |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1480 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
|
1481 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
|
1482 if (usecs >= 1000000) |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1483 { |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1484 usecs -= 1000000; |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1485 secs++; |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1486 } |
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1487 |
72531
90bdf0a2ff4c
(Fcurrent_time, Fget_internal_run_time): Simplify; use list3.
Kim F. Storm <storm@cua.dk>
parents:
72272
diff
changeset
|
1488 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
|
1489 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
|
1490 make_number (usecs)); |
81422
9086f0548bdc
(Fget_internal_run_time) [WINDOWSNT]: Use w32_get_internal_run_time.
Jason Rumney <jasonr@gnu.org>
parents:
81286
diff
changeset
|
1491 #else /* ! HAVE_GETRUSAGE */ |
96348
ecd6143014da
Remove unneeded -Defines in the compiler command line (MinGW and MSVC).
Juanma Barranquero <lekktu@gmail.com>
parents:
95479
diff
changeset
|
1492 #ifdef WINDOWSNT |
81422
9086f0548bdc
(Fget_internal_run_time) [WINDOWSNT]: Use w32_get_internal_run_time.
Jason Rumney <jasonr@gnu.org>
parents:
81286
diff
changeset
|
1493 return w32_get_internal_run_time (); |
9086f0548bdc
(Fget_internal_run_time) [WINDOWSNT]: Use w32_get_internal_run_time.
Jason Rumney <jasonr@gnu.org>
parents:
81286
diff
changeset
|
1494 #else /* ! WINDOWSNT */ |
57987
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1495 return Fcurrent_time (); |
81422
9086f0548bdc
(Fget_internal_run_time) [WINDOWSNT]: Use w32_get_internal_run_time.
Jason Rumney <jasonr@gnu.org>
parents:
81286
diff
changeset
|
1496 #endif /* WINDOWSNT */ |
9086f0548bdc
(Fget_internal_run_time) [WINDOWSNT]: Use w32_get_internal_run_time.
Jason Rumney <jasonr@gnu.org>
parents:
81286
diff
changeset
|
1497 #endif /* HAVE_GETRUSAGE */ |
57987
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
1498 } |
448 | 1499 |
1500 | |
55193
1b09eb24ab02
(lisp_time_argument): Provide externally.
Eli Zaretskii <eliz@gnu.org>
parents:
54846
diff
changeset
|
1501 int |
30480 | 1502 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
|
1503 Lisp_Object specified_time; |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1504 time_t *result; |
30480 | 1505 int *usec; |
2921
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1506 { |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1507 if (NILP (specified_time)) |
30480 | 1508 { |
1509 if (usec) | |
1510 { | |
1511 EMACS_TIME t; | |
1512 | |
30503
fef49230e1aa
(lisp_time_argument): Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents:
30480
diff
changeset
|
1513 EMACS_GET_TIME (t); |
30480 | 1514 *usec = EMACS_USECS (t); |
1515 *result = EMACS_SECS (t); | |
1516 return 1; | |
1517 } | |
1518 else | |
1519 return time (result) != -1; | |
1520 } | |
2921
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1521 else |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1522 { |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1523 Lisp_Object high, low; |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1524 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
|
1525 CHECK_NUMBER (high); |
2921
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1526 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
|
1527 if (CONSP (low)) |
30480 | 1528 { |
1529 if (usec) | |
1530 { | |
1531 Lisp_Object usec_l = Fcdr (low); | |
1532 if (CONSP (usec_l)) | |
1533 usec_l = Fcar (usec_l); | |
1534 if (NILP (usec_l)) | |
1535 *usec = 0; | |
1536 else | |
1537 { | |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
1538 CHECK_NUMBER (usec_l); |
30480 | 1539 *usec = XINT (usec_l); |
1540 } | |
1541 } | |
1542 low = Fcar (low); | |
1543 } | |
1544 else if (usec) | |
1545 *usec = 0; | |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
1546 CHECK_NUMBER (low); |
2921
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1547 *result = (XINT (high) << 16) + (XINT (low) & 0xffff); |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1548 return *result >> 16 == XINT (high); |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1549 } |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1550 } |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1551 |
30480 | 1552 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
|
1553 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
|
1554 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
|
1555 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
|
1556 (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
|
1557 `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
|
1558 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
|
1559 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1560 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
|
1561 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
|
1562 (specified_time) |
30480 | 1563 Lisp_Object specified_time; |
1564 { | |
1565 time_t sec; | |
1566 int usec; | |
1567 | |
1568 if (! lisp_time_argument (specified_time, &sec, &usec)) | |
1569 error ("Invalid time specification"); | |
1570 | |
37046
a9b2639dd045
(Ffloat_time): Fix off-by-factor-of-10 bug in the
Gerd Moellmann <gerd@gnu.org>
parents:
36479
diff
changeset
|
1571 return make_float ((sec * 1e6 + usec) / 1e6); |
30480 | 1572 } |
1573 | |
23213
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1574 /* 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
|
1575 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
|
1576 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
|
1577 Return the number of bytes written, not including the terminating |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1578 '\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
|
1579 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
|
1580 ((size_t) -1) for MAXSIZE. |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1581 |
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
parents:
26058
diff
changeset
|
1582 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
|
1583 bytes in FORMAT. */ |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1584 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
|
1585 emacs_memftimeu (s, maxsize, format, format_len, tp, ut) |
23213
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1586 char *s; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1587 size_t maxsize; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1588 const char *format; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1589 size_t format_len; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1590 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
|
1591 int ut; |
23213
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 size_t total = 0; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1594 |
23218
90e5d916ebd9
Add a comment to emacs_memftime, explaining why it needs to loop.
Paul Eggert <eggert@twinsun.com>
parents:
23213
diff
changeset
|
1595 /* 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
|
1596 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
|
1597 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
|
1598 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
|
1599 '\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
|
1600 for (;;) |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1601 { |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1602 size_t len; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1603 size_t result; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1604 |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1605 if (s) |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1606 s[0] = '\1'; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1607 |
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
parents:
26058
diff
changeset
|
1608 result = emacs_strftimeu (s, maxsize, format, tp, ut); |
23213
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1609 |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1610 if (s) |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1611 { |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1612 if (result == 0 && s[0] != '\0') |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1613 return 0; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1614 s += result + 1; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1615 } |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1616 |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1617 maxsize -= result + 1; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1618 total += result; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1619 len = strlen (format); |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1620 if (len == format_len) |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1621 return total; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1622 total++; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1623 format += len + 1; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1624 format_len -= len + 1; |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1625 } |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1626 } |
3bfc1e9b0377
(emacs_memftime): New function.
Paul Eggert <eggert@twinsun.com>
parents:
23211
diff
changeset
|
1627 |
17907
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1628 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
|
1629 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
|
1630 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
|
1631 `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
|
1632 is also still accepted. |
39966
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1633 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
|
1634 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
|
1635 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
|
1636 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
|
1637 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1638 %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
|
1639 %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
|
1640 %m is the numeric month. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1641 %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
|
1642 %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
|
1643 %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
|
1644 %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
|
1645 %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
|
1646 %V according to ISO 8601. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1647 %j is the day of the year. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1648 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1649 %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
|
1650 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
|
1651 %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
|
1652 %M is the minute. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1653 %S is the second. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1654 %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
|
1655 %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
|
1656 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1657 %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
|
1658 %x is the locale's "preferred" date format. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1659 %D is like "%m/%d/%y". |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1660 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1661 %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
|
1662 %X is the locale's "preferred" time format. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1663 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1664 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
|
1665 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1666 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
|
1667 The flags are `_', `-', `^' and `#'. For certain characters X, |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1668 %_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
|
1669 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
|
1670 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
|
1671 all textual characters reversed. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1672 %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
|
1673 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
|
1674 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
|
1675 %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
|
1676 %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
|
1677 |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1678 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
|
1679 (format_string, time, universal) |
17907
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1680 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
|
1681 { |
b4739bcefc44
(Fformat_time_string): Mostly rewritten, to handle
Richard M. Stallman <rms@gnu.org>
parents:
8981
diff
changeset
|
1682 time_t value; |
b4739bcefc44
(Fformat_time_string): Mostly rewritten, to handle
Richard M. Stallman <rms@gnu.org>
parents:
8981
diff
changeset
|
1683 int size; |
23198
dddce768cf7a
(Fformat_time_string, Fdecode_time, Fcurrent_time_zone):
Paul Eggert <eggert@twinsun.com>
parents:
23197
diff
changeset
|
1684 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
|
1685 int ut = ! NILP (universal); |
9154
b4739bcefc44
(Fformat_time_string): Mostly rewritten, to handle
Richard M. Stallman <rms@gnu.org>
parents:
8981
diff
changeset
|
1686 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
1687 CHECK_STRING (format_string); |
9154
b4739bcefc44
(Fformat_time_string): Mostly rewritten, to handle
Richard M. Stallman <rms@gnu.org>
parents:
8981
diff
changeset
|
1688 |
30480 | 1689 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
|
1690 error ("Invalid time specification"); |
b4739bcefc44
(Fformat_time_string): Mostly rewritten, to handle
Richard M. Stallman <rms@gnu.org>
parents:
8981
diff
changeset
|
1691 |
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
parents:
26058
diff
changeset
|
1692 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
|
1693 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
|
1694 |
9154
b4739bcefc44
(Fformat_time_string): Mostly rewritten, to handle
Richard M. Stallman <rms@gnu.org>
parents:
8981
diff
changeset
|
1695 /* 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
|
1696 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
|
1697 |
75096
ca95b6ba52a9
(Fformat_time_string, Fdecode_time, Fencode_time)
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents:
73950
diff
changeset
|
1698 BLOCK_INPUT; |
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
parents:
26058
diff
changeset
|
1699 tm = ut ? gmtime (&value) : localtime (&value); |
75096
ca95b6ba52a9
(Fformat_time_string, Fdecode_time, Fencode_time)
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents:
73950
diff
changeset
|
1700 UNBLOCK_INPUT; |
23198
dddce768cf7a
(Fformat_time_string, Fdecode_time, Fcurrent_time_zone):
Paul Eggert <eggert@twinsun.com>
parents:
23197
diff
changeset
|
1701 if (! tm) |
dddce768cf7a
(Fformat_time_string, Fdecode_time, Fcurrent_time_zone):
Paul Eggert <eggert@twinsun.com>
parents:
23197
diff
changeset
|
1702 error ("Specified time is not representable"); |
dddce768cf7a
(Fformat_time_string, Fdecode_time, Fcurrent_time_zone):
Paul Eggert <eggert@twinsun.com>
parents:
23197
diff
changeset
|
1703 |
26526
b7438760079b
* callproc.c (strerror): Remove decl.
Paul Eggert <eggert@twinsun.com>
parents:
26415
diff
changeset
|
1704 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
|
1705 |
9154
b4739bcefc44
(Fformat_time_string): Mostly rewritten, to handle
Richard M. Stallman <rms@gnu.org>
parents:
8981
diff
changeset
|
1706 while (1) |
b4739bcefc44
(Fformat_time_string): Mostly rewritten, to handle
Richard M. Stallman <rms@gnu.org>
parents:
8981
diff
changeset
|
1707 { |
17907
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1708 char *buf = (char *) alloca (size + 1); |
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1709 int result; |
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1710 |
19032
84ae0a03a643
(Fformat_time_string): Don't hang if strftime produces
Richard M. Stallman <rms@gnu.org>
parents:
18937
diff
changeset
|
1711 buf[0] = '\1'; |
75096
ca95b6ba52a9
(Fformat_time_string, Fdecode_time, Fencode_time)
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents:
73950
diff
changeset
|
1712 BLOCK_INPUT; |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1713 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
|
1714 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
|
1715 tm, ut); |
75096
ca95b6ba52a9
(Fformat_time_string, Fdecode_time, Fencode_time)
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents:
73950
diff
changeset
|
1716 UNBLOCK_INPUT; |
19032
84ae0a03a643
(Fformat_time_string): Don't hang if strftime produces
Richard M. Stallman <rms@gnu.org>
parents:
18937
diff
changeset
|
1717 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
|
1718 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
|
1719 Vlocale_coding_system, 0); |
17907
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1720 |
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1721 /* If buffer was too small, make it bigger and try again. */ |
75096
ca95b6ba52a9
(Fformat_time_string, Fdecode_time, Fencode_time)
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents:
73950
diff
changeset
|
1722 BLOCK_INPUT; |
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
parents:
26058
diff
changeset
|
1723 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
|
1724 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
|
1725 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
|
1726 tm, ut); |
75096
ca95b6ba52a9
(Fformat_time_string, Fdecode_time, Fencode_time)
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents:
73950
diff
changeset
|
1727 UNBLOCK_INPUT; |
17907
a1f8ff84f3f1
(Fformat_time_string): Doc update.
Richard M. Stallman <rms@gnu.org>
parents:
17829
diff
changeset
|
1728 size = result + 1; |
9154
b4739bcefc44
(Fformat_time_string): Mostly rewritten, to handle
Richard M. Stallman <rms@gnu.org>
parents:
8981
diff
changeset
|
1729 } |
b4739bcefc44
(Fformat_time_string): Mostly rewritten, to handle
Richard M. Stallman <rms@gnu.org>
parents:
8981
diff
changeset
|
1730 } |
b4739bcefc44
(Fformat_time_string): Mostly rewritten, to handle
Richard M. Stallman <rms@gnu.org>
parents:
8981
diff
changeset
|
1731 |
9801
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
1732 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
|
1733 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
|
1734 The optional SPECIFIED-TIME should be a list of (HIGH LOW . IGNORED), |
75387
41b2aae64f85
(Finsert_char): Doc fix.
Juanma Barranquero <lekktu@gmail.com>
parents:
75217
diff
changeset
|
1735 as from `current-time' and `file-attributes', or nil to use the |
56386
4f00fbfe3c1e
(Ffloat_time, Fformat_time_string, Fdecode_time)
Luc Teirlinck <teirllm@auburn.edu>
parents:
56194
diff
changeset
|
1736 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
|
1737 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
|
1738 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
|
1739 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
|
1740 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
|
1741 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
|
1742 four-digit year. DOW is the day of week, an integer between 0 and 6, |
76509 | 1743 where 0 is Sunday. DST is t if daylight saving time is in effect, |
56386
4f00fbfe3c1e
(Ffloat_time, Fformat_time_string, Fdecode_time)
Luc Teirlinck <teirllm@auburn.edu>
parents:
56194
diff
changeset
|
1744 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
|
1745 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
|
1746 DOW and ZONE.) */) |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
1747 (specified_time) |
9801
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
1748 Lisp_Object specified_time; |
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
1749 { |
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
1750 time_t time_spec; |
9812
bc352c8f079c
(Fdecode_time): Fix Lisp_Object vs. integer problems.
Karl Heuer <kwzh@gnu.org>
parents:
9809
diff
changeset
|
1751 struct tm save_tm; |
9801
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
1752 struct tm *decoded_time; |
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
1753 Lisp_Object list_args[9]; |
30480 | 1754 |
1755 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
|
1756 error ("Invalid time specification"); |
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
1757 |
75096
ca95b6ba52a9
(Fformat_time_string, Fdecode_time, Fencode_time)
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents:
73950
diff
changeset
|
1758 BLOCK_INPUT; |
9801
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
1759 decoded_time = localtime (&time_spec); |
75096
ca95b6ba52a9
(Fformat_time_string, Fdecode_time, Fencode_time)
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents:
73950
diff
changeset
|
1760 UNBLOCK_INPUT; |
23198
dddce768cf7a
(Fformat_time_string, Fdecode_time, Fcurrent_time_zone):
Paul Eggert <eggert@twinsun.com>
parents:
23197
diff
changeset
|
1761 if (! decoded_time) |
dddce768cf7a
(Fformat_time_string, Fdecode_time, Fcurrent_time_zone):
Paul Eggert <eggert@twinsun.com>
parents:
23197
diff
changeset
|
1762 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
|
1763 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
|
1764 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
|
1765 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
|
1766 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
|
1767 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
|
1768 /* 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
|
1769 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
|
1770 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
|
1771 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
|
1772 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
|
1773 |
bc352c8f079c
(Fdecode_time): Fix Lisp_Object vs. integer problems.
Karl Heuer <kwzh@gnu.org>
parents:
9809
diff
changeset
|
1774 /* 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
|
1775 save_tm = *decoded_time; |
75096
ca95b6ba52a9
(Fformat_time_string, Fdecode_time, Fencode_time)
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents:
73950
diff
changeset
|
1776 BLOCK_INPUT; |
9812
bc352c8f079c
(Fdecode_time): Fix Lisp_Object vs. integer problems.
Karl Heuer <kwzh@gnu.org>
parents:
9809
diff
changeset
|
1777 decoded_time = gmtime (&time_spec); |
75096
ca95b6ba52a9
(Fformat_time_string, Fdecode_time, Fencode_time)
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents:
73950
diff
changeset
|
1778 UNBLOCK_INPUT; |
9812
bc352c8f079c
(Fdecode_time): Fix Lisp_Object vs. integer problems.
Karl Heuer <kwzh@gnu.org>
parents:
9809
diff
changeset
|
1779 if (decoded_time == 0) |
bc352c8f079c
(Fdecode_time): Fix Lisp_Object vs. integer problems.
Karl Heuer <kwzh@gnu.org>
parents:
9809
diff
changeset
|
1780 list_args[8] = Qnil; |
bc352c8f079c
(Fdecode_time): Fix Lisp_Object vs. integer problems.
Karl Heuer <kwzh@gnu.org>
parents:
9809
diff
changeset
|
1781 else |
16269
79e6c47054c5
(tm_diff): Renamed from difftm. Yield int, not long.
Paul Eggert <eggert@twinsun.com>
parents:
16134
diff
changeset
|
1782 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
|
1783 return Flist (9, list_args); |
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
1784 } |
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
1785 |
15180
9a22c72359c1
(Fencode_time): Accept MANY args, so as to cope
Richard M. Stallman <rms@gnu.org>
parents:
15075
diff
changeset
|
1786 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
|
1787 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
|
1788 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
|
1789 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
|
1790 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
|
1791 \(as from `current-time-zone') or an integer (as from `decode-time') |
76498
741577a048ed
(Fdecode_time, Fencode_time): "daylight savings" -> "daylight saving"
Chong Yidong <cyd@stupidchicken.com>
parents:
75949
diff
changeset
|
1792 applied without consideration for daylight saving time. |
39966
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1793 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1794 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
|
1795 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
|
1796 The intervening arguments are ignored. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1797 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
|
1798 |
55972
db2480202623
(Fuser_login_name, Ffloat_time, Fencode_time, Fcurrent_time_string)
Juanma Barranquero <lekktu@gmail.com>
parents:
55424
diff
changeset
|
1799 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
|
1800 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
|
1801 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
|
1802 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
|
1803 |
52211
a057bd074729
(Fencode_time): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
51841
diff
changeset
|
1804 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
|
1805 year values as low as 1901 do work. |
a057bd074729
(Fencode_time): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
51841
diff
changeset
|
1806 |
40131
de086e415fa2
(Finsert, Finsert_and_inherit, Finsert_before_markers, Fmessage)
Miles Bader <miles@gnu.org>
parents:
40046
diff
changeset
|
1807 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
|
1808 (nargs, args) |
15180
9a22c72359c1
(Fencode_time): Accept MANY args, so as to cope
Richard M. Stallman <rms@gnu.org>
parents:
15075
diff
changeset
|
1809 int nargs; |
9a22c72359c1
(Fencode_time): Accept MANY args, so as to cope
Richard M. Stallman <rms@gnu.org>
parents:
15075
diff
changeset
|
1810 register Lisp_Object *args; |
11402
66d935214d8e
(Fencode_time): Use XINT to examine `zone'.
Richard M. Stallman <rms@gnu.org>
parents:
11263
diff
changeset
|
1811 { |
11468
772f49d1969d
(Fencode_time): Rewrite by Naggum.
Richard M. Stallman <rms@gnu.org>
parents:
11451
diff
changeset
|
1812 time_t time; |
13025
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1813 struct tm tm; |
16874 | 1814 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
|
1815 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
1816 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
|
1817 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
|
1818 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
|
1819 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
|
1820 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
|
1821 CHECK_NUMBER (args[5]); /* year */ |
11468
772f49d1969d
(Fencode_time): Rewrite by Naggum.
Richard M. Stallman <rms@gnu.org>
parents:
11451
diff
changeset
|
1822 |
15180
9a22c72359c1
(Fencode_time): Accept MANY args, so as to cope
Richard M. Stallman <rms@gnu.org>
parents:
15075
diff
changeset
|
1823 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
|
1824 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
|
1825 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
|
1826 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
|
1827 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
|
1828 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
|
1829 tm.tm_isdst = -1; |
11468
772f49d1969d
(Fencode_time): Rewrite by Naggum.
Richard M. Stallman <rms@gnu.org>
parents:
11451
diff
changeset
|
1830 |
13025
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1831 if (CONSP (zone)) |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1832 zone = Fcar (zone); |
11468
772f49d1969d
(Fencode_time): Rewrite by Naggum.
Richard M. Stallman <rms@gnu.org>
parents:
11451
diff
changeset
|
1833 if (NILP (zone)) |
75096
ca95b6ba52a9
(Fformat_time_string, Fdecode_time, Fencode_time)
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents:
73950
diff
changeset
|
1834 { |
ca95b6ba52a9
(Fformat_time_string, Fdecode_time, Fencode_time)
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents:
73950
diff
changeset
|
1835 BLOCK_INPUT; |
ca95b6ba52a9
(Fformat_time_string, Fdecode_time, Fencode_time)
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents:
73950
diff
changeset
|
1836 time = mktime (&tm); |
ca95b6ba52a9
(Fformat_time_string, Fdecode_time, Fencode_time)
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents:
73950
diff
changeset
|
1837 UNBLOCK_INPUT; |
ca95b6ba52a9
(Fformat_time_string, Fdecode_time, Fencode_time)
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents:
73950
diff
changeset
|
1838 } |
13025
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1839 else |
11468
772f49d1969d
(Fencode_time): Rewrite by Naggum.
Richard M. Stallman <rms@gnu.org>
parents:
11451
diff
changeset
|
1840 { |
13025
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1841 char tzbuf[100]; |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1842 char *tzstring; |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1843 char **oldenv = environ, **newenv; |
30480 | 1844 |
18613
614b916ff5bf
Fix bugs with inappropriate mixing of Lisp_Object with int.
Richard M. Stallman <rms@gnu.org>
parents:
18605
diff
changeset
|
1845 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
|
1846 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
|
1847 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
|
1848 tzstring = (char *) SDATA (zone); |
13025
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1849 else if (INTEGERP (zone)) |
11468
772f49d1969d
(Fencode_time): Rewrite by Naggum.
Richard M. Stallman <rms@gnu.org>
parents:
11451
diff
changeset
|
1850 { |
85253 | 1851 int abszone = eabs (XINT (zone)); |
13025
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1852 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
|
1853 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
|
1854 tzstring = tzbuf; |
11468
772f49d1969d
(Fencode_time): Rewrite by Naggum.
Richard M. Stallman <rms@gnu.org>
parents:
11451
diff
changeset
|
1855 } |
13025
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1856 else |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1857 error ("Invalid time zone specification"); |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1858 |
30480 | 1859 /* 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
|
1860 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
|
1861 set_time_zone_rule (tzstring); |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1862 |
75096
ca95b6ba52a9
(Fformat_time_string, Fdecode_time, Fencode_time)
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents:
73950
diff
changeset
|
1863 BLOCK_INPUT; |
13025
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1864 time = mktime (&tm); |
75096
ca95b6ba52a9
(Fformat_time_string, Fdecode_time, Fencode_time)
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents:
73950
diff
changeset
|
1865 UNBLOCK_INPUT; |
13025
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1866 |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1867 /* Restore TZ to previous value. */ |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1868 newenv = environ; |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1869 environ = oldenv; |
16521
fe9cc0d392dd
(Fencode_time): Use xfree, not free.
Richard M. Stallman <rms@gnu.org>
parents:
16485
diff
changeset
|
1870 xfree (newenv); |
13025
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1871 #ifdef LOCALTIME_CACHE |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1872 tzset (); |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1873 #endif |
11468
772f49d1969d
(Fencode_time): Rewrite by Naggum.
Richard M. Stallman <rms@gnu.org>
parents:
11451
diff
changeset
|
1874 } |
11402
66d935214d8e
(Fencode_time): Use XINT to examine `zone'.
Richard M. Stallman <rms@gnu.org>
parents:
11263
diff
changeset
|
1875 |
13025
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1876 if (time == (time_t) -1) |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1877 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
|
1878 |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
1879 return make_time (time); |
11402
66d935214d8e
(Fencode_time): Use XINT to examine `zone'.
Richard M. Stallman <rms@gnu.org>
parents:
11263
diff
changeset
|
1880 } |
66d935214d8e
(Fencode_time): Use XINT to examine `zone'.
Richard M. Stallman <rms@gnu.org>
parents:
11263
diff
changeset
|
1881 |
2154
69c58e548ca5
(Fcurrent_time_string): Optional arg specifies time.
Richard M. Stallman <rms@gnu.org>
parents:
2049
diff
changeset
|
1882 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
|
1883 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
|
1884 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
|
1885 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
|
1886 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
|
1887 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
|
1888 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
|
1889 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
|
1890 |
56386
4f00fbfe3c1e
(Ffloat_time, Fformat_time_string, Fdecode_time)
Luc Teirlinck <teirllm@auburn.edu>
parents:
56194
diff
changeset
|
1891 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
|
1892 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
|
1893 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
|
1894 `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
|
1895 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
|
1896 (specified_time) |
2154
69c58e548ca5
(Fcurrent_time_string): Optional arg specifies time.
Richard M. Stallman <rms@gnu.org>
parents:
2049
diff
changeset
|
1897 Lisp_Object specified_time; |
305 | 1898 { |
2921
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1899 time_t value; |
69664
55e66496ae1a
* editfns.c: (TM_YEAR_BASE): Move up.
Paul Eggert <eggert@twinsun.com>
parents:
68669
diff
changeset
|
1900 struct tm *tm; |
2154
69c58e548ca5
(Fcurrent_time_string): Optional arg specifies time.
Richard M. Stallman <rms@gnu.org>
parents:
2049
diff
changeset
|
1901 register char *tem; |
69c58e548ca5
(Fcurrent_time_string): Optional arg specifies time.
Richard M. Stallman <rms@gnu.org>
parents:
2049
diff
changeset
|
1902 |
30480 | 1903 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
|
1904 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
|
1905 |
1e68e7f3b824
* lib-src/b2m.c (main): Don't include <limits.h>.
Paul Eggert <eggert@twinsun.com>
parents:
69673
diff
changeset
|
1906 /* 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
|
1907 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
|
1908 range. */ |
75096
ca95b6ba52a9
(Fformat_time_string, Fdecode_time, Fencode_time)
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents:
73950
diff
changeset
|
1909 BLOCK_INPUT; |
69664
55e66496ae1a
* editfns.c: (TM_YEAR_BASE): Move up.
Paul Eggert <eggert@twinsun.com>
parents:
68669
diff
changeset
|
1910 tm = localtime (&value); |
75096
ca95b6ba52a9
(Fformat_time_string, Fdecode_time, Fencode_time)
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents:
73950
diff
changeset
|
1911 UNBLOCK_INPUT; |
69790
1e68e7f3b824
* lib-src/b2m.c (main): Don't include <limits.h>.
Paul Eggert <eggert@twinsun.com>
parents:
69673
diff
changeset
|
1912 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
|
1913 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
|
1914 |
1e68e7f3b824
* lib-src/b2m.c (main): Don't include <limits.h>.
Paul Eggert <eggert@twinsun.com>
parents:
69673
diff
changeset
|
1915 /* Remove the trailing newline. */ |
1e68e7f3b824
* lib-src/b2m.c (main): Don't include <limits.h>.
Paul Eggert <eggert@twinsun.com>
parents:
69673
diff
changeset
|
1916 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
|
1917 |
1e68e7f3b824
* lib-src/b2m.c (main): Don't include <limits.h>.
Paul Eggert <eggert@twinsun.com>
parents:
69673
diff
changeset
|
1918 return build_string (tem); |
305 | 1919 } |
962
3533821d6edc
* editfns.c (Fcurrent_time_zone): Doc fix.
Jim Blandy <jimb@redhat.com>
parents:
690
diff
changeset
|
1920 |
16269
79e6c47054c5
(tm_diff): Renamed from difftm. Yield int, not long.
Paul Eggert <eggert@twinsun.com>
parents:
16134
diff
changeset
|
1921 /* 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
|
1922 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
|
1923 static int |
79e6c47054c5
(tm_diff): Renamed from difftm. Yield int, not long.
Paul Eggert <eggert@twinsun.com>
parents:
16134
diff
changeset
|
1924 tm_diff (a, b) |
2921
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1925 struct tm *a, *b; |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1926 { |
16269
79e6c47054c5
(tm_diff): Renamed from difftm. Yield int, not long.
Paul Eggert <eggert@twinsun.com>
parents:
16134
diff
changeset
|
1927 /* 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
|
1928 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
|
1929 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
|
1930 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
|
1931 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
|
1932 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
|
1933 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
|
1934 int a400 = a100 >> 2; |
79e6c47054c5
(tm_diff): Renamed from difftm. Yield int, not long.
Paul Eggert <eggert@twinsun.com>
parents:
16134
diff
changeset
|
1935 int b400 = b100 >> 2; |
79e6c47054c5
(tm_diff): Renamed from difftm. Yield int, not long.
Paul Eggert <eggert@twinsun.com>
parents:
16134
diff
changeset
|
1936 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
|
1937 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
|
1938 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
|
1939 + (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
|
1940 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
|
1941 + (a->tm_min - b->tm_min)) |
5882 | 1942 + (a->tm_sec - b->tm_sec)); |
2921
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1943 } |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1944 |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1945 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
|
1946 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
|
1947 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
|
1948 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
|
1949 A negative value means west of Greenwich. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1950 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
|
1951 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
|
1952 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
|
1953 (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
|
1954 `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
|
1955 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
|
1956 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
1957 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
|
1958 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
|
1959 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
|
1960 (specified_time) |
2921
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1961 Lisp_Object specified_time; |
962
3533821d6edc
* editfns.c (Fcurrent_time_zone): Doc fix.
Jim Blandy <jimb@redhat.com>
parents:
690
diff
changeset
|
1962 { |
2921
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1963 time_t value; |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1964 struct tm *t; |
23198
dddce768cf7a
(Fformat_time_string, Fdecode_time, Fcurrent_time_zone):
Paul Eggert <eggert@twinsun.com>
parents:
23197
diff
changeset
|
1965 struct tm gmt; |
962
3533821d6edc
* editfns.c (Fcurrent_time_zone): Doc fix.
Jim Blandy <jimb@redhat.com>
parents:
690
diff
changeset
|
1966 |
75096
ca95b6ba52a9
(Fformat_time_string, Fdecode_time, Fencode_time)
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents:
73950
diff
changeset
|
1967 if (!lisp_time_argument (specified_time, &value, NULL)) |
ca95b6ba52a9
(Fformat_time_string, Fdecode_time, Fencode_time)
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents:
73950
diff
changeset
|
1968 t = NULL; |
ca95b6ba52a9
(Fformat_time_string, Fdecode_time, Fencode_time)
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents:
73950
diff
changeset
|
1969 else |
ca95b6ba52a9
(Fformat_time_string, Fdecode_time, Fencode_time)
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents:
73950
diff
changeset
|
1970 { |
ca95b6ba52a9
(Fformat_time_string, Fdecode_time, Fencode_time)
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents:
73950
diff
changeset
|
1971 BLOCK_INPUT; |
ca95b6ba52a9
(Fformat_time_string, Fdecode_time, Fencode_time)
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents:
73950
diff
changeset
|
1972 t = gmtime (&value); |
ca95b6ba52a9
(Fformat_time_string, Fdecode_time, Fencode_time)
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents:
73950
diff
changeset
|
1973 if (t) |
ca95b6ba52a9
(Fformat_time_string, Fdecode_time, Fencode_time)
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents:
73950
diff
changeset
|
1974 { |
ca95b6ba52a9
(Fformat_time_string, Fdecode_time, Fencode_time)
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents:
73950
diff
changeset
|
1975 gmt = *t; |
ca95b6ba52a9
(Fformat_time_string, Fdecode_time, Fencode_time)
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents:
73950
diff
changeset
|
1976 t = localtime (&value); |
ca95b6ba52a9
(Fformat_time_string, Fdecode_time, Fencode_time)
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents:
73950
diff
changeset
|
1977 } |
ca95b6ba52a9
(Fformat_time_string, Fdecode_time, Fencode_time)
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents:
73950
diff
changeset
|
1978 UNBLOCK_INPUT; |
ca95b6ba52a9
(Fformat_time_string, Fdecode_time, Fencode_time)
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents:
73950
diff
changeset
|
1979 } |
ca95b6ba52a9
(Fformat_time_string, Fdecode_time, Fencode_time)
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents:
73950
diff
changeset
|
1980 |
ca95b6ba52a9
(Fformat_time_string, Fdecode_time, Fencode_time)
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents:
73950
diff
changeset
|
1981 if (t) |
2921
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1982 { |
23198
dddce768cf7a
(Fformat_time_string, Fdecode_time, Fcurrent_time_zone):
Paul Eggert <eggert@twinsun.com>
parents:
23197
diff
changeset
|
1983 int offset = tm_diff (t, &gmt); |
dddce768cf7a
(Fformat_time_string, Fdecode_time, Fcurrent_time_zone):
Paul Eggert <eggert@twinsun.com>
parents:
23197
diff
changeset
|
1984 char *s = 0; |
dddce768cf7a
(Fformat_time_string, Fdecode_time, Fcurrent_time_zone):
Paul Eggert <eggert@twinsun.com>
parents:
23197
diff
changeset
|
1985 char buf[6]; |
81259
d2bd034ded27
(Fcurrent_time_zone): Remove hack for Japanese Windows.
Jason Rumney <jasonr@gnu.org>
parents:
77661
diff
changeset
|
1986 |
2921
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1987 #ifdef HAVE_TM_ZONE |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1988 if (t->tm_zone) |
7506
9fa47d36798a
(Fcurrent_time_zone): Add cast.
Richard M. Stallman <rms@gnu.org>
parents:
7485
diff
changeset
|
1989 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
|
1990 #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
|
1991 #ifdef HAVE_TZNAME |
dc9f7a107e28
(Fcurrent_time_zone): Add alternative for !HAVE_TM_ZONE.
Richard M. Stallman <rms@gnu.org>
parents:
2994
diff
changeset
|
1992 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
|
1993 s = tzname[t->tm_isdst]; |
962
3533821d6edc
* editfns.c (Fcurrent_time_zone): Doc fix.
Jim Blandy <jimb@redhat.com>
parents:
690
diff
changeset
|
1994 #endif |
3522
dc9f7a107e28
(Fcurrent_time_zone): Add alternative for !HAVE_TM_ZONE.
Richard M. Stallman <rms@gnu.org>
parents:
2994
diff
changeset
|
1995 #endif /* not HAVE_TM_ZONE */ |
36479
ac3ee681e8f9
(Fcurrent_time_zone) [HAVE_TM_ZONE || HAVE_TZNAME]:
Gerd Moellmann <gerd@gnu.org>
parents:
35998
diff
changeset
|
1996 |
2921
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1997 if (!s) |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1998 { |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
1999 /* 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
|
2000 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
|
2001 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
|
2002 s = buf; |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
2003 } |
81259
d2bd034ded27
(Fcurrent_time_zone): Remove hack for Japanese Windows.
Jason Rumney <jasonr@gnu.org>
parents:
77661
diff
changeset
|
2004 |
2921
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
2005 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
|
2006 } |
37503f466755
Some time-handling patches from Paul Eggert:
Jim Blandy <jimb@redhat.com>
parents:
2783
diff
changeset
|
2007 else |
18745
192b3ebd108e
(Fcurrent_time_zone): Convert Fmake_list argument to Lisp_Integer.
Richard M. Stallman <rms@gnu.org>
parents:
18661
diff
changeset
|
2008 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
|
2009 } |
3533821d6edc
* editfns.c (Fcurrent_time_zone): Doc fix.
Jim Blandy <jimb@redhat.com>
parents:
690
diff
changeset
|
2010 |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2011 /* 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
|
2012 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
|
2013 has never been called. */ |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2014 static char **environbuf; |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2015 |
92954
f0f1c359cd43
(initial_tz): New variable.
Jason Rumney <jasonr@gnu.org>
parents:
92236
diff
changeset
|
2016 /* This holds the startup value of the TZ environment variable so it |
f0f1c359cd43
(initial_tz): New variable.
Jason Rumney <jasonr@gnu.org>
parents:
92236
diff
changeset
|
2017 can be restored if the user calls set-time-zone-rule with a nil |
f0f1c359cd43
(initial_tz): New variable.
Jason Rumney <jasonr@gnu.org>
parents:
92236
diff
changeset
|
2018 argument. */ |
f0f1c359cd43
(initial_tz): New variable.
Jason Rumney <jasonr@gnu.org>
parents:
92236
diff
changeset
|
2019 static char *initial_tz; |
f0f1c359cd43
(initial_tz): New variable.
Jason Rumney <jasonr@gnu.org>
parents:
92236
diff
changeset
|
2020 |
13019
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
2021 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
|
2022 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
|
2023 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
|
2024 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
|
2025 (tz) |
13019
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
2026 Lisp_Object tz; |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
2027 { |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
2028 char *tzstring; |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
2029 |
92954
f0f1c359cd43
(initial_tz): New variable.
Jason Rumney <jasonr@gnu.org>
parents:
92236
diff
changeset
|
2030 /* When called for the first time, save the original TZ. */ |
f0f1c359cd43
(initial_tz): New variable.
Jason Rumney <jasonr@gnu.org>
parents:
92236
diff
changeset
|
2031 if (!environbuf) |
f0f1c359cd43
(initial_tz): New variable.
Jason Rumney <jasonr@gnu.org>
parents:
92236
diff
changeset
|
2032 initial_tz = (char *) getenv ("TZ"); |
f0f1c359cd43
(initial_tz): New variable.
Jason Rumney <jasonr@gnu.org>
parents:
92236
diff
changeset
|
2033 |
13019
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
2034 if (NILP (tz)) |
92954
f0f1c359cd43
(initial_tz): New variable.
Jason Rumney <jasonr@gnu.org>
parents:
92236
diff
changeset
|
2035 tzstring = initial_tz; |
18613
614b916ff5bf
Fix bugs with inappropriate mixing of Lisp_Object with int.
Richard M. Stallman <rms@gnu.org>
parents:
18605
diff
changeset
|
2036 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
|
2037 tzstring = "UTC0"; |
13019
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
2038 else |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
2039 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
2040 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
|
2041 tzstring = (char *) SDATA (tz); |
13019
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
2042 } |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
2043 |
13025
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
2044 set_time_zone_rule (tzstring); |
95479
9588c3703f38
remove useless if-before-free tests
Jim Meyering <jim@meyering.net>
parents:
94963
diff
changeset
|
2045 free (environbuf); |
13025
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
2046 environbuf = environ; |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
2047 |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
2048 return Qnil; |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
2049 } |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
2050 |
16918
ab49512bcdff
(set_time_zone_rule_tz1, set_time_zone_rule_tz2):
Paul Eggert <eggert@twinsun.com>
parents:
16874
diff
changeset
|
2051 #ifdef LOCALTIME_CACHE |
ab49512bcdff
(set_time_zone_rule_tz1, set_time_zone_rule_tz2):
Paul Eggert <eggert@twinsun.com>
parents:
16874
diff
changeset
|
2052 |
ab49512bcdff
(set_time_zone_rule_tz1, set_time_zone_rule_tz2):
Paul Eggert <eggert@twinsun.com>
parents:
16874
diff
changeset
|
2053 /* 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
|
2054 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
|
2055 Their values shouldn't matter in non-buggy implementations. |
30480 | 2056 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
|
2057 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
|
2058 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
|
2059 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
|
2060 improperly modify environment''. */ |
80a852988718
(set_time_zone_rule): Don't put a string literal
Richard M. Stallman <rms@gnu.org>
parents:
15779
diff
changeset
|
2061 |
16918
ab49512bcdff
(set_time_zone_rule_tz1, set_time_zone_rule_tz2):
Paul Eggert <eggert@twinsun.com>
parents:
16874
diff
changeset
|
2062 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
|
2063 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
|
2064 |
ab49512bcdff
(set_time_zone_rule_tz1, set_time_zone_rule_tz2):
Paul Eggert <eggert@twinsun.com>
parents:
16874
diff
changeset
|
2065 #endif |
15841
80a852988718
(set_time_zone_rule): Don't put a string literal
Richard M. Stallman <rms@gnu.org>
parents:
15779
diff
changeset
|
2066 |
13025
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
2067 /* 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
|
2068 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
|
2069 responsibility to free. */ |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
2070 |
14201
ff372902386d
(set_time_zone_rule): No longer static.
Richard M. Stallman <rms@gnu.org>
parents:
14126
diff
changeset
|
2071 void |
13025
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
2072 set_time_zone_rule (tzstring) |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
2073 char *tzstring; |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
2074 { |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
2075 int envptrs; |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
2076 char **from, **to, **newenv; |
1eab52043f10
(Fencode_time): Use mktime to do the real work;
Paul Eggert <eggert@twinsun.com>
parents:
13019
diff
changeset
|
2077 |
15334 | 2078 /* 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
|
2079 for (from = environ; *from; from++) |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
2080 continue; |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
2081 envptrs = from - environ + 2; |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
2082 newenv = to = (char **) xmalloc (envptrs * sizeof (char *) |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
2083 + (tzstring ? strlen (tzstring) + 4 : 0)); |
15334 | 2084 |
2085 /* 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
|
2086 if (tzstring) |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
2087 { |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
2088 char *t = (char *) (to + envptrs); |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
2089 strcpy (t, "TZ="); |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
2090 strcat (t, tzstring); |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
2091 *to++ = t; |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
2092 } |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
2093 |
15334 | 2094 /* Copy the old environ vector elements into NEWENV, |
2095 but don't copy the TZ variable. | |
2096 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
|
2097 for (from = environ; *from; from++) |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
2098 if (strncmp (*from, "TZ=", 3) != 0) |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
2099 *to++ = *from; |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
2100 *to = 0; |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
2101 |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
2102 environ = newenv; |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
2103 |
15334 | 2104 /* If we do have a TZSTRING, NEWENV points to the vector slot where |
2105 the TZ variable is stored. If we do not have a TZSTRING, | |
2106 TO points to the vector slot which has the terminating null. */ | |
2107 | |
13019
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
2108 #ifdef LOCALTIME_CACHE |
15334 | 2109 { |
2110 /* In SunOS 4.1.3_U1 and 4.1.4, if TZ has a value like | |
2111 "US/Pacific" that loads a tz file, then changes to a value like | |
2112 "XXX0" that does not load a tz file, and then changes back to | |
2113 its original value, the last change is (incorrectly) ignored. | |
2114 Also, if TZ changes twice in succession to values that do | |
2115 not load a tz file, tzset can dump core (see Sun bug#1225179). | |
2116 The following code works around these bugs. */ | |
2117 | |
2118 if (tzstring) | |
2119 { | |
2120 /* Temporarily set TZ to a value that loads a tz file | |
2121 and that differs from tzstring. */ | |
2122 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
|
2123 *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
|
2124 ? set_time_zone_rule_tz2 : set_time_zone_rule_tz1); |
15334 | 2125 tzset (); |
2126 *newenv = tz; | |
2127 } | |
2128 else | |
2129 { | |
2130 /* The implied tzstring is unknown, so temporarily set TZ to | |
2131 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
|
2132 *to = set_time_zone_rule_tz1; |
15334 | 2133 to[1] = 0; |
2134 tzset (); | |
15841
80a852988718
(set_time_zone_rule): Don't put a string literal
Richard M. Stallman <rms@gnu.org>
parents:
15779
diff
changeset
|
2135 *to = set_time_zone_rule_tz2; |
15334 | 2136 tzset (); |
2137 *to = 0; | |
2138 } | |
2139 | |
2140 /* Now TZ has the desired value, and tzset can be invoked safely. */ | |
2141 } | |
2142 | |
13019
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
2143 tzset (); |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
2144 #endif |
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
2145 } |
305 | 2146 |
17031 | 2147 /* Insert NARGS Lisp objects in the array ARGS by calling INSERT_FUNC |
2148 (if a type of object is Lisp_Int) or INSERT_FROM_STRING_FUNC (if a | |
2149 type of object is Lisp_String). INHERIT is passed to | |
2150 INSERT_FROM_STRING_FUNC as the last argument. */ | |
2151 | |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
2152 static void |
17031 | 2153 general_insert_function (insert_func, insert_from_string_func, |
2154 inherit, nargs, args) | |
46464
e05dd5b81fc7
(general_insert_function): Insertion function now
Ken Raeburn <raeburn@raeburn.org>
parents:
46447
diff
changeset
|
2155 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
|
2156 void (*insert_from_string_func) P_ ((Lisp_Object, int, int, int, int, int)); |
17031 | 2157 int inherit, nargs; |
2158 register Lisp_Object *args; | |
2159 { | |
2160 register int argnum; | |
2161 register Lisp_Object val; | |
2162 | |
2163 for (argnum = 0; argnum < nargs; argnum++) | |
2164 { | |
2165 val = args[argnum]; | |
90800
37b19435acef
(Fchar_to_string): Use CHARACTERP, not INTEGERP.
Kenichi Handa <handa@m17n.org>
parents:
90796
diff
changeset
|
2166 if (CHARACTERP (val)) |
17031 | 2167 { |
26853
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2168 unsigned char str[MAX_MULTIBYTE_LENGTH]; |
17031 | 2169 int len; |
2170 | |
2171 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
|
2172 len = CHAR_STRING (XFASTINT (val), str); |
17031 | 2173 else |
22929
6dda0a4b882f
(general_insert_function): If enable-multibyte-characters is
Kenichi Handa <handa@m17n.org>
parents:
22895
diff
changeset
|
2174 { |
89209
3903a3ae19cb
(general_insert_function): Check VAL by ASCII_CHAR_P,
Kenichi Handa <handa@m17n.org>
parents:
89034
diff
changeset
|
2175 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
|
2176 ? XINT (val) |
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2177 : 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
|
2178 len = 1; |
6dda0a4b882f
(general_insert_function): If enable-multibyte-characters is
Kenichi Handa <handa@m17n.org>
parents:
22895
diff
changeset
|
2179 } |
17031 | 2180 (*insert_func) (str, len); |
2181 } | |
2182 else if (STRINGP (val)) | |
2183 { | |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
2184 (*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
|
2185 SCHARS (val), |
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
2186 SBYTES (val), |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
2187 inherit); |
17031 | 2188 } |
2189 else | |
71832
e891eb992cb2
(general_insert_function): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents:
71817
diff
changeset
|
2190 wrong_type_argument (Qchar_or_string_p, val); |
17031 | 2191 } |
2192 } | |
2193 | |
305 | 2194 void |
2195 insert1 (arg) | |
2196 Lisp_Object arg; | |
2197 { | |
2198 Finsert (1, &arg); | |
2199 } | |
2200 | |
330 | 2201 |
2202 /* Callers passing one argument to Finsert need not gcpro the | |
2203 argument "array", since the only element of the array will | |
2204 not be used after calling insert or insert_from_string, so | |
2205 we don't care if it gets trashed. */ | |
2206 | |
305 | 2207 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
|
2208 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
|
2209 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
|
2210 after the inserted text. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2211 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
|
2212 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2213 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
|
2214 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
|
2215 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
|
2216 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
|
2217 |
41213ea7b9d6
(Finsert): Mention `string-make-multibyte' and
Kim F. Storm <storm@cua.dk>
parents:
49285
diff
changeset
|
2218 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
|
2219 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
|
2220 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
|
2221 and insert the result. |
40131
de086e415fa2
(Finsert, Finsert_and_inherit, Finsert_before_markers, Fmessage)
Miles Bader <miles@gnu.org>
parents:
40046
diff
changeset
|
2222 |
de086e415fa2
(Finsert, Finsert_and_inherit, Finsert_before_markers, Fmessage)
Miles Bader <miles@gnu.org>
parents:
40046
diff
changeset
|
2223 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
|
2224 (nargs, args) |
305 | 2225 int nargs; |
2226 register Lisp_Object *args; | |
2227 { | |
17031 | 2228 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
|
2229 return Qnil; |
350231e38e68
(Finsert_and_inherit): New function.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2230 } |
350231e38e68
(Finsert_and_inherit): New function.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2231 |
350231e38e68
(Finsert_and_inherit): New function.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2232 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
|
2233 0, MANY, 0, |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
2234 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
|
2235 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
|
2236 after the inserted text. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2237 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
|
2238 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2239 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
|
2240 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
|
2241 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
|
2242 to unibyte for insertion. |
de086e415fa2
(Finsert, Finsert_and_inherit, Finsert_before_markers, Fmessage)
Miles Bader <miles@gnu.org>
parents:
40046
diff
changeset
|
2243 |
de086e415fa2
(Finsert, Finsert_and_inherit, Finsert_before_markers, Fmessage)
Miles Bader <miles@gnu.org>
parents:
40046
diff
changeset
|
2244 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
|
2245 (nargs, args) |
4714
350231e38e68
(Finsert_and_inherit): New function.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2246 int nargs; |
350231e38e68
(Finsert_and_inherit): New function.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2247 register Lisp_Object *args; |
350231e38e68
(Finsert_and_inherit): New function.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2248 { |
17031 | 2249 general_insert_function (insert_and_inherit, insert_from_string, 1, |
2250 nargs, args); | |
305 | 2251 return Qnil; |
2252 } | |
2253 | |
2254 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
|
2255 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
|
2256 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
|
2257 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2258 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
|
2259 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
|
2260 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
|
2261 to unibyte for insertion. |
de086e415fa2
(Finsert, Finsert_and_inherit, Finsert_before_markers, Fmessage)
Miles Bader <miles@gnu.org>
parents:
40046
diff
changeset
|
2262 |
de086e415fa2
(Finsert, Finsert_and_inherit, Finsert_before_markers, Fmessage)
Miles Bader <miles@gnu.org>
parents:
40046
diff
changeset
|
2263 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
|
2264 (nargs, args) |
305 | 2265 int nargs; |
2266 register Lisp_Object *args; | |
2267 { | |
17031 | 2268 general_insert_function (insert_before_markers, |
2269 insert_from_string_before_markers, 0, | |
2270 nargs, args); | |
4714
350231e38e68
(Finsert_and_inherit): New function.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2271 return Qnil; |
350231e38e68
(Finsert_and_inherit): New function.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2272 } |
350231e38e68
(Finsert_and_inherit): New function.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2273 |
16485
9b919c5464a4
Reorganize function definitions so etags finds them.
Erik Naggum <erik@naggum.no>
parents:
16298
diff
changeset
|
2274 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
|
2275 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
|
2276 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
|
2277 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
|
2278 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2279 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
|
2280 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
|
2281 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
|
2282 to unibyte for insertion. |
de086e415fa2
(Finsert, Finsert_and_inherit, Finsert_before_markers, Fmessage)
Miles Bader <miles@gnu.org>
parents:
40046
diff
changeset
|
2283 |
de086e415fa2
(Finsert, Finsert_and_inherit, Finsert_before_markers, Fmessage)
Miles Bader <miles@gnu.org>
parents:
40046
diff
changeset
|
2284 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
|
2285 (nargs, args) |
4714
350231e38e68
(Finsert_and_inherit): New function.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2286 int nargs; |
350231e38e68
(Finsert_and_inherit): New function.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2287 register Lisp_Object *args; |
350231e38e68
(Finsert_and_inherit): New function.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2288 { |
17031 | 2289 general_insert_function (insert_before_markers_and_inherit, |
2290 insert_from_string_before_markers, 1, | |
2291 nargs, args); | |
305 | 2292 return Qnil; |
2293 } | |
2294 | |
8646
0f05e3e89f87
(Finsert_char): New arg INHERIT.
Richard M. Stallman <rms@gnu.org>
parents:
8333
diff
changeset
|
2295 DEFUN ("insert-char", Finsert_char, Sinsert_char, 2, 3, 0, |
75387
41b2aae64f85
(Finsert_char): Doc fix.
Juanma Barranquero <lekktu@gmail.com>
parents:
75217
diff
changeset
|
2296 doc: /* Insert COUNT copies of CHARACTER. |
39966
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2297 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
|
2298 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
|
2299 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
|
2300 (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
|
2301 Lisp_Object character, count, inherit; |
305 | 2302 { |
2303 register unsigned char *string; | |
2304 register int strlen; | |
2305 register int i, n; | |
17031 | 2306 int len; |
26853
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2307 unsigned char str[MAX_MULTIBYTE_LENGTH]; |
305 | 2308 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
2309 CHECK_NUMBER (character); |
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
2310 CHECK_NUMBER (count); |
305 | 2311 |
17031 | 2312 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
|
2313 len = CHAR_STRING (XFASTINT (character), str); |
17031 | 2314 else |
26853
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2315 str[0] = XFASTINT (character), len = 1; |
17031 | 2316 n = XINT (count) * len; |
305 | 2317 if (n <= 0) |
2318 return Qnil; | |
17031 | 2319 strlen = min (n, 256 * len); |
305 | 2320 string = (unsigned char *) alloca (strlen); |
2321 for (i = 0; i < strlen; i++) | |
17031 | 2322 string[i] = str[i % len]; |
305 | 2323 while (n >= strlen) |
2324 { | |
18194
c291aa915b85
(Finsert_char): Check QUIT.
Richard M. Stallman <rms@gnu.org>
parents:
18106
diff
changeset
|
2325 QUIT; |
8646
0f05e3e89f87
(Finsert_char): New arg INHERIT.
Richard M. Stallman <rms@gnu.org>
parents:
8333
diff
changeset
|
2326 if (!NILP (inherit)) |
0f05e3e89f87
(Finsert_char): New arg INHERIT.
Richard M. Stallman <rms@gnu.org>
parents:
8333
diff
changeset
|
2327 insert_and_inherit (string, strlen); |
0f05e3e89f87
(Finsert_char): New arg INHERIT.
Richard M. Stallman <rms@gnu.org>
parents:
8333
diff
changeset
|
2328 else |
0f05e3e89f87
(Finsert_char): New arg INHERIT.
Richard M. Stallman <rms@gnu.org>
parents:
8333
diff
changeset
|
2329 insert (string, strlen); |
305 | 2330 n -= strlen; |
2331 } | |
2332 if (n > 0) | |
10382
9738aad59697
(Finsert_char): Check inherit flag for long strings too.
Karl Heuer <kwzh@gnu.org>
parents:
10308
diff
changeset
|
2333 { |
9738aad59697
(Finsert_char): Check inherit flag for long strings too.
Karl Heuer <kwzh@gnu.org>
parents:
10308
diff
changeset
|
2334 if (!NILP (inherit)) |
9738aad59697
(Finsert_char): Check inherit flag for long strings too.
Karl Heuer <kwzh@gnu.org>
parents:
10308
diff
changeset
|
2335 insert_and_inherit (string, n); |
9738aad59697
(Finsert_char): Check inherit flag for long strings too.
Karl Heuer <kwzh@gnu.org>
parents:
10308
diff
changeset
|
2336 else |
9738aad59697
(Finsert_char): Check inherit flag for long strings too.
Karl Heuer <kwzh@gnu.org>
parents:
10308
diff
changeset
|
2337 insert (string, n); |
9738aad59697
(Finsert_char): Check inherit flag for long strings too.
Karl Heuer <kwzh@gnu.org>
parents:
10308
diff
changeset
|
2338 } |
305 | 2339 return Qnil; |
2340 } | |
2341 | |
89034
63f566c131d7
(Finsert_byte): New function.
Kenichi Handa <handa@m17n.org>
parents:
89025
diff
changeset
|
2342 DEFUN ("insert-byte", Finsert_byte, Sinsert_byte, 2, 3, 0, |
63f566c131d7
(Finsert_byte): New function.
Kenichi Handa <handa@m17n.org>
parents:
89025
diff
changeset
|
2343 doc: /* Insert COUNT (second arg) copies of BYTE (first arg). |
63f566c131d7
(Finsert_byte): New function.
Kenichi Handa <handa@m17n.org>
parents:
89025
diff
changeset
|
2344 Both arguments are required. |
63f566c131d7
(Finsert_byte): New function.
Kenichi Handa <handa@m17n.org>
parents:
89025
diff
changeset
|
2345 BYTE is a number of the range 0..255. |
63f566c131d7
(Finsert_byte): New function.
Kenichi Handa <handa@m17n.org>
parents:
89025
diff
changeset
|
2346 |
63f566c131d7
(Finsert_byte): New function.
Kenichi Handa <handa@m17n.org>
parents:
89025
diff
changeset
|
2347 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
|
2348 corresponding eight-bit character is inserted. |
63f566c131d7
(Finsert_byte): New function.
Kenichi Handa <handa@m17n.org>
parents:
89025
diff
changeset
|
2349 |
63f566c131d7
(Finsert_byte): New function.
Kenichi Handa <handa@m17n.org>
parents:
89025
diff
changeset
|
2350 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
|
2351 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
|
2352 from adjoining text, if those properties are sticky. */) |
63f566c131d7
(Finsert_byte): New function.
Kenichi Handa <handa@m17n.org>
parents:
89025
diff
changeset
|
2353 (byte, count, inherit) |
63f566c131d7
(Finsert_byte): New function.
Kenichi Handa <handa@m17n.org>
parents:
89025
diff
changeset
|
2354 Lisp_Object byte, count, inherit; |
63f566c131d7
(Finsert_byte): New function.
Kenichi Handa <handa@m17n.org>
parents:
89025
diff
changeset
|
2355 { |
63f566c131d7
(Finsert_byte): New function.
Kenichi Handa <handa@m17n.org>
parents:
89025
diff
changeset
|
2356 CHECK_NUMBER (byte); |
63f566c131d7
(Finsert_byte): New function.
Kenichi Handa <handa@m17n.org>
parents:
89025
diff
changeset
|
2357 if (XINT (byte) < 0 || XINT (byte) > 255) |
63f566c131d7
(Finsert_byte): New function.
Kenichi Handa <handa@m17n.org>
parents:
89025
diff
changeset
|
2358 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
|
2359 if (XINT (byte) >= 128 |
63f566c131d7
(Finsert_byte): New function.
Kenichi Handa <handa@m17n.org>
parents:
89025
diff
changeset
|
2360 && ! NILP (current_buffer->enable_multibyte_characters)) |
63f566c131d7
(Finsert_byte): New function.
Kenichi Handa <handa@m17n.org>
parents:
89025
diff
changeset
|
2361 XSETFASTINT (byte, BYTE8_TO_CHAR (XINT (byte))); |
89217
d0650cc0038f
(Finsert_byte): Return a proper value.
Dave Love <fx@gnu.org>
parents:
89209
diff
changeset
|
2362 return Finsert_char (byte, count, inherit); |
89034
63f566c131d7
(Finsert_byte): New function.
Kenichi Handa <handa@m17n.org>
parents:
89025
diff
changeset
|
2363 } |
63f566c131d7
(Finsert_byte): New function.
Kenichi Handa <handa@m17n.org>
parents:
89025
diff
changeset
|
2364 |
305 | 2365 |
648 | 2366 /* Making strings from buffer contents. */ |
2367 | |
2368 /* 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
|
2369 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
|
2370 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
|
2371 have them, if PROPS is nonzero. |
648 | 2372 |
2373 We don't want to use plain old make_string here, because it calls | |
2374 make_uninit_string, which can cause the buffer arena to be | |
2375 compacted. make_string has no way of knowing that the data has | |
2376 been moved, and thus copies the wrong data into the string. This | |
2377 doesn't effect most of the other users of make_string, so it should | |
2378 be left as is. But we should use this function when conjuring | |
2379 buffer substrings. */ | |
1285
d50533e23dff
* editfns.c (make_buffer_string): Call copy_intervals_to_string().
Joseph Arceneaux <jla@gnu.org>
parents:
1254
diff
changeset
|
2380 |
648 | 2381 Lisp_Object |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2382 make_buffer_string (start, end, props) |
648 | 2383 int start, end; |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2384 int props; |
648 | 2385 { |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
2386 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
|
2387 int end_byte = CHAR_TO_BYTE (end); |
648 | 2388 |
21235
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2389 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
|
2390 } |
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2391 |
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2392 /* 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
|
2393 START / START_BYTE to END / END_BYTE. |
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2394 |
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2395 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
|
2396 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
|
2397 have them, if PROPS is nonzero. |
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2398 |
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2399 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
|
2400 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
|
2401 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
|
2402 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
|
2403 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
|
2404 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
|
2405 buffer substrings. */ |
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2406 |
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2407 Lisp_Object |
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2408 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
|
2409 int start, start_byte, end, end_byte; |
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2410 int props; |
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2411 { |
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2412 Lisp_Object result, tem, tem1; |
eba3d61855d0
(make_buffer_string_both): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21226
diff
changeset
|
2413 |
648 | 2414 if (start < GPT && GPT < end) |
2415 move_gap (start); | |
2416 | |
21257
205a5aa4aa2f
(Fchar_to_string): Use make_string_from_bytes.
Richard M. Stallman <rms@gnu.org>
parents:
21245
diff
changeset
|
2417 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
|
2418 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
|
2419 else |
205a5aa4aa2f
(Fchar_to_string): Use make_string_from_bytes.
Richard M. Stallman <rms@gnu.org>
parents:
21245
diff
changeset
|
2420 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
|
2421 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
|
2422 end_byte - start_byte); |
648 | 2423 |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2424 /* 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
|
2425 if (props) |
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 update_buffer_properties (start, end); |
5130
ddee29e260d2
(make_buffer_string): Don't copy intervals
Richard M. Stallman <rms@gnu.org>
parents:
4943
diff
changeset
|
2428 |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2429 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
|
2430 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
|
2431 |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2432 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
|
2433 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
|
2434 end - start); |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2435 } |
1285
d50533e23dff
* editfns.c (make_buffer_string): Call copy_intervals_to_string().
Joseph Arceneaux <jla@gnu.org>
parents:
1254
diff
changeset
|
2436 |
648 | 2437 return result; |
2438 } | |
305 | 2439 |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2440 /* 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
|
2441 in the current buffer, if necessary. */ |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2442 |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2443 static void |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2444 update_buffer_properties (start, end) |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2445 int start, end; |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2446 { |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2447 /* 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
|
2448 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
|
2449 if (!NILP (Vbuffer_access_fontify_functions)) |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2450 { |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2451 Lisp_Object args[3]; |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2452 Lisp_Object tem; |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2453 |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2454 args[0] = Qbuffer_access_fontify_functions; |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2455 XSETINT (args[1], start); |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2456 XSETINT (args[2], end); |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2457 |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2458 /* 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
|
2459 has already been done. */ |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2460 if (!NILP (Vbuffer_access_fontified_property)) |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2461 { |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2462 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
|
2463 Vbuffer_access_fontified_property, |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2464 Qnil, Qnil); |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2465 if (! NILP (tem)) |
14126
edc94b82c3b3
(update_buffer_properties): Delete superfluous &'s.
Karl Heuer <kwzh@gnu.org>
parents:
14071
diff
changeset
|
2466 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
|
2467 } |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2468 else |
14126
edc94b82c3b3
(update_buffer_properties): Delete superfluous &'s.
Karl Heuer <kwzh@gnu.org>
parents:
14071
diff
changeset
|
2469 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
|
2470 } |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2471 } |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2472 |
305 | 2473 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
|
2474 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
|
2475 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
|
2476 they can be in either order. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2477 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
|
2478 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2479 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
|
2480 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
|
2481 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
|
2482 (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
|
2483 Lisp_Object start, end; |
305 | 2484 { |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2485 register int b, e; |
305 | 2486 |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2487 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
|
2488 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
|
2489 e = XINT (end); |
305 | 2490 |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2491 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
|
2492 } |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2493 |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2494 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
|
2495 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
|
2496 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
|
2497 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
|
2498 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
|
2499 (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
|
2500 Lisp_Object start, end; |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
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 register int b, e; |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2503 |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2504 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
|
2505 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
|
2506 e = XINT (end); |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2507 |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2508 return make_buffer_string (b, e, 0); |
305 | 2509 } |
2510 | |
2511 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
|
2512 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
|
2513 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
|
2514 of the buffer. */) |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
2515 () |
305 | 2516 { |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
2517 return make_buffer_string (BEGV, ZV, 1); |
305 | 2518 } |
2519 | |
2520 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
|
2521 1, 3, 0, |
55424
04990cada43d
(Finsert_buffer_substring): Make argument names match their use in
Juanma Barranquero <lekktu@gmail.com>
parents:
55193
diff
changeset
|
2522 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
|
2523 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
|
2524 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
|
2525 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
|
2526 (buffer, start, end) |
04990cada43d
(Finsert_buffer_substring): Make argument names match their use in
Juanma Barranquero <lekktu@gmail.com>
parents:
55193
diff
changeset
|
2527 Lisp_Object buffer, start, end; |
305 | 2528 { |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2529 register int b, e, temp; |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2530 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
|
2531 Lisp_Object buf; |
04990cada43d
(Finsert_buffer_substring): Make argument names match their use in
Juanma Barranquero <lekktu@gmail.com>
parents:
55193
diff
changeset
|
2532 |
04990cada43d
(Finsert_buffer_substring): Make argument names match their use in
Juanma Barranquero <lekktu@gmail.com>
parents:
55193
diff
changeset
|
2533 buf = Fget_buffer (buffer); |
04990cada43d
(Finsert_buffer_substring): Make argument names match their use in
Juanma Barranquero <lekktu@gmail.com>
parents:
55193
diff
changeset
|
2534 if (NILP (buf)) |
04990cada43d
(Finsert_buffer_substring): Make argument names match their use in
Juanma Barranquero <lekktu@gmail.com>
parents:
55193
diff
changeset
|
2535 nsberror (buffer); |
04990cada43d
(Finsert_buffer_substring): Make argument names match their use in
Juanma Barranquero <lekktu@gmail.com>
parents:
55193
diff
changeset
|
2536 bp = XBUFFER (buf); |
16134
7558d82368f9
(Finsert_buffer_substring): Check for deleted buffer.
Karl Heuer <kwzh@gnu.org>
parents:
16097
diff
changeset
|
2537 if (NILP (bp->name)) |
7558d82368f9
(Finsert_buffer_substring): Check for deleted buffer.
Karl Heuer <kwzh@gnu.org>
parents:
16097
diff
changeset
|
2538 error ("Selecting deleted buffer"); |
305 | 2539 |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2540 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
|
2541 b = BUF_BEGV (bp); |
305 | 2542 else |
2543 { | |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
2544 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
|
2545 b = XINT (start); |
305 | 2546 } |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2547 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
|
2548 e = BUF_ZV (bp); |
305 | 2549 else |
2550 { | |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
2551 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
|
2552 e = XINT (end); |
305 | 2553 } |
2554 | |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2555 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
|
2556 temp = b, b = e, e = temp; |
305 | 2557 |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2558 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
|
2559 args_out_of_range (start, end); |
305 | 2560 |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2561 obuf = current_buffer; |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2562 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
|
2563 update_buffer_properties (b, e); |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2564 set_buffer_internal_1 (obuf); |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
2565 |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
2566 insert_from_buffer (bp, b, e - b, 0); |
305 | 2567 return Qnil; |
2568 } | |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2569 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2570 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
|
2571 6, 6, 0, |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
2572 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
|
2573 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
|
2574 +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
|
2575 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
|
2576 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
|
2577 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
2578 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
|
2579 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
|
2580 (buffer1, start1, end1, buffer2, start2, end2) |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2581 Lisp_Object buffer1, start1, end1, buffer2, start2, end2; |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2582 { |
21837
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2583 register int begp1, endp1, begp2, endp2, temp; |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2584 register struct buffer *bp1, *bp2; |
66367
a80af18dfc7e
(Fcompare_buffer_substrings): Handle multibyte chars.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65763
diff
changeset
|
2585 register Lisp_Object trt |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2586 = (!NILP (current_buffer->case_fold_search) |
66379
48a5d83a7c9d
(Fcompare_buffer_substrings): Fix last change.
Kim F. Storm <storm@cua.dk>
parents:
66367
diff
changeset
|
2587 ? 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
|
2588 int chars = 0; |
21837
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2589 int i1, i2, i1_byte, i2_byte; |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2590 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2591 /* Find the first buffer and its substring. */ |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2592 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2593 if (NILP (buffer1)) |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2594 bp1 = current_buffer; |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2595 else |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2596 { |
1854
5a18c36181fa
(Finsert_buffer_substring): Proper error for non-ex buffer.
Richard M. Stallman <rms@gnu.org>
parents:
1853
diff
changeset
|
2597 Lisp_Object buf1; |
5a18c36181fa
(Finsert_buffer_substring): Proper error for non-ex buffer.
Richard M. Stallman <rms@gnu.org>
parents:
1853
diff
changeset
|
2598 buf1 = Fget_buffer (buffer1); |
5a18c36181fa
(Finsert_buffer_substring): Proper error for non-ex buffer.
Richard M. Stallman <rms@gnu.org>
parents:
1853
diff
changeset
|
2599 if (NILP (buf1)) |
5a18c36181fa
(Finsert_buffer_substring): Proper error for non-ex buffer.
Richard M. Stallman <rms@gnu.org>
parents:
1853
diff
changeset
|
2600 nsberror (buffer1); |
5a18c36181fa
(Finsert_buffer_substring): Proper error for non-ex buffer.
Richard M. Stallman <rms@gnu.org>
parents:
1853
diff
changeset
|
2601 bp1 = XBUFFER (buf1); |
16134
7558d82368f9
(Finsert_buffer_substring): Check for deleted buffer.
Karl Heuer <kwzh@gnu.org>
parents:
16097
diff
changeset
|
2602 if (NILP (bp1->name)) |
7558d82368f9
(Finsert_buffer_substring): Check for deleted buffer.
Karl Heuer <kwzh@gnu.org>
parents:
16097
diff
changeset
|
2603 error ("Selecting deleted buffer"); |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2604 } |
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 (start1)) |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2607 begp1 = BUF_BEGV (bp1); |
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 (start1); |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2611 begp1 = XINT (start1); |
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 if (NILP (end1)) |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2614 endp1 = BUF_ZV (bp1); |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2615 else |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2616 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
2617 CHECK_NUMBER_COERCE_MARKER (end1); |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2618 endp1 = XINT (end1); |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2619 } |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2620 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2621 if (begp1 > endp1) |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2622 temp = begp1, begp1 = endp1, endp1 = temp; |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2623 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2624 if (!(BUF_BEGV (bp1) <= begp1 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2625 && begp1 <= endp1 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2626 && endp1 <= BUF_ZV (bp1))) |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2627 args_out_of_range (start1, end1); |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2628 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2629 /* Likewise for second substring. */ |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2630 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2631 if (NILP (buffer2)) |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2632 bp2 = current_buffer; |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2633 else |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2634 { |
1854
5a18c36181fa
(Finsert_buffer_substring): Proper error for non-ex buffer.
Richard M. Stallman <rms@gnu.org>
parents:
1853
diff
changeset
|
2635 Lisp_Object buf2; |
5a18c36181fa
(Finsert_buffer_substring): Proper error for non-ex buffer.
Richard M. Stallman <rms@gnu.org>
parents:
1853
diff
changeset
|
2636 buf2 = Fget_buffer (buffer2); |
5a18c36181fa
(Finsert_buffer_substring): Proper error for non-ex buffer.
Richard M. Stallman <rms@gnu.org>
parents:
1853
diff
changeset
|
2637 if (NILP (buf2)) |
5a18c36181fa
(Finsert_buffer_substring): Proper error for non-ex buffer.
Richard M. Stallman <rms@gnu.org>
parents:
1853
diff
changeset
|
2638 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
|
2639 bp2 = XBUFFER (buf2); |
16134
7558d82368f9
(Finsert_buffer_substring): Check for deleted buffer.
Karl Heuer <kwzh@gnu.org>
parents:
16097
diff
changeset
|
2640 if (NILP (bp2->name)) |
7558d82368f9
(Finsert_buffer_substring): Check for deleted buffer.
Karl Heuer <kwzh@gnu.org>
parents:
16097
diff
changeset
|
2641 error ("Selecting deleted buffer"); |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2642 } |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2643 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2644 if (NILP (start2)) |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2645 begp2 = BUF_BEGV (bp2); |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2646 else |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2647 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
2648 CHECK_NUMBER_COERCE_MARKER (start2); |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2649 begp2 = XINT (start2); |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2650 } |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2651 if (NILP (end2)) |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2652 endp2 = BUF_ZV (bp2); |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2653 else |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2654 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
2655 CHECK_NUMBER_COERCE_MARKER (end2); |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2656 endp2 = XINT (end2); |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2657 } |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2658 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2659 if (begp2 > endp2) |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2660 temp = begp2, begp2 = endp2, endp2 = temp; |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2661 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2662 if (!(BUF_BEGV (bp2) <= begp2 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2663 && begp2 <= endp2 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2664 && endp2 <= BUF_ZV (bp2))) |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2665 args_out_of_range (start2, end2); |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2666 |
21837
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2667 i1 = begp1; |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2668 i2 = begp2; |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2669 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
|
2670 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
|
2671 |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2672 while (i1 < endp1 && i2 < endp2) |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2673 { |
21837
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2674 /* 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
|
2675 characters, not just the bytes. */ |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2676 int c1, c2; |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2677 |
42116
37b724c77b98
(Fcompare_buffer_substrings): Add QUIT to main loop.
Richard M. Stallman <rms@gnu.org>
parents:
41065
diff
changeset
|
2678 QUIT; |
37b724c77b98
(Fcompare_buffer_substrings): Add QUIT to main loop.
Richard M. Stallman <rms@gnu.org>
parents:
41065
diff
changeset
|
2679 |
21837
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2680 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
|
2681 { |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2682 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
|
2683 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
|
2684 i1++; |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2685 } |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2686 else |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2687 { |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2688 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
|
2689 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
|
2690 i1++; |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2691 } |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2692 |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2693 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
|
2694 { |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2695 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
|
2696 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
|
2697 i2++; |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2698 } |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2699 else |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2700 { |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2701 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
|
2702 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
|
2703 i2++; |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2704 } |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
2705 |
66367
a80af18dfc7e
(Fcompare_buffer_substrings): Handle multibyte chars.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65763
diff
changeset
|
2706 if (!NILP (trt)) |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2707 { |
66367
a80af18dfc7e
(Fcompare_buffer_substrings): Handle multibyte chars.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65763
diff
changeset
|
2708 c1 = CHAR_TABLE_TRANSLATE (trt, c1); |
a80af18dfc7e
(Fcompare_buffer_substrings): Handle multibyte chars.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65763
diff
changeset
|
2709 c2 = CHAR_TABLE_TRANSLATE (trt, c2); |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2710 } |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2711 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
|
2712 return make_number (- 1 - chars); |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2713 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
|
2714 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
|
2715 |
ea78758c282e
(Fcompare_buffer_substrings): Rewrite to loop by chars.
Richard M. Stallman <rms@gnu.org>
parents:
21821
diff
changeset
|
2716 chars++; |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2717 } |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2718 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2719 /* The strings match as far as they go. |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2720 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
|
2721 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
|
2722 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
|
2723 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
|
2724 return make_number (- chars - 1); |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2725 |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2726 /* Same length too => they are equal. */ |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2727 return make_number (0); |
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
2728 } |
305 | 2729 |
10480
fbb254882b9f
(subst_char_in_region_unwind): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10383
diff
changeset
|
2730 static Lisp_Object |
fbb254882b9f
(subst_char_in_region_unwind): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10383
diff
changeset
|
2731 subst_char_in_region_unwind (arg) |
fbb254882b9f
(subst_char_in_region_unwind): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10383
diff
changeset
|
2732 Lisp_Object arg; |
fbb254882b9f
(subst_char_in_region_unwind): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10383
diff
changeset
|
2733 { |
fbb254882b9f
(subst_char_in_region_unwind): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10383
diff
changeset
|
2734 return current_buffer->undo_list = arg; |
fbb254882b9f
(subst_char_in_region_unwind): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10383
diff
changeset
|
2735 } |
fbb254882b9f
(subst_char_in_region_unwind): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10383
diff
changeset
|
2736 |
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
|
2737 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
|
2738 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
|
2739 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
|
2740 { |
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
|
2741 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
|
2742 } |
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
|
2743 |
305 | 2744 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
|
2745 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
|
2746 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
|
2747 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
|
2748 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
|
2749 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
|
2750 (start, end, fromchar, tochar, noundo) |
305 | 2751 Lisp_Object start, end, fromchar, tochar, noundo; |
2752 { | |
20834
95a80c1e06c3
(Fsubst_char_in_region): Handle character-base
Kenichi Handa <handa@m17n.org>
parents:
20826
diff
changeset
|
2753 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
|
2754 /* 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
|
2755 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
|
2756 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
|
2757 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
|
2758 int changed = 0; |
26853
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2759 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
|
2760 unsigned char *p; |
46293
1fb8f75062c6
Use macro SPECPDL_INDEX.
Juanma Barranquero <lekktu@gmail.com>
parents:
45398
diff
changeset
|
2761 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
|
2762 #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
|
2763 #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
|
2764 #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
|
2765 #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
|
2766 int maybe_byte_combining = COMBINING_NO; |
32420
40df6727225a
(save_excursion_save): Additionally record the
Gerd Moellmann <gerd@gnu.org>
parents:
31774
diff
changeset
|
2767 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
|
2768 int multibyte_p = !NILP (current_buffer->enable_multibyte_characters); |
305 | 2769 |
72272
f3b2e3e20e3b
(Fsubst_char_in_region): Redo the setup work after running
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
72194
diff
changeset
|
2770 restart: |
f3b2e3e20e3b
(Fsubst_char_in_region): Redo the setup work after running
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
72194
diff
changeset
|
2771 |
305 | 2772 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
|
2773 CHECK_NUMBER (fromchar); |
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
2774 CHECK_NUMBER (tochar); |
305 | 2775 |
28358
7ae3851c0a19
(Fsubst_char_in_region): Don't use INC_POS in unibyte
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2776 if (multibyte_p) |
17031 | 2777 { |
26853
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2778 len = CHAR_STRING (XFASTINT (fromchar), fromstr); |
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2779 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
|
2780 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
|
2781 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
|
2782 { |
b9b4581adf36
(Fsubst_char_in_region): Adjust the way to check byte-combining
Kenichi Handa <handa@m17n.org>
parents:
25346
diff
changeset
|
2783 /* 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
|
2784 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
|
2785 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
|
2786 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
|
2787 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
|
2788 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
|
2789 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
|
2790 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
|
2791 } |
17031 | 2792 } |
2793 else | |
2794 { | |
2795 len = 1; | |
26853
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2796 fromstr[0] = XFASTINT (fromchar); |
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2797 tostr[0] = XFASTINT (tochar); |
17031 | 2798 } |
2799 | |
20834
95a80c1e06c3
(Fsubst_char_in_region): Handle character-base
Kenichi Handa <handa@m17n.org>
parents:
20826
diff
changeset
|
2800 pos = XINT (start); |
95a80c1e06c3
(Fsubst_char_in_region): Handle character-base
Kenichi Handa <handa@m17n.org>
parents:
20826
diff
changeset
|
2801 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
|
2802 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
|
2803 end_byte = stop; |
305 | 2804 |
10480
fbb254882b9f
(subst_char_in_region_unwind): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10383
diff
changeset
|
2805 /* 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
|
2806 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
|
2807 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
|
2808 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
|
2809 if (!changed && !NILP (noundo)) |
10480
fbb254882b9f
(subst_char_in_region_unwind): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10383
diff
changeset
|
2810 { |
fbb254882b9f
(subst_char_in_region_unwind): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10383
diff
changeset
|
2811 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
|
2812 current_buffer->undo_list); |
fbb254882b9f
(subst_char_in_region_unwind): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10383
diff
changeset
|
2813 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
|
2814 /* 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
|
2815 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
|
2816 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
|
2817 current_buffer->filename = Qnil; |
10480
fbb254882b9f
(subst_char_in_region_unwind): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10383
diff
changeset
|
2818 } |
fbb254882b9f
(subst_char_in_region_unwind): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10383
diff
changeset
|
2819 |
20834
95a80c1e06c3
(Fsubst_char_in_region): Handle character-base
Kenichi Handa <handa@m17n.org>
parents:
20826
diff
changeset
|
2820 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
|
2821 stop = min (stop, GPT_BYTE); |
17031 | 2822 while (1) |
305 | 2823 { |
23554
e06e84c477fa
(Fsubst_char_in_region): Correctly handle the case
Kenichi Handa <handa@m17n.org>
parents:
23553
diff
changeset
|
2824 int pos_byte_next = pos_byte; |
e06e84c477fa
(Fsubst_char_in_region): Correctly handle the case
Kenichi Handa <handa@m17n.org>
parents:
23553
diff
changeset
|
2825 |
20834
95a80c1e06c3
(Fsubst_char_in_region): Handle character-base
Kenichi Handa <handa@m17n.org>
parents:
20826
diff
changeset
|
2826 if (pos_byte >= stop) |
17031 | 2827 { |
20834
95a80c1e06c3
(Fsubst_char_in_region): Handle character-base
Kenichi Handa <handa@m17n.org>
parents:
20826
diff
changeset
|
2828 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
|
2829 stop = end_byte; |
17031 | 2830 } |
20834
95a80c1e06c3
(Fsubst_char_in_region): Handle character-base
Kenichi Handa <handa@m17n.org>
parents:
20826
diff
changeset
|
2831 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
|
2832 if (multibyte_p) |
7ae3851c0a19
(Fsubst_char_in_region): Don't use INC_POS in unibyte
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2833 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
|
2834 else |
7ae3851c0a19
(Fsubst_char_in_region): Don't use INC_POS in unibyte
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2835 ++pos_byte_next; |
23554
e06e84c477fa
(Fsubst_char_in_region): Correctly handle the case
Kenichi Handa <handa@m17n.org>
parents:
23553
diff
changeset
|
2836 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
|
2837 && p[0] == fromstr[0] |
17031 | 2838 && (len == 1 |
2839 || (p[1] == fromstr[1] | |
2840 && (len == 2 || (p[2] == fromstr[2] | |
2841 && (len == 3 || p[3] == fromstr[3])))))) | |
305 | 2842 { |
72272
f3b2e3e20e3b
(Fsubst_char_in_region): Redo the setup work after running
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
72194
diff
changeset
|
2843 if (changed < 0) |
f3b2e3e20e3b
(Fsubst_char_in_region): Redo the setup work after running
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
72194
diff
changeset
|
2844 /* 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
|
2845 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
|
2846 changed = pos; |
f3b2e3e20e3b
(Fsubst_char_in_region): Redo the setup work after running
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
72194
diff
changeset
|
2847 else if (!changed) |
5130
ddee29e260d2
(make_buffer_string): Don't copy intervals
Richard M. Stallman <rms@gnu.org>
parents:
4943
diff
changeset
|
2848 { |
72272
f3b2e3e20e3b
(Fsubst_char_in_region): Redo the setup work after running
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
72194
diff
changeset
|
2849 changed = -1; |
72592
f6de516bbb4b
* buffer.h (struct buffer_text): New field chars_modiff.
Chong Yidong <cyd@stupidchicken.com>
parents:
72584
diff
changeset
|
2850 modify_region (current_buffer, pos, XINT (end), 0); |
5242
0e99ea9941e2
(Fmessage): Use message2.
Richard M. Stallman <rms@gnu.org>
parents:
5130
diff
changeset
|
2851 |
0e99ea9941e2
(Fmessage): Use message2.
Richard M. Stallman <rms@gnu.org>
parents:
5130
diff
changeset
|
2852 if (! NILP (noundo)) |
0e99ea9941e2
(Fmessage): Use message2.
Richard M. Stallman <rms@gnu.org>
parents:
5130
diff
changeset
|
2853 { |
10308
90784ed0416f
Use SAVE_MODIFF and BUF_SAVE_MODIFF
Richard M. Stallman <rms@gnu.org>
parents:
9812
diff
changeset
|
2854 if (MODIFF - 1 == SAVE_MODIFF) |
90784ed0416f
Use SAVE_MODIFF and BUF_SAVE_MODIFF
Richard M. Stallman <rms@gnu.org>
parents:
9812
diff
changeset
|
2855 SAVE_MODIFF++; |
5242
0e99ea9941e2
(Fmessage): Use message2.
Richard M. Stallman <rms@gnu.org>
parents:
5130
diff
changeset
|
2856 if (MODIFF - 1 == current_buffer->auto_save_modified) |
0e99ea9941e2
(Fmessage): Use message2.
Richard M. Stallman <rms@gnu.org>
parents:
5130
diff
changeset
|
2857 current_buffer->auto_save_modified++; |
0e99ea9941e2
(Fmessage): Use message2.
Richard M. Stallman <rms@gnu.org>
parents:
5130
diff
changeset
|
2858 } |
72272
f3b2e3e20e3b
(Fsubst_char_in_region): Redo the setup work after running
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
72194
diff
changeset
|
2859 |
f3b2e3e20e3b
(Fsubst_char_in_region): Redo the setup work after running
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
72194
diff
changeset
|
2860 /* 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
|
2861 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
|
2862 goto restart; |
5130
ddee29e260d2
(make_buffer_string): Don't copy intervals
Richard M. Stallman <rms@gnu.org>
parents:
4943
diff
changeset
|
2863 } |
ddee29e260d2
(make_buffer_string): Don't copy intervals
Richard M. Stallman <rms@gnu.org>
parents:
4943
diff
changeset
|
2864 |
22895
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2865 /* Take care of the case where the new character |
30480 | 2866 combines with neighboring bytes. */ |
23554
e06e84c477fa
(Fsubst_char_in_region): Correctly handle the case
Kenichi Handa <handa@m17n.org>
parents:
23553
diff
changeset
|
2867 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
|
2868 && (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
|
2869 ? (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
|
2870 && ! 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
|
2871 : ((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
|
2872 && ! 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
|
2873 || (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
|
2874 && ! 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
|
2875 { |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2876 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
|
2877 |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2878 struct gcpro gcpro1; |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2879 |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2880 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
|
2881 GCPRO1 (tem); |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2882 |
25507
b9b4581adf36
(Fsubst_char_in_region): Adjust the way to check byte-combining
Kenichi Handa <handa@m17n.org>
parents:
25346
diff
changeset
|
2883 /* 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
|
2884 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
|
2885 /* 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
|
2886 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
|
2887 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
|
2888 0, 0, 1); |
23554
e06e84c477fa
(Fsubst_char_in_region): Correctly handle the case
Kenichi Handa <handa@m17n.org>
parents:
23553
diff
changeset
|
2889 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
|
2890 if (pos_byte_next > pos_byte) |
e06e84c477fa
(Fsubst_char_in_region): Correctly handle the case
Kenichi Handa <handa@m17n.org>
parents:
23553
diff
changeset
|
2891 /* 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
|
2892 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
|
2893 decrease it now. */ |
077655e1e014
(Fsubst_char_in_region): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23554
diff
changeset
|
2894 pos--; |
23554
e06e84c477fa
(Fsubst_char_in_region): Correctly handle the case
Kenichi Handa <handa@m17n.org>
parents:
23553
diff
changeset
|
2895 else |
23565
077655e1e014
(Fsubst_char_in_region): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23554
diff
changeset
|
2896 INC_POS (pos_byte_next); |
30480 | 2897 |
22895
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2898 if (! NILP (noundo)) |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2899 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
|
2900 |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2901 UNGCPRO; |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2902 } |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2903 else |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2904 { |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2905 if (NILP (noundo)) |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
2906 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
|
2907 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
|
2908 } |
26853
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2909 last_changed = pos + 1; |
305 | 2910 } |
23565
077655e1e014
(Fsubst_char_in_region): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23554
diff
changeset
|
2911 pos_byte = pos_byte_next; |
077655e1e014
(Fsubst_char_in_region): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23554
diff
changeset
|
2912 pos++; |
305 | 2913 } |
2914 | |
72272
f3b2e3e20e3b
(Fsubst_char_in_region): Redo the setup work after running
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
72194
diff
changeset
|
2915 if (changed > 0) |
26853
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2916 { |
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2917 signal_after_change (changed, |
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2918 last_changed - changed, last_changed - changed); |
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
2919 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
|
2920 } |
5130
ddee29e260d2
(make_buffer_string): Don't copy intervals
Richard M. Stallman <rms@gnu.org>
parents:
4943
diff
changeset
|
2921 |
10480
fbb254882b9f
(subst_char_in_region_unwind): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10383
diff
changeset
|
2922 unbind_to (count, Qnil); |
305 | 2923 return Qnil; |
2924 } | |
2925 | |
89878 | 2926 |
2927 static Lisp_Object check_translation P_ ((int, int, int, Lisp_Object)); | |
2928 | |
2929 /* Helper function for Ftranslate_region_internal. | |
2930 | |
2931 Check if a character sequence at POS (POS_BYTE) matches an element | |
2932 of VAL. VAL is a list (([FROM-CHAR ...] . TO) ...). If a matching | |
2933 element is found, return it. Otherwise return Qnil. */ | |
2934 | |
2935 static Lisp_Object | |
2936 check_translation (pos, pos_byte, end, val) | |
2937 int pos, pos_byte, end; | |
2938 Lisp_Object val; | |
2939 { | |
2940 int buf_size = 16, buf_used = 0; | |
2941 int *buf = alloca (sizeof (int) * buf_size); | |
2942 | |
2943 for (; CONSP (val); val = XCDR (val)) | |
2944 { | |
2945 Lisp_Object elt; | |
2946 int len, i; | |
2947 | |
2948 elt = XCAR (val); | |
2949 if (! CONSP (elt)) | |
2950 continue; | |
2951 elt = XCAR (elt); | |
2952 if (! VECTORP (elt)) | |
2953 continue; | |
2954 len = ASIZE (elt); | |
2955 if (len <= end - pos) | |
2956 { | |
2957 for (i = 0; i < len; i++) | |
2958 { | |
2959 if (buf_used <= i) | |
2960 { | |
2961 unsigned char *p = BYTE_POS_ADDR (pos_byte); | |
2962 int len; | |
2963 | |
2964 if (buf_used == buf_size) | |
2965 { | |
2966 int *newbuf; | |
2967 | |
2968 buf_size += 16; | |
2969 newbuf = alloca (sizeof (int) * buf_size); | |
2970 memcpy (newbuf, buf, sizeof (int) * buf_used); | |
2971 buf = newbuf; | |
2972 } | |
2973 buf[buf_used++] = STRING_CHAR_AND_LENGTH (p, 0, len); | |
2974 pos_byte += len; | |
2975 } | |
2976 if (XINT (AREF (elt, i)) != buf[i]) | |
2977 break; | |
2978 } | |
2979 if (i == len) | |
2980 return XCAR (val); | |
2981 } | |
2982 } | |
2983 return Qnil; | |
2984 } | |
2985 | |
2986 | |
57644
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2987 DEFUN ("translate-region-internal", Ftranslate_region_internal, |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2988 Stranslate_region_internal, 3, 3, 0, |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2989 doc: /* Internal use only. |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
2990 From START to END, translate characters according to TABLE. |
89878 | 2991 TABLE is a string or a char-table; the Nth character in it is the |
2992 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
|
2993 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
|
2994 (start, end, table) |
305 | 2995 Lisp_Object start; |
2996 Lisp_Object end; | |
2997 register Lisp_Object table; | |
2998 { | |
2999 register unsigned char *tt; /* Trans table. */ | |
3000 register int nc; /* New character. */ | |
3001 int cnt; /* Number of changes made. */ | |
3002 int size; /* Size of translate table. */ | |
57644
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
3003 int pos, pos_byte, end_pos; |
26415
bda6a3a2bf96
(Ftranslate_region): Check the buffer multibyteness.
Kenichi Handa <handa@m17n.org>
parents:
26389
diff
changeset
|
3004 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
|
3005 int string_multibyte; |
89840
c49eea8699c8
(Ftranslate_region_internal): Renamed from
Kenichi Handa <handa@m17n.org>
parents:
89601
diff
changeset
|
3006 Lisp_Object val; |
305 | 3007 |
3008 validate_region (&start, &end); | |
57644
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
3009 if (CHAR_TABLE_P (table)) |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
3010 { |
89878 | 3011 if (! EQ (XCHAR_TABLE (table)->purpose, Qtranslation_table)) |
3012 error ("Not a translation table"); | |
57644
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
3013 size = MAX_CHAR; |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
3014 tt = NULL; |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
3015 } |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
3016 else |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
3017 { |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
3018 CHECK_STRING (table); |
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 if (! multibyte && (SCHARS (table) < SBYTES (table))) |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
3021 table = string_make_unibyte (table); |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
3022 string_multibyte = SCHARS (table) < SBYTES (table); |
89840
c49eea8699c8
(Ftranslate_region_internal): Renamed from
Kenichi Handa <handa@m17n.org>
parents:
89601
diff
changeset
|
3023 size = SBYTES (table); |
57644
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
3024 tt = SDATA (table); |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
3025 } |
305 | 3026 |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3027 pos = XINT (start); |
54214
a2f5ab3b6d1b
(Ftranslate_region): Fix previous change
Kenichi Handa <handa@m17n.org>
parents:
54213
diff
changeset
|
3028 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
|
3029 end_pos = XINT (end); |
90599 | 3030 modify_region (current_buffer, pos, end_pos, 0); |
305 | 3031 |
3032 cnt = 0; | |
57644
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
3033 for (; pos < end_pos; ) |
305 | 3034 { |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3035 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
|
3036 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
|
3037 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
|
3038 int oc; |
89878 | 3039 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
|
3040 |
26415
bda6a3a2bf96
(Ftranslate_region): Check the buffer multibyteness.
Kenichi Handa <handa@m17n.org>
parents:
26389
diff
changeset
|
3041 if (multibyte) |
54214
a2f5ab3b6d1b
(Ftranslate_region): Fix previous change
Kenichi Handa <handa@m17n.org>
parents:
54213
diff
changeset
|
3042 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
|
3043 else |
bda6a3a2bf96
(Ftranslate_region): Check the buffer multibyteness.
Kenichi Handa <handa@m17n.org>
parents:
26389
diff
changeset
|
3044 oc = *p, len = 1; |
54213
29d4d158e5eb
(Ftranslate_region): Handle multibyte chars in the arg
Kenichi Handa <handa@m17n.org>
parents:
53819
diff
changeset
|
3045 if (oc < size) |
305 | 3046 { |
57644
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
3047 if (tt) |
54213
29d4d158e5eb
(Ftranslate_region): Handle multibyte chars in the arg
Kenichi Handa <handa@m17n.org>
parents:
53819
diff
changeset
|
3048 { |
65455
51d3a3f03a8a
(Ftranslate_region_internal): Reload `tt' after
Kim F. Storm <storm@cua.dk>
parents:
65324
diff
changeset
|
3049 /* 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
|
3050 tt = SDATA (table); |
57644
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
3051 if (string_multibyte) |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
3052 { |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
3053 str = tt + string_char_to_byte (table, oc); |
93921
f7d6d03d8ceb
(Ffield_string_no_properties): Fix typo in docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
93038
diff
changeset
|
3054 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
|
3055 str_len); |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
3056 } |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
3057 else |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
3058 { |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
3059 nc = tt[oc]; |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
3060 if (! ASCII_BYTE_P (nc) && multibyte) |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
3061 { |
90050
1df66cb75f66
(Ftranslate_region_internal): Don't convert unibyte
Kenichi Handa <handa@m17n.org>
parents:
90044
diff
changeset
|
3062 str_len = BYTE8_STRING (nc, buf); |
57644
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
3063 str = buf; |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
3064 } |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
3065 else |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
3066 { |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
3067 str_len = 1; |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
3068 str = tt + oc; |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
3069 } |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
3070 } |
54213
29d4d158e5eb
(Ftranslate_region): Handle multibyte chars in the arg
Kenichi Handa <handa@m17n.org>
parents:
53819
diff
changeset
|
3071 } |
29d4d158e5eb
(Ftranslate_region): Handle multibyte chars in the arg
Kenichi Handa <handa@m17n.org>
parents:
53819
diff
changeset
|
3072 else |
29d4d158e5eb
(Ftranslate_region): Handle multibyte chars in the arg
Kenichi Handa <handa@m17n.org>
parents:
53819
diff
changeset
|
3073 { |
57644
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
3074 int c; |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
3075 |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
3076 nc = oc; |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
3077 val = CHAR_TABLE_REF (table, oc); |
90050
1df66cb75f66
(Ftranslate_region_internal): Don't convert unibyte
Kenichi Handa <handa@m17n.org>
parents:
90044
diff
changeset
|
3078 if (CHARACTERP (val) |
57644
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
3079 && (c = XINT (val), CHAR_VALID_P (c, 0))) |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
3080 { |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
3081 nc = c; |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
3082 str_len = CHAR_STRING (nc, buf); |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
3083 str = buf; |
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
3084 } |
90050
1df66cb75f66
(Ftranslate_region_internal): Don't convert unibyte
Kenichi Handa <handa@m17n.org>
parents:
90044
diff
changeset
|
3085 else if (VECTORP (val) || (CONSP (val))) |
1df66cb75f66
(Ftranslate_region_internal): Don't convert unibyte
Kenichi Handa <handa@m17n.org>
parents:
90044
diff
changeset
|
3086 { |
1df66cb75f66
(Ftranslate_region_internal): Don't convert unibyte
Kenichi Handa <handa@m17n.org>
parents:
90044
diff
changeset
|
3087 /* 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
|
3088 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
|
3089 nc = -1; |
1df66cb75f66
(Ftranslate_region_internal): Don't convert unibyte
Kenichi Handa <handa@m17n.org>
parents:
90044
diff
changeset
|
3090 } |
54213
29d4d158e5eb
(Ftranslate_region): Handle multibyte chars in the arg
Kenichi Handa <handa@m17n.org>
parents:
53819
diff
changeset
|
3091 } |
57644
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
3092 |
90050
1df66cb75f66
(Ftranslate_region_internal): Don't convert unibyte
Kenichi Handa <handa@m17n.org>
parents:
90044
diff
changeset
|
3093 if (nc != oc && nc >= 0) |
305 | 3094 { |
89878 | 3095 /* Simple one char to one char translation. */ |
54214
a2f5ab3b6d1b
(Ftranslate_region): Fix previous change
Kenichi Handa <handa@m17n.org>
parents:
54213
diff
changeset
|
3096 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
|
3097 { |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
3098 Lisp_Object string; |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
3099 |
54214
a2f5ab3b6d1b
(Ftranslate_region): Fix previous change
Kenichi Handa <handa@m17n.org>
parents:
54213
diff
changeset
|
3100 /* This is less efficient, because it moves the gap, |
89878 | 3101 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
|
3102 string = make_multibyte_string (str, 1, str_len); |
54214
a2f5ab3b6d1b
(Ftranslate_region): Fix previous change
Kenichi Handa <handa@m17n.org>
parents:
54213
diff
changeset
|
3103 replace_range (pos, pos + 1, string, 1, 0, 1); |
a2f5ab3b6d1b
(Ftranslate_region): Fix previous change
Kenichi Handa <handa@m17n.org>
parents:
54213
diff
changeset
|
3104 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
|
3105 } |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
3106 else |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
3107 { |
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
3108 record_change (pos, 1); |
54213
29d4d158e5eb
(Ftranslate_region): Handle multibyte chars in the arg
Kenichi Handa <handa@m17n.org>
parents:
53819
diff
changeset
|
3109 while (str_len-- > 0) |
29d4d158e5eb
(Ftranslate_region): Handle multibyte chars in the arg
Kenichi Handa <handa@m17n.org>
parents:
53819
diff
changeset
|
3110 *p++ = *str++; |
22895
9f800ebc6091
(Fsubst_char_in_region): Use replace_range in the case
Richard M. Stallman <rms@gnu.org>
parents:
22712
diff
changeset
|
3111 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
|
3112 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
|
3113 } |
305 | 3114 ++cnt; |
3115 } | |
90050
1df66cb75f66
(Ftranslate_region_internal): Don't convert unibyte
Kenichi Handa <handa@m17n.org>
parents:
90044
diff
changeset
|
3116 else if (nc < 0) |
89840
c49eea8699c8
(Ftranslate_region_internal): Renamed from
Kenichi Handa <handa@m17n.org>
parents:
89601
diff
changeset
|
3117 { |
89878 | 3118 Lisp_Object string; |
3119 | |
3120 if (CONSP (val)) | |
3121 { | |
3122 val = check_translation (pos, pos_byte, end_pos, val); | |
3123 if (NILP (val)) | |
3124 { | |
3125 pos_byte += len; | |
3126 pos++; | |
3127 continue; | |
3128 } | |
3129 /* VAL is ([FROM-CHAR ...] . TO). */ | |
3130 len = ASIZE (XCAR (val)); | |
3131 val = XCDR (val); | |
3132 } | |
3133 else | |
3134 len = 1; | |
3135 | |
3136 if (VECTORP (val)) | |
3137 { | |
3138 int i; | |
3139 | |
3140 string = Fmake_string (make_number (ASIZE (val)), | |
3141 AREF (val, 0)); | |
3142 for (i = 1; i < ASIZE (val); i++) | |
3143 Faset (string, make_number (i), AREF (val, i)); | |
3144 } | |
3145 else | |
3146 { | |
3147 string = Fmake_string (make_number (1), val); | |
3148 } | |
3149 replace_range (pos, pos + len, string, 1, 0, 1); | |
3150 pos_byte += SBYTES (string); | |
3151 pos += SCHARS (string); | |
3152 cnt += SCHARS (string); | |
3153 end_pos += SCHARS (string) - len; | |
3154 continue; | |
89840
c49eea8699c8
(Ftranslate_region_internal): Renamed from
Kenichi Handa <handa@m17n.org>
parents:
89601
diff
changeset
|
3155 } |
305 | 3156 } |
54214
a2f5ab3b6d1b
(Ftranslate_region): Fix previous change
Kenichi Handa <handa@m17n.org>
parents:
54213
diff
changeset
|
3157 pos_byte += len; |
23565
077655e1e014
(Fsubst_char_in_region): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23554
diff
changeset
|
3158 pos++; |
305 | 3159 } |
3160 | |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3161 return make_number (cnt); |
305 | 3162 } |
3163 | |
3164 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
|
3165 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
|
3166 |
39966
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3167 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
|
3168 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
|
3169 (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
|
3170 Lisp_Object start, end; |
305 | 3171 { |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
3172 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
|
3173 del_range (XINT (start), XINT (end)); |
305 | 3174 return Qnil; |
3175 } | |
26742
936b39bd05b4
* editfns.c (Fdelete_and_extract_region): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
26699
diff
changeset
|
3176 |
936b39bd05b4
* editfns.c (Fdelete_and_extract_region): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
26699
diff
changeset
|
3177 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
|
3178 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
|
3179 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
|
3180 (start, end) |
26742
936b39bd05b4
* editfns.c (Fdelete_and_extract_region): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
26699
diff
changeset
|
3181 Lisp_Object start, end; |
936b39bd05b4
* editfns.c (Fdelete_and_extract_region): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
26699
diff
changeset
|
3182 { |
936b39bd05b4
* editfns.c (Fdelete_and_extract_region): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
26699
diff
changeset
|
3183 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
|
3184 if (XINT (start) == XINT (end)) |
81286
6194f2677500
(Fdelete_and_extract_region): Use empty_unibyte_string.
Juanma Barranquero <lekktu@gmail.com>
parents:
81259
diff
changeset
|
3185 return empty_unibyte_string; |
26742
936b39bd05b4
* editfns.c (Fdelete_and_extract_region): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
26699
diff
changeset
|
3186 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
|
3187 } |
305 | 3188 |
3189 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
|
3190 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
|
3191 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
|
3192 () |
305 | 3193 { |
19207
be370e94fb42
(Fwiden, Fnarrow_to_region, save_restriction_restore):
Richard M. Stallman <rms@gnu.org>
parents:
19032
diff
changeset
|
3194 if (BEG != BEGV || Z != ZV) |
be370e94fb42
(Fwiden, Fnarrow_to_region, save_restriction_restore):
Richard M. Stallman <rms@gnu.org>
parents:
19032
diff
changeset
|
3195 current_buffer->clip_changed = 1; |
305 | 3196 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
|
3197 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
|
3198 SET_BUF_ZV_BOTH (current_buffer, Z, Z_BYTE); |
330 | 3199 /* Changing the buffer bounds invalidates any recorded current column. */ |
3200 invalidate_current_column (); | |
305 | 3201 return Qnil; |
3202 } | |
3203 | |
3204 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
|
3205 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
|
3206 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
|
3207 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
|
3208 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
|
3209 See also `save-restriction'. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3210 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3211 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
|
3212 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
|
3213 (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
|
3214 register Lisp_Object start, end; |
305 | 3215 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
3216 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
|
3217 CHECK_NUMBER_COERCE_MARKER (end); |
305 | 3218 |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
3219 if (XINT (start) > XINT (end)) |
305 | 3220 { |
10383
a7fe0fb11314
(Fnarrow_to_region): Swap using temp Lisp_Object, not int.
Karl Heuer <kwzh@gnu.org>
parents:
10382
diff
changeset
|
3221 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
|
3222 tem = start; start = end; end = tem; |
305 | 3223 } |
3224 | |
14071
59906ecd9b92
(Fchar_to_string, Fstring_to_char, Fgoto_char, Fencode_time, Finsert_char,
Erik Naggum <erik@naggum.no>
parents:
13878
diff
changeset
|
3225 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
|
3226 args_out_of_range (start, end); |
305 | 3227 |
19207
be370e94fb42
(Fwiden, Fnarrow_to_region, save_restriction_restore):
Richard M. Stallman <rms@gnu.org>
parents:
19032
diff
changeset
|
3228 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
|
3229 current_buffer->clip_changed = 1; |
be370e94fb42
(Fwiden, Fnarrow_to_region, save_restriction_restore):
Richard M. Stallman <rms@gnu.org>
parents:
19032
diff
changeset
|
3230 |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
3231 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
|
3232 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
|
3233 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
|
3234 SET_PT (XFASTINT (start)); |
16039
855c8d8ba0f0
Change all references from point to PT.
Karl Heuer <kwzh@gnu.org>
parents:
15910
diff
changeset
|
3235 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
|
3236 SET_PT (XFASTINT (end)); |
330 | 3237 /* Changing the buffer bounds invalidates any recorded current column. */ |
3238 invalidate_current_column (); | |
305 | 3239 return Qnil; |
3240 } | |
3241 | |
3242 Lisp_Object | |
3243 save_restriction_save () | |
3244 { | |
30931
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3245 if (BEGV == BEG && ZV == Z) |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3246 /* 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
|
3247 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
|
3248 recognizes as meaning `no restriction'. */ |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3249 return Fcurrent_buffer (); |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3250 else |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3251 /* 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
|
3252 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
|
3253 { |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3254 Lisp_Object beg, end; |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3255 |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3256 beg = buildmark (BEGV, BEGV_BYTE); |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3257 end = buildmark (ZV, ZV_BYTE); |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3258 |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3259 /* 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
|
3260 XMARKER(end)->insertion_type = 1; |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3261 |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3262 return Fcons (beg, end); |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3263 } |
305 | 3264 } |
3265 | |
3266 Lisp_Object | |
3267 save_restriction_restore (data) | |
3268 Lisp_Object data; | |
3269 { | |
30931
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3270 if (CONSP (data)) |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3271 /* A pair of marks bounding a saved restriction. */ |
305 | 3272 { |
30931
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3273 struct Lisp_Marker *beg = XMARKER (XCAR (data)); |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3274 struct Lisp_Marker *end = XMARKER (XCDR (data)); |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3275 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
|
3276 |
46921
40c8bb63c063
(save_restriction_restore): Defend from unchained marker.
Richard M. Stallman <rms@gnu.org>
parents:
46639
diff
changeset
|
3277 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
|
3278 && (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
|
3279 /* 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
|
3280 the saved restriction. */ |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3281 { |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3282 int pt = BUF_PT (buf); |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3283 |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3284 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
|
3285 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
|
3286 |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3287 if (pt < beg->charpos || pt > end->charpos) |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3288 /* 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
|
3289 SET_BUF_PT_BOTH (buf, |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3290 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
|
3291 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
|
3292 end->bytepos)); |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49472
diff
changeset
|
3293 |
30931
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3294 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
|
3295 } |
305 | 3296 } |
30931
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3297 else |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3298 /* 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
|
3299 { |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3300 struct buffer *buf = XBUFFER (data); |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3301 |
46921
40c8bb63c063
(save_restriction_restore): Defend from unchained marker.
Richard M. Stallman <rms@gnu.org>
parents:
46639
diff
changeset
|
3302 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
|
3303 && (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
|
3304 /* 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
|
3305 { |
46921
40c8bb63c063
(save_restriction_restore): Defend from unchained marker.
Richard M. Stallman <rms@gnu.org>
parents:
46639
diff
changeset
|
3306 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
|
3307 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
|
3308 |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3309 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
|
3310 } |
35428eaf59e3
(save_restriction_save): Rewrite to use markers.
Miles Bader <miles@gnu.org>
parents:
30677
diff
changeset
|
3311 } |
305 | 3312 |
3313 return Qnil; | |
3314 } | |
3315 | |
3316 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
|
3317 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
|
3318 The buffer's restrictions make parts of the beginning and end invisible. |
75387
41b2aae64f85
(Finsert_char): Doc fix.
Juanma Barranquero <lekktu@gmail.com>
parents:
75217
diff
changeset
|
3319 \(They are set up with `narrow-to-region' and eliminated with `widen'.) |
39966
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3320 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
|
3321 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
|
3322 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
|
3323 The old restrictions settings are restored |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3324 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
|
3325 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3326 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
|
3327 |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3328 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
|
3329 use `save-excursion' outermost: |
40140
9bf80d5fff41
(Fsave_excursion, Fsave_current_buffer)
Miles Bader <miles@gnu.org>
parents:
40131
diff
changeset
|
3330 (save-excursion (save-restriction ...)) |
9bf80d5fff41
(Fsave_excursion, Fsave_current_buffer)
Miles Bader <miles@gnu.org>
parents:
40131
diff
changeset
|
3331 |
9bf80d5fff41
(Fsave_excursion, Fsave_current_buffer)
Miles Bader <miles@gnu.org>
parents:
40131
diff
changeset
|
3332 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
|
3333 (body) |
305 | 3334 Lisp_Object body; |
3335 { | |
3336 register Lisp_Object val; | |
46293
1fb8f75062c6
Use macro SPECPDL_INDEX.
Juanma Barranquero <lekktu@gmail.com>
parents:
45398
diff
changeset
|
3337 int count = SPECPDL_INDEX (); |
305 | 3338 |
3339 record_unwind_protect (save_restriction_restore, save_restriction_save ()); | |
3340 val = Fprogn (body); | |
3341 return unbind_to (count, val); | |
3342 } | |
3343 | |
38059
0b34b024286d
(Fmessage_box): If the frame is not under a window
Eli Zaretskii <eliz@gnu.org>
parents:
37916
diff
changeset
|
3344 /* 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
|
3345 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
|
3346 |
d02095ea13a5
(Fmessage): Copy the text to be displayed into a malloc'd buffer.
Karl Heuer <kwzh@gnu.org>
parents:
5882
diff
changeset
|
3347 /* 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
|
3348 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
|
3349 |
305 | 3350 DEFUN ("message", Fmessage, Smessage, 1, MANY, 0, |
73950
5229e2ae0b0e
(Fmessage): Doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents:
72801
diff
changeset
|
3351 doc: /* Display a message at the bottom of the screen. |
57736 | 3352 The message also goes into the `*Messages*' buffer. |
3353 \(In keyboard macros, that's all it does.) | |
73950
5229e2ae0b0e
(Fmessage): Doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents:
72801
diff
changeset
|
3354 Return the message. |
57736 | 3355 |
39966
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3356 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
|
3357 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
|
3358 |
72801
861a71881b6a
(Fmessage): Recommend using (message "%s" ...).
Kim F. Storm <storm@cua.dk>
parents:
72751
diff
changeset
|
3359 Note: Use (message "%s" VALUE) to print the value of expressions and |
861a71881b6a
(Fmessage): Recommend using (message "%s" ...).
Kim F. Storm <storm@cua.dk>
parents:
72751
diff
changeset
|
3360 variables to avoid accidentally interpreting `%' as format specifiers. |
861a71881b6a
(Fmessage): Recommend using (message "%s" ...).
Kim F. Storm <storm@cua.dk>
parents:
72751
diff
changeset
|
3361 |
65455
51d3a3f03a8a
(Ftranslate_region_internal): Reload `tt' after
Kim F. Storm <storm@cua.dk>
parents:
65324
diff
changeset
|
3362 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
|
3363 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
|
3364 also `current-message'. |
40131
de086e415fa2
(Finsert, Finsert_and_inherit, Finsert_before_markers, Fmessage)
Miles Bader <miles@gnu.org>
parents:
40046
diff
changeset
|
3365 |
65739
83ce839858fb
(Fmessage, Fmessage_box, Fmessage_or_box):
Juri Linkov <juri@jurta.org>
parents:
65659
diff
changeset
|
3366 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
|
3367 (nargs, args) |
305 | 3368 int nargs; |
3369 Lisp_Object *args; | |
3370 { | |
46639
8587dd21917c
(Fmessage): Treat "" like nil.
Richard M. Stallman <rms@gnu.org>
parents:
46464
diff
changeset
|
3371 if (NILP (args[0]) |
8587dd21917c
(Fmessage): Treat "" like nil.
Richard M. Stallman <rms@gnu.org>
parents:
46464
diff
changeset
|
3372 || (STRINGP (args[0]) |
8587dd21917c
(Fmessage): Treat "" like nil.
Richard M. Stallman <rms@gnu.org>
parents:
46464
diff
changeset
|
3373 && 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
|
3374 { |
e21c1f3e37cb
* editfns.c (Fmessage): Don't forget to return a value when
Jim Blandy <jimb@redhat.com>
parents:
1854
diff
changeset
|
3375 message (0); |
59662
c140948a6044
(Fmessage): If arg is "", return "" (as before).
Richard M. Stallman <rms@gnu.org>
parents:
59658
diff
changeset
|
3376 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
|
3377 } |
1426
67fd35416ba3
* * editfns.c (Fmessage): With no arguments, clear any active
Jim Blandy <jimb@redhat.com>
parents:
1285
diff
changeset
|
3378 else |
67fd35416ba3
* * editfns.c (Fmessage): With no arguments, clear any active
Jim Blandy <jimb@redhat.com>
parents:
1285
diff
changeset
|
3379 { |
67fd35416ba3
* * editfns.c (Fmessage): With no arguments, clear any active
Jim Blandy <jimb@redhat.com>
parents:
1285
diff
changeset
|
3380 register Lisp_Object val; |
48115
72f8d789f551
(Fmessage): Revert last change to properly handle %% format.
Andreas Schwab <schwab@suse.de>
parents:
48111
diff
changeset
|
3381 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
|
3382 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
|
3383 return val; |
67fd35416ba3
* * editfns.c (Fmessage): With no arguments, clear any active
Jim Blandy <jimb@redhat.com>
parents:
1285
diff
changeset
|
3384 } |
305 | 3385 } |
3386 | |
8975
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3387 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
|
3388 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
|
3389 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
|
3390 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
|
3391 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
|
3392 |
65455
51d3a3f03a8a
(Ftranslate_region_internal): Reload `tt' after
Kim F. Storm <storm@cua.dk>
parents:
65324
diff
changeset
|
3393 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
|
3394 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
|
3395 |
65739
83ce839858fb
(Fmessage, Fmessage_box, Fmessage_or_box):
Juri Linkov <juri@jurta.org>
parents:
65659
diff
changeset
|
3396 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
|
3397 (nargs, args) |
8975
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3398 int nargs; |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3399 Lisp_Object *args; |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3400 { |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3401 if (NILP (args[0])) |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3402 { |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3403 message (0); |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3404 return Qnil; |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3405 } |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3406 else |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3407 { |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3408 register Lisp_Object val; |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3409 val = Fformat (nargs, args); |
13878
2a71500dfb93
(Fmessage_box, Fmessage_or_box):
Richard M. Stallman <rms@gnu.org>
parents:
13767
diff
changeset
|
3410 #ifdef HAVE_MENUS |
38059
0b34b024286d
(Fmessage_box): If the frame is not under a window
Eli Zaretskii <eliz@gnu.org>
parents:
37916
diff
changeset
|
3411 /* 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
|
3412 not FRAME_WINDOW_P. */ |
0b34b024286d
(Fmessage_box): If the frame is not under a window
Eli Zaretskii <eliz@gnu.org>
parents:
37916
diff
changeset
|
3413 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
|
3414 || FRAME_MSDOS_P (XFRAME (selected_frame))) |
8975
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3415 { |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3416 Lisp_Object pane, menu, obj; |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3417 struct gcpro gcpro1; |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3418 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
|
3419 GCPRO1 (pane); |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3420 menu = Fcons (val, pane); |
62662
9733e98a93e4
(Fmessage_box): Use "Information" for frame title.
Nick Roberts <nickrob@snap.net.nz>
parents:
61700
diff
changeset
|
3421 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
|
3422 UNGCPRO; |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3423 return val; |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3424 } |
38059
0b34b024286d
(Fmessage_box): If the frame is not under a window
Eli Zaretskii <eliz@gnu.org>
parents:
37916
diff
changeset
|
3425 #endif /* HAVE_MENUS */ |
8975
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3426 /* 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
|
3427 if (! message_text) |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3428 { |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3429 message_text = (char *)xmalloc (80); |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3430 message_length = 80; |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3431 } |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
3432 if (SBYTES (val) > message_length) |
8975
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3433 { |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
3434 message_length = SBYTES (val); |
8975
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3435 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
|
3436 } |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
3437 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
|
3438 message2 (message_text, SBYTES (val), |
21358
e9f7d8708bae
(Fmessage_box): Pass the missing third argument
Richard M. Stallman <rms@gnu.org>
parents:
21257
diff
changeset
|
3439 STRING_MULTIBYTE (val)); |
8975
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3440 return val; |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3441 } |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3442 } |
13878
2a71500dfb93
(Fmessage_box, Fmessage_or_box):
Richard M. Stallman <rms@gnu.org>
parents:
13767
diff
changeset
|
3443 #ifdef HAVE_MENUS |
8975
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3444 extern Lisp_Object last_nonmenu_event; |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3445 #endif |
13878
2a71500dfb93
(Fmessage_box, Fmessage_or_box):
Richard M. Stallman <rms@gnu.org>
parents:
13767
diff
changeset
|
3446 |
8975
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3447 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
|
3448 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
|
3449 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
|
3450 `use-dialog-box' is non-nil. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3451 Otherwise, use the echo area. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3452 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
|
3453 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
|
3454 |
65455
51d3a3f03a8a
(Ftranslate_region_internal): Reload `tt' after
Kim F. Storm <storm@cua.dk>
parents:
65324
diff
changeset
|
3455 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
|
3456 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
|
3457 |
65739
83ce839858fb
(Fmessage, Fmessage_box, Fmessage_or_box):
Juri Linkov <juri@jurta.org>
parents:
65659
diff
changeset
|
3458 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
|
3459 (nargs, args) |
8975
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3460 int nargs; |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3461 Lisp_Object *args; |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3462 { |
13878
2a71500dfb93
(Fmessage_box, Fmessage_or_box):
Richard M. Stallman <rms@gnu.org>
parents:
13767
diff
changeset
|
3463 #ifdef HAVE_MENUS |
26699
ed4ab9d24450
(Fmessage_or_box): Use use_dialog_box.
Dave Love <fx@gnu.org>
parents:
26629
diff
changeset
|
3464 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
|
3465 && use_dialog_box) |
8981
6e1a5ff3d795
(Fmessage_or_box): Use Fmessage_box with new name.
Richard M. Stallman <rms@gnu.org>
parents:
8975
diff
changeset
|
3466 return Fmessage_box (nargs, args); |
8975
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3467 #endif |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3468 return Fmessage (nargs, args); |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3469 } |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
3470 |
18937
ddb91108a9d2
(Fcurrent_message): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18756
diff
changeset
|
3471 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
|
3472 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
|
3473 () |
18937
ddb91108a9d2
(Fcurrent_message): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18756
diff
changeset
|
3474 { |
25346
15ec35852b48
Remove conditional compilation on NO_PROMPT_IN_BUFFER.
Gerd Moellmann <gerd@gnu.org>
parents:
25018
diff
changeset
|
3475 return current_message (); |
18937
ddb91108a9d2
(Fcurrent_message): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18756
diff
changeset
|
3476 } |
ddb91108a9d2
(Fcurrent_message): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18756
diff
changeset
|
3477 |
25815 | 3478 |
41062
07a4ff5f0909
(Fpropertize): Allow call with 1 arg.
Richard M. Stallman <rms@gnu.org>
parents:
40981
diff
changeset
|
3479 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
|
3480 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
|
3481 First argument is the string to copy. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3482 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
|
3483 properties to add to the result. |
de086e415fa2
(Finsert, Finsert_and_inherit, Finsert_before_markers, Fmessage)
Miles Bader <miles@gnu.org>
parents:
40046
diff
changeset
|
3484 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
|
3485 (nargs, args) |
25815 | 3486 int nargs; |
3487 Lisp_Object *args; | |
3488 { | |
3489 Lisp_Object properties, string; | |
3490 struct gcpro gcpro1, gcpro2; | |
3491 int i; | |
3492 | |
3493 /* Number of args must be odd. */ | |
41062
07a4ff5f0909
(Fpropertize): Allow call with 1 arg.
Richard M. Stallman <rms@gnu.org>
parents:
40981
diff
changeset
|
3494 if ((nargs & 1) == 0 || nargs < 1) |
25815 | 3495 error ("Wrong number of arguments"); |
3496 | |
3497 properties = string = Qnil; | |
3498 GCPRO2 (properties, string); | |
30480 | 3499 |
25815 | 3500 /* 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
|
3501 CHECK_STRING (args[0]); |
25815 | 3502 string = Fcopy_sequence (args[0]); |
3503 | |
3504 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
|
3505 properties = Fcons (args[i], Fcons (args[i + 1], properties)); |
25815 | 3506 |
3507 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
|
3508 make_number (SCHARS (string)), |
25815 | 3509 properties, string); |
3510 RETURN_UNGCPRO (string); | |
3511 } | |
3512 | |
3513 | |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3514 /* 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
|
3515 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
|
3516 |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3517 #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
|
3518 (((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
|
3519 ? 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
|
3520 : SBYTES (STRING)) |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3521 |
305 | 3522 DEFUN ("format", Fformat, Sformat, 1, MANY, 0, |
65739
83ce839858fb
(Fmessage, Fmessage_box, Fmessage_or_box):
Juri Linkov <juri@jurta.org>
parents:
65659
diff
changeset
|
3523 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
|
3524 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
|
3525 The other arguments are substituted into it to make the result, a string. |
92236 | 3526 |
3527 The format control string may contain %-sequences meaning to substitute | |
3528 the next available argument: | |
3529 | |
39966
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3530 %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
|
3531 %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
|
3532 %X is like %x, but uses upper case. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3533 %e means print a number in exponential notation. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3534 %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
|
3535 %g means print a number in exponential notation |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3536 or decimal-point notation, whichever uses fewer characters. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
3537 %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
|
3538 %S means print any object as an s-expression (using `prin1'). |
92236 | 3539 |
3540 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
|
3541 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
|
3542 |
92236 | 3543 A %-sequence may contain optional flag, width, and precision |
3544 specifiers, as follows: | |
3545 | |
3546 %<flags><width><precision>character | |
3547 | |
3548 where flags is [+ #-0]+, width is [0-9]+, and precision is .[0-9]+ | |
3549 | |
3550 The + flag character inserts a + before any positive number, while a | |
3551 space inserts a space before any positive number; these flags only | |
3552 affect %d, %e, %f, and %g sequences, and the + flag takes precedence. | |
3553 The # flag means to use an alternate display form for %o, %x, %X, %e, | |
3554 %f, and %g sequences. The - and 0 flags affect the width specifier, | |
3555 as described below. | |
3556 | |
3557 The width specifier supplies a lower limit for the length of the | |
3558 printed representation. The padding, if any, normally goes on the | |
3559 left, but it goes on the right if the - flag is present. The padding | |
3560 character is normally a space, but it is 0 if the 0 flag is present. | |
3561 The - flag takes precedence over the 0 flag. | |
3562 | |
3563 For %e, %f, and %g sequences, the number after the "." in the | |
3564 precision specifier says how many decimal places to show; if zero, the | |
3565 decimal point itself is omitted. For %s and %S, the precision | |
3566 specifier truncates the string to the given width. | |
53687
4f06a8a0e7a6
For `format', make source and documentation match.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53541
diff
changeset
|
3567 |
40131
de086e415fa2
(Finsert, Finsert_and_inherit, Finsert_before_markers, Fmessage)
Miles Bader <miles@gnu.org>
parents:
40046
diff
changeset
|
3568 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
|
3569 (nargs, args) |
305 | 3570 int nargs; |
3571 register Lisp_Object *args; | |
3572 { | |
3573 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
|
3574 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
|
3575 char *buf, *p; |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3576 register unsigned char *format, *end, *format_start; |
25782
8f59abd3a02b
(init_editfns): Remove unused variables.
Gerd Moellmann <gerd@gnu.org>
parents:
25662
diff
changeset
|
3577 int nchars; |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3578 /* 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
|
3579 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
|
3580 int multibyte = 0; |
22698
ea6ef56295b4
(Fformat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents:
22669
diff
changeset
|
3581 /* 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
|
3582 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
|
3583 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
|
3584 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
|
3585 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
|
3586 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
|
3587 /* 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
|
3588 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
|
3589 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
|
3590 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
|
3591 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
|
3592 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
|
3593 int longest_format; |
20804
14fa73136e64
(CONVERTED_BYTE_SIZE): Fix the logic.
Kenichi Handa <handa@m17n.org>
parents:
20706
diff
changeset
|
3594 Lisp_Object val; |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3595 int arg_intervals = 0; |
56194
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
3596 USE_SAFE_ALLOCA; |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3597 |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3598 /* 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
|
3599 string was not copied into the output. |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3600 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
|
3601 char *discarded = 0; |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3602 |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3603 /* Each element records, for one argument, |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3604 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
|
3605 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
|
3606 info[0] is unused. Unused elements have -1 for start. */ |
25018 | 3607 struct info |
3608 { | |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3609 int start, end, intervals; |
25018 | 3610 } *info = 0; |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3611 |
305 | 3612 /* It should not be necessary to GCPRO ARGS, because |
3613 the caller in the interpreter should take care of that. */ | |
3614 | |
20826
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3615 /* 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
|
3616 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
|
3617 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
|
3618 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
|
3619 for (n = 0; n < nargs; n++) |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3620 { |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3621 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
|
3622 multibyte = 1; |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3623 /* 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
|
3624 precision[n] = -1; |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3625 } |
56560
1a84eb100ef3
(Fformat): Allocated extra (dummy) element in info.
Kim F. Storm <storm@cua.dk>
parents:
56386
diff
changeset
|
3626 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
|
3627 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40287
diff
changeset
|
3628 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
|
3629 /* 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
|
3630 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
|
3631 |
50746
2a57a6e6b390
(Fformat): Set abort_on_gc during first scan of format.
Richard M. Stallman <rms@gnu.org>
parents:
50555
diff
changeset
|
3632 /* 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
|
3633 abort_on_gc++; |
2a57a6e6b390
(Fformat): Set abort_on_gc during first scan of format.
Richard M. Stallman <rms@gnu.org>
parents:
50555
diff
changeset
|
3634 |
20826
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3635 /* 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
|
3636 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
|
3637 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
|
3638 retry: |
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3639 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
3640 format = SDATA (args[0]); |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3641 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
|
3642 end = format + SBYTES (args[0]); |
20826
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3643 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
|
3644 |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3645 /* 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
|
3646 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
|
3647 |
54846
e8865bfda38b
(Fformat): Fix allocation size of precision array.
Kim F. Storm <storm@cua.dk>
parents:
54655
diff
changeset
|
3648 /* Allocate the info and discarded tables. */ |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3649 { |
56560
1a84eb100ef3
(Fformat): Allocated extra (dummy) element in info.
Kim F. Storm <storm@cua.dk>
parents:
56386
diff
changeset
|
3650 int nbytes = (nargs+1) * sizeof *info; |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3651 int i; |
57725
c0675c413aa3
(Fformat): Allocate discarded table with SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
57644
diff
changeset
|
3652 if (!info) |
c0675c413aa3
(Fformat): Allocate discarded table with SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
57644
diff
changeset
|
3653 info = (struct info *) alloca (nbytes); |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3654 bzero (info, nbytes); |
56560
1a84eb100ef3
(Fformat): Allocated extra (dummy) element in info.
Kim F. Storm <storm@cua.dk>
parents:
56386
diff
changeset
|
3655 for (i = 0; i <= nargs; i++) |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3656 info[i].start = -1; |
57725
c0675c413aa3
(Fformat): Allocate discarded table with SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
57644
diff
changeset
|
3657 if (!discarded) |
c0675c413aa3
(Fformat): Allocate discarded table with SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
57644
diff
changeset
|
3658 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
|
3659 bzero (discarded, SBYTES (args[0])); |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3660 } |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3661 |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3662 /* Add to TOTAL enough space to hold the converted arguments. */ |
305 | 3663 |
3664 n = 0; | |
3665 while (format != end) | |
3666 if (*format++ == '%') | |
3667 { | |
34566
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3668 int thissize = 0; |
42484
717eee813b2c
(Fformat): Update thissize from field_width
Richard M. Stallman <rms@gnu.org>
parents:
42116
diff
changeset
|
3669 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
|
3670 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
|
3671 int field_width = 0; |
34566
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3672 |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3673 /* General format specifications look like |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3674 |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3675 '%' [flags] [field-width] [precision] format |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3676 |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3677 where |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3678 |
75949
d420b7899f20
(Fformat): Add support for '+' flag.
Andreas Schwab <schwab@suse.de>
parents:
75387
diff
changeset
|
3679 flags ::= [-+ #0]+ |
34566
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3680 field-width ::= [0-9]+ |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3681 precision ::= '.' [0-9]* |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3682 |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3683 If a field-width is specified, it specifies to which width |
78501 | 3684 the output should be padded with blanks, if the output |
34566
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3685 string is shorter than field-width. |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3686 |
48764
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3687 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
|
3688 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
|
3689 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
|
3690 |
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
|
3691 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
|
3692 && (*format == '-' || *format == '0' || *format == '#' |
75949
d420b7899f20
(Fformat): Add support for '+' flag.
Andreas Schwab <schwab@suse.de>
parents:
75387
diff
changeset
|
3693 || * format == ' ' || *format == '+')) |
34566
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3694 ++format; |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3695 |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3696 if (*format >= '0' && *format <= '9') |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3697 { |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3698 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
|
3699 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
|
3700 } |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3701 |
48764
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3702 /* 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
|
3703 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
|
3704 if (*format == '.') |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3705 { |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3706 ++format; |
48764
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3707 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
|
3708 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
|
3709 } |
305 | 3710 |
79424 | 3711 /* Extra +1 for 'l' that we may need to insert into the |
3712 format. */ | |
3713 if (format - this_format_start + 2 > longest_format) | |
3714 longest_format = format - this_format_start + 2; | |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3715 |
23197
0d3baa5514b7
(Fformat): Detect incomplete format spec at string's end.
Karl Heuer <kwzh@gnu.org>
parents:
23166
diff
changeset
|
3716 if (format == end) |
0d3baa5514b7
(Fformat): Detect incomplete format spec at string's end.
Karl Heuer <kwzh@gnu.org>
parents:
23166
diff
changeset
|
3717 error ("Format string ends in middle of format specifier"); |
305 | 3718 if (*format == '%') |
3719 format++; | |
3720 else if (++n >= nargs) | |
12831
3917c5d131d3
(Fformat): Limit minlen to avoid stack overflow.
Richard M. Stallman <rms@gnu.org>
parents:
12623
diff
changeset
|
3721 error ("Not enough arguments for format string"); |
305 | 3722 else if (*format == 'S') |
3723 { | |
3724 /* For `S', prin1 the argument and then treat like a string. */ | |
3725 register Lisp_Object tem; | |
3726 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
|
3727 if (STRING_MULTIBYTE (tem) && ! multibyte) |
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3728 { |
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3729 multibyte = 1; |
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3730 goto retry; |
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3731 } |
305 | 3732 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
|
3733 /* 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
|
3734 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
|
3735 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
|
3736 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
|
3737 *format = 's'; |
305 | 3738 goto string; |
3739 } | |
9163
41fe5f636879
(lisp_time_argument, Finsert, Finsert_and_inherit, Finsert_before_markers,
Karl Heuer <kwzh@gnu.org>
parents:
9154
diff
changeset
|
3740 else if (SYMBOLP (args[n])) |
305 | 3741 { |
46447
8e01c92219ab
(Fstring_to_char): Don't use XSTRING/XSETSTRING to copy a lisp value.
Ken Raeburn <raeburn@raeburn.org>
parents:
46443
diff
changeset
|
3742 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
|
3743 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
|
3744 { |
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
3745 multibyte = 1; |
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
3746 goto retry; |
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
3747 } |
305 | 3748 goto string; |
3749 } | |
9163
41fe5f636879
(lisp_time_argument, Finsert, Finsert_and_inherit, Finsert_before_markers,
Karl Heuer <kwzh@gnu.org>
parents:
9154
diff
changeset
|
3750 else if (STRINGP (args[n])) |
305 | 3751 { |
3752 string: | |
6528
d0f6a386b7cb
(Fformat): Validate number and type of arguments.
Karl Heuer <kwzh@gnu.org>
parents:
6206
diff
changeset
|
3753 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
|
3754 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
|
3755 /* 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
|
3756 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
|
3757 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
|
3758 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
|
3759 actual_width = lisp_string_width (args[n], -1, NULL, NULL); |
305 | 3760 } |
3761 /* 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
|
3762 else if (INTEGERP (args[n]) && *format != 's') |
305 | 3763 { |
3591
507f64624555
Apply typo patches from Paul Eggert.
Jim Blandy <jimb@redhat.com>
parents:
3522
diff
changeset
|
3764 /* The following loop assumes the Lisp type indicates |
305 | 3765 the proper way to pass the argument. |
3766 So make sure we have a flonum if the argument should | |
3767 be a double. */ | |
3768 if (*format == 'e' || *format == 'f' || *format == 'g') | |
79428
576665ace786
*** empty log message ***
Andreas Schwab <schwab@suse.de>
parents:
79427
diff
changeset
|
3769 args[n] = Ffloat (args[n]); |
23326
df3f641c9ca1
(Fformat): Check format control characters.
Kenichi Handa <handa@m17n.org>
parents:
23292
diff
changeset
|
3770 else |
df3f641c9ca1
(Fformat): Check format control characters.
Kenichi Handa <handa@m17n.org>
parents:
23292
diff
changeset
|
3771 if (*format != 'd' && *format != 'o' && *format != 'x' |
24505 | 3772 && *format != 'i' && *format != 'X' && *format != 'c') |
23326
df3f641c9ca1
(Fformat): Check format control characters.
Kenichi Handa <handa@m17n.org>
parents:
23292
diff
changeset
|
3773 error ("Invalid format operation %%%c", *format); |
df3f641c9ca1
(Fformat): Check format control characters.
Kenichi Handa <handa@m17n.org>
parents:
23292
diff
changeset
|
3774 |
79427
cc15c80eebe7
Always take precision into account.
Andreas Schwab <schwab@suse.de>
parents:
79425
diff
changeset
|
3775 thissize = 30 + (precision[n] > 0 ? precision[n] : 0); |
49285
7ec1335b6d36
(Fformat): Convert an unibyte char argument that is
Kenichi Handa <handa@m17n.org>
parents:
48908
diff
changeset
|
3776 if (*format == 'c') |
21064
90bdbe2754c8
(Fformat): Format multibyte characters by "%c"
Kenichi Handa <handa@m17n.org>
parents:
21052
diff
changeset
|
3777 { |
89483 | 3778 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
|
3779 /* 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
|
3780 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
|
3781 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
|
3782 don't change it. */ |
49285
7ec1335b6d36
(Fformat): Convert an unibyte char argument that is
Kenichi Handa <handa@m17n.org>
parents:
48908
diff
changeset
|
3783 || XINT (args[n]) == 0) |
21064
90bdbe2754c8
(Fformat): Format multibyte characters by "%c"
Kenichi Handa <handa@m17n.org>
parents:
21052
diff
changeset
|
3784 { |
49285
7ec1335b6d36
(Fformat): Convert an unibyte char argument that is
Kenichi Handa <handa@m17n.org>
parents:
48908
diff
changeset
|
3785 if (! multibyte) |
7ec1335b6d36
(Fformat): Convert an unibyte char argument that is
Kenichi Handa <handa@m17n.org>
parents:
48908
diff
changeset
|
3786 { |
7ec1335b6d36
(Fformat): Convert an unibyte char argument that is
Kenichi Handa <handa@m17n.org>
parents:
48908
diff
changeset
|
3787 multibyte = 1; |
7ec1335b6d36
(Fformat): Convert an unibyte char argument that is
Kenichi Handa <handa@m17n.org>
parents:
48908
diff
changeset
|
3788 goto retry; |
7ec1335b6d36
(Fformat): Convert an unibyte char argument that is
Kenichi Handa <handa@m17n.org>
parents:
48908
diff
changeset
|
3789 } |
7ec1335b6d36
(Fformat): Convert an unibyte char argument that is
Kenichi Handa <handa@m17n.org>
parents:
48908
diff
changeset
|
3790 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
|
3791 thissize = SBYTES (args[n]); |
21064
90bdbe2754c8
(Fformat): Format multibyte characters by "%c"
Kenichi Handa <handa@m17n.org>
parents:
21052
diff
changeset
|
3792 } |
49285
7ec1335b6d36
(Fformat): Convert an unibyte char argument that is
Kenichi Handa <handa@m17n.org>
parents:
48908
diff
changeset
|
3793 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
|
3794 { |
7ec1335b6d36
(Fformat): Convert an unibyte char argument that is
Kenichi Handa <handa@m17n.org>
parents:
48908
diff
changeset
|
3795 args[n] |
7ec1335b6d36
(Fformat): Convert an unibyte char argument that is
Kenichi Handa <handa@m17n.org>
parents:
48908
diff
changeset
|
3796 = 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
|
3797 thissize = SBYTES (args[n]); |
7ec1335b6d36
(Fformat): Convert an unibyte char argument that is
Kenichi Handa <handa@m17n.org>
parents:
48908
diff
changeset
|
3798 } |
21064
90bdbe2754c8
(Fformat): Format multibyte characters by "%c"
Kenichi Handa <handa@m17n.org>
parents:
21052
diff
changeset
|
3799 } |
305 | 3800 } |
9163
41fe5f636879
(lisp_time_argument, Finsert, Finsert_and_inherit, Finsert_before_markers,
Karl Heuer <kwzh@gnu.org>
parents:
9154
diff
changeset
|
3801 else if (FLOATP (args[n]) && *format != 's') |
305 | 3802 { |
3803 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
|
3804 { |
7ac7ca5ac550
(Fformat): Detect invalid format letters for floats.
Richard M. Stallman <rms@gnu.org>
parents:
47763
diff
changeset
|
3805 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
|
3806 && *format != 'i' && *format != 'X' && *format != 'c') |
7ac7ca5ac550
(Fformat): Detect invalid format letters for floats.
Richard M. Stallman <rms@gnu.org>
parents:
47763
diff
changeset
|
3807 error ("Invalid format operation %%%c", *format); |
75181
ea255892b6fd
(Fformat): Allow integer-format to work with floats of size
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
75096
diff
changeset
|
3808 /* This fails unnecessarily if args[n] is bigger than |
ea255892b6fd
(Fformat): Allow integer-format to work with floats of size
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
75096
diff
changeset
|
3809 most-positive-fixnum but smaller than MAXINT. |
ea255892b6fd
(Fformat): Allow integer-format to work with floats of size
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
75096
diff
changeset
|
3810 These cases are important because we sometimes use floats |
ea255892b6fd
(Fformat): Allow integer-format to work with floats of size
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
75096
diff
changeset
|
3811 to represent such integer values (typically such values |
ea255892b6fd
(Fformat): Allow integer-format to work with floats of size
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
75096
diff
changeset
|
3812 come from UIDs or PIDs). */ |
ea255892b6fd
(Fformat): Allow integer-format to work with floats of size
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
75096
diff
changeset
|
3813 /* args[n] = Ftruncate (args[n], Qnil); */ |
48020
7ac7ca5ac550
(Fformat): Detect invalid format letters for floats.
Richard M. Stallman <rms@gnu.org>
parents:
47763
diff
changeset
|
3814 } |
34566
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3815 |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
3816 /* 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
|
3817 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
|
3818 prints. */ |
48782
b02bdb795a5c
(Fformat): Use alloca, not _alloca.
Juanma Barranquero <lekktu@gmail.com>
parents:
48781
diff
changeset
|
3819 /* Filter out flag value of -1. */ |
48908 | 3820 thissize = (MAX_10_EXP + 100 |
3821 + (precision[n] > 0 ? precision[n] : 0)); | |
305 | 3822 } |
3823 else | |
3824 { | |
3825 /* Anything but a string, convert to a string using princ. */ | |
3826 register Lisp_Object tem; | |
3827 tem = Fprin1_to_string (args[n], Qt); | |
53541
41ceb9298a4e
(Fformat): Fix '&' to '&&'.
Kenichi Handa <handa@m17n.org>
parents:
52451
diff
changeset
|
3828 if (STRING_MULTIBYTE (tem) && ! multibyte) |
20826
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3829 { |
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3830 multibyte = 1; |
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3831 goto retry; |
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3832 } |
305 | 3833 args[n] = tem; |
3834 goto string; | |
3835 } | |
30480 | 3836 |
42484
717eee813b2c
(Fformat): Update thissize from field_width
Richard M. Stallman <rms@gnu.org>
parents:
42116
diff
changeset
|
3837 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
|
3838 total += thissize + 4; |
305 | 3839 } |
3840 | |
50746
2a57a6e6b390
(Fformat): Set abort_on_gc during first scan of format.
Richard M. Stallman <rms@gnu.org>
parents:
50555
diff
changeset
|
3841 abort_on_gc--; |
2a57a6e6b390
(Fformat): Set abort_on_gc during first scan of format.
Richard M. Stallman <rms@gnu.org>
parents:
50555
diff
changeset
|
3842 |
20826
cbaa9e50b013
(Fformat): If MULTIBYTE is changed to 1
Richard M. Stallman <rms@gnu.org>
parents:
20804
diff
changeset
|
3843 /* 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
|
3844 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
|
3845 |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3846 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
|
3847 |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3848 /* 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
|
3849 Note that TOTAL is an overestimate. */ |
56194
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
3850 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
|
3851 |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3852 p = buf; |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3853 nchars = 0; |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3854 n = 0; |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3855 |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3856 /* 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
|
3857 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
|
3858 format_start = format; |
2a57a6e6b390
(Fformat): Set abort_on_gc during first scan of format.
Richard M. Stallman <rms@gnu.org>
parents:
50555
diff
changeset
|
3859 end = format + SBYTES (args[0]); |
22698
ea6ef56295b4
(Fformat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents:
22669
diff
changeset
|
3860 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
|
3861 while (format != end) |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3862 { |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3863 if (*format == '%') |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3864 { |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3865 int minlen; |
21225
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3866 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
|
3867 unsigned char *this_format_start = format; |
305 | 3868 |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3869 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
|
3870 format++; |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3871 |
75949
d420b7899f20
(Fformat): Add support for '+' flag.
Andreas Schwab <schwab@suse.de>
parents:
75387
diff
changeset
|
3872 while (index("-+0# ", *format)) |
53687
4f06a8a0e7a6
For `format', make source and documentation match.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53541
diff
changeset
|
3873 { |
4f06a8a0e7a6
For `format', make source and documentation match.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53541
diff
changeset
|
3874 if (*format == '-') |
4f06a8a0e7a6
For `format', make source and documentation match.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53541
diff
changeset
|
3875 { |
4f06a8a0e7a6
For `format', make source and documentation match.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53541
diff
changeset
|
3876 negative = 1; |
4f06a8a0e7a6
For `format', make source and documentation match.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53541
diff
changeset
|
3877 } |
4f06a8a0e7a6
For `format', make source and documentation match.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53541
diff
changeset
|
3878 discarded[format - format_start] = 1; |
4f06a8a0e7a6
For `format', make source and documentation match.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53541
diff
changeset
|
3879 ++format; |
4f06a8a0e7a6
For `format', make source and documentation match.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53541
diff
changeset
|
3880 } |
4f06a8a0e7a6
For `format', make source and documentation match.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53541
diff
changeset
|
3881 |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3882 minlen = atoi (format); |
53687
4f06a8a0e7a6
For `format', make source and documentation match.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53541
diff
changeset
|
3883 |
4f06a8a0e7a6
For `format', make source and documentation match.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53541
diff
changeset
|
3884 while ((*format >= '0' && *format <= '9') || *format == '.') |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3885 { |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3886 discarded[format - format_start] = 1; |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3887 format++; |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3888 } |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3889 |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3890 if (*format++ == '%') |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3891 { |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3892 *p++ = '%'; |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3893 nchars++; |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3894 continue; |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3895 } |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3896 |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3897 ++n; |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3898 |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3899 discarded[format - format_start - 1] = 1; |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3900 info[n].start = nchars; |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3901 |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3902 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
|
3903 { |
48764
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3904 /* 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
|
3905 |
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3906 int width, padding; |
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3907 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
|
3908 int nchars_string; |
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3909 |
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3910 /* 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
|
3911 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
|
3912 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
|
3913 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
|
3914 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
|
3915 |
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3916 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
|
3917 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
|
3918 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
|
3919 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
|
3920 else |
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3921 { /* 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
|
3922 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
|
3923 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
|
3924 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
|
3925 } |
21225
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3926 |
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3927 /* 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
|
3928 padding = minlen - width; |
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3929 if (! negative) |
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3930 while (padding-- > 0) |
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3931 { |
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3932 *p++ = ' '; |
35461
f0f0e9179ed6
(Fformat): Don't extend text properties from arguments
Gerd Moellmann <gerd@gnu.org>
parents:
35440
diff
changeset
|
3933 ++nchars; |
21225
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3934 } |
305 | 3935 |
66500
8392b2926dd8
(Fformat): Don't include string padding
Richard M. Stallman <rms@gnu.org>
parents:
66379
diff
changeset
|
3936 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
|
3937 nchars += nchars_string; |
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3938 end = nchars; |
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3939 |
22698
ea6ef56295b4
(Fformat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents:
22669
diff
changeset
|
3940 if (p > buf |
ea6ef56295b4
(Fformat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents:
22669
diff
changeset
|
3941 && multibyte |
22712
6f129ed55108
(Fformat): Replace explicit numeric constants with proper macros.
Kenichi Handa <handa@m17n.org>
parents:
22698
diff
changeset
|
3942 && !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
|
3943 && 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
|
3944 && !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
|
3945 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
|
3946 |
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3947 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
|
3948 nbytes, |
4a69081f2ff4
(Fformat): Handle precision in string conversion specifiers like libc
Kai Großjohann <kgrossjo@eu.uu.net>
parents:
48134
diff
changeset
|
3949 STRING_MULTIBYTE (args[n]), multibyte); |
305 | 3950 |
66500
8392b2926dd8
(Fformat): Don't include string padding
Richard M. Stallman <rms@gnu.org>
parents:
66379
diff
changeset
|
3951 info[n].end = nchars; |
8392b2926dd8
(Fformat): Don't include string padding
Richard M. Stallman <rms@gnu.org>
parents:
66379
diff
changeset
|
3952 |
21225
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3953 if (negative) |
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3954 while (padding-- > 0) |
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3955 { |
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3956 *p++ = ' '; |
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3957 nchars++; |
47e189a470d2
(Fformat): Handle padding before or after, for %s etc.
Richard M. Stallman <rms@gnu.org>
parents:
21202
diff
changeset
|
3958 } |
25018 | 3959 |
3960 /* If this argument has text properties, record where | |
3961 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
|
3962 if (STRING_INTERVALS (args[n])) |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
3963 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
|
3964 } |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3965 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
|
3966 { |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3967 int this_nchars; |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3968 |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
3969 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
|
3970 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
|
3971 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
|
3972 |
79422
45618be84af9
(Fformat): Correctly format EMACS_INT values.
Andreas Schwab <schwab@suse.de>
parents:
78501
diff
changeset
|
3973 if (format[-1] == 'e' || format[-1] == 'f' || format[-1] == 'g') |
45618be84af9
(Fformat): Correctly format EMACS_INT values.
Andreas Schwab <schwab@suse.de>
parents:
78501
diff
changeset
|
3974 sprintf (p, this_format, XFLOAT_DATA (args[n])); |
45618be84af9
(Fformat): Correctly format EMACS_INT values.
Andreas Schwab <schwab@suse.de>
parents:
78501
diff
changeset
|
3975 else |
72584
ad48859287a7
(Fformat): Don't sign-extend for %o or %x.
Richard M. Stallman <rms@gnu.org>
parents:
72531
diff
changeset
|
3976 { |
79472
daa9b2b4d89d
(Fformat): Handle %c specially since it requires the
Andreas Schwab <schwab@suse.de>
parents:
79428
diff
changeset
|
3977 if (sizeof (EMACS_INT) > sizeof (int) |
daa9b2b4d89d
(Fformat): Handle %c specially since it requires the
Andreas Schwab <schwab@suse.de>
parents:
79428
diff
changeset
|
3978 && format[-1] != 'c') |
79422
45618be84af9
(Fformat): Correctly format EMACS_INT values.
Andreas Schwab <schwab@suse.de>
parents:
78501
diff
changeset
|
3979 { |
45618be84af9
(Fformat): Correctly format EMACS_INT values.
Andreas Schwab <schwab@suse.de>
parents:
78501
diff
changeset
|
3980 /* Insert 'l' before format spec. */ |
45618be84af9
(Fformat): Correctly format EMACS_INT values.
Andreas Schwab <schwab@suse.de>
parents:
78501
diff
changeset
|
3981 this_format[format - this_format_start] |
45618be84af9
(Fformat): Correctly format EMACS_INT values.
Andreas Schwab <schwab@suse.de>
parents:
78501
diff
changeset
|
3982 = this_format[format - this_format_start - 1]; |
45618be84af9
(Fformat): Correctly format EMACS_INT values.
Andreas Schwab <schwab@suse.de>
parents:
78501
diff
changeset
|
3983 this_format[format - this_format_start - 1] = 'l'; |
45618be84af9
(Fformat): Correctly format EMACS_INT values.
Andreas Schwab <schwab@suse.de>
parents:
78501
diff
changeset
|
3984 this_format[format - this_format_start + 1] = 0; |
45618be84af9
(Fformat): Correctly format EMACS_INT values.
Andreas Schwab <schwab@suse.de>
parents:
78501
diff
changeset
|
3985 } |
45618be84af9
(Fformat): Correctly format EMACS_INT values.
Andreas Schwab <schwab@suse.de>
parents:
78501
diff
changeset
|
3986 |
45618be84af9
(Fformat): Correctly format EMACS_INT values.
Andreas Schwab <schwab@suse.de>
parents:
78501
diff
changeset
|
3987 if (INTEGERP (args[n])) |
45618be84af9
(Fformat): Correctly format EMACS_INT values.
Andreas Schwab <schwab@suse.de>
parents:
78501
diff
changeset
|
3988 { |
79472
daa9b2b4d89d
(Fformat): Handle %c specially since it requires the
Andreas Schwab <schwab@suse.de>
parents:
79428
diff
changeset
|
3989 if (format[-1] == 'c') |
daa9b2b4d89d
(Fformat): Handle %c specially since it requires the
Andreas Schwab <schwab@suse.de>
parents:
79428
diff
changeset
|
3990 sprintf (p, this_format, (int) XINT (args[n])); |
daa9b2b4d89d
(Fformat): Handle %c specially since it requires the
Andreas Schwab <schwab@suse.de>
parents:
79428
diff
changeset
|
3991 else if (format[-1] == 'd') |
79422
45618be84af9
(Fformat): Correctly format EMACS_INT values.
Andreas Schwab <schwab@suse.de>
parents:
78501
diff
changeset
|
3992 sprintf (p, this_format, XINT (args[n])); |
45618be84af9
(Fformat): Correctly format EMACS_INT values.
Andreas Schwab <schwab@suse.de>
parents:
78501
diff
changeset
|
3993 /* Don't sign-extend for octal or hex printing. */ |
45618be84af9
(Fformat): Correctly format EMACS_INT values.
Andreas Schwab <schwab@suse.de>
parents:
78501
diff
changeset
|
3994 else |
45618be84af9
(Fformat): Correctly format EMACS_INT values.
Andreas Schwab <schwab@suse.de>
parents:
78501
diff
changeset
|
3995 sprintf (p, this_format, XUINT (args[n])); |
45618be84af9
(Fformat): Correctly format EMACS_INT values.
Andreas Schwab <schwab@suse.de>
parents:
78501
diff
changeset
|
3996 } |
79472
daa9b2b4d89d
(Fformat): Handle %c specially since it requires the
Andreas Schwab <schwab@suse.de>
parents:
79428
diff
changeset
|
3997 else if (format[-1] == 'c') |
daa9b2b4d89d
(Fformat): Handle %c specially since it requires the
Andreas Schwab <schwab@suse.de>
parents:
79428
diff
changeset
|
3998 sprintf (p, this_format, (int) XFLOAT_DATA (args[n])); |
79422
45618be84af9
(Fformat): Correctly format EMACS_INT values.
Andreas Schwab <schwab@suse.de>
parents:
78501
diff
changeset
|
3999 else if (format[-1] == 'd') |
45618be84af9
(Fformat): Correctly format EMACS_INT values.
Andreas Schwab <schwab@suse.de>
parents:
78501
diff
changeset
|
4000 /* Maybe we should use "%1.0f" instead so it also works |
45618be84af9
(Fformat): Correctly format EMACS_INT values.
Andreas Schwab <schwab@suse.de>
parents:
78501
diff
changeset
|
4001 for values larger than MAXINT. */ |
45618be84af9
(Fformat): Correctly format EMACS_INT values.
Andreas Schwab <schwab@suse.de>
parents:
78501
diff
changeset
|
4002 sprintf (p, this_format, (EMACS_INT) XFLOAT_DATA (args[n])); |
72584
ad48859287a7
(Fformat): Don't sign-extend for %o or %x.
Richard M. Stallman <rms@gnu.org>
parents:
72531
diff
changeset
|
4003 else |
79422
45618be84af9
(Fformat): Correctly format EMACS_INT values.
Andreas Schwab <schwab@suse.de>
parents:
78501
diff
changeset
|
4004 /* Don't sign-extend for octal or hex printing. */ |
45618be84af9
(Fformat): Correctly format EMACS_INT values.
Andreas Schwab <schwab@suse.de>
parents:
78501
diff
changeset
|
4005 sprintf (p, this_format, (EMACS_UINT) XFLOAT_DATA (args[n])); |
72584
ad48859287a7
(Fformat): Don't sign-extend for %o or %x.
Richard M. Stallman <rms@gnu.org>
parents:
72531
diff
changeset
|
4006 } |
12603
6d033c8501d4
(Fformat): Increment total for size of control string.
Richard M. Stallman <rms@gnu.org>
parents:
12602
diff
changeset
|
4007 |
22698
ea6ef56295b4
(Fformat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents:
22669
diff
changeset
|
4008 if (p > buf |
ea6ef56295b4
(Fformat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents:
22669
diff
changeset
|
4009 && multibyte |
22712
6f129ed55108
(Fformat): Replace explicit numeric constants with proper macros.
Kenichi Handa <handa@m17n.org>
parents:
22698
diff
changeset
|
4010 && !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
|
4011 && !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
|
4012 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
|
4013 this_nchars = strlen (p); |
29008
939760ef7379
(Fformat): Be sure to convert 8-bit characters to
Kenichi Handa <handa@m17n.org>
parents:
28545
diff
changeset
|
4014 if (multibyte) |
56194
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
4015 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
|
4016 else |
939760ef7379
(Fformat): Be sure to convert 8-bit characters to
Kenichi Handa <handa@m17n.org>
parents:
28545
diff
changeset
|
4017 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
|
4018 nchars += this_nchars; |
66500
8392b2926dd8
(Fformat): Don't include string padding
Richard M. Stallman <rms@gnu.org>
parents:
66379
diff
changeset
|
4019 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
|
4020 } |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4021 |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
4022 } |
20861
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
4023 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
|
4024 { |
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
4025 /* Copy a whole multibyte character. */ |
22698
ea6ef56295b4
(Fformat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents:
22669
diff
changeset
|
4026 if (p > buf |
ea6ef56295b4
(Fformat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents:
22669
diff
changeset
|
4027 && multibyte |
22712
6f129ed55108
(Fformat): Replace explicit numeric constants with proper macros.
Kenichi Handa <handa@m17n.org>
parents:
22698
diff
changeset
|
4028 && !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
|
4029 && !CHAR_HEAD_P (*format)) |
22698
ea6ef56295b4
(Fformat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents:
22669
diff
changeset
|
4030 maybe_combine_byte = 1; |
20861
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
4031 *p++ = *format++; |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4032 while (! CHAR_HEAD_P (*format)) |
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 discarded[format - format_start] = 2; |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4035 *p++ = *format++; |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4036 } |
20861
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
4037 nchars++; |
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
4038 } |
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
4039 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
|
4040 { |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
4041 /* 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
|
4042 int len = copy_text (format, p, 1, 0, 1); |
305 | 4043 |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
4044 p += len; |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
4045 format++; |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
4046 nchars++; |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
4047 } |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
4048 else |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
4049 *p++ = *format++, nchars++; |
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
4050 } |
305 | 4051 |
56194
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
4052 if (p > buf + total) |
34566
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
4053 abort (); |
0370af7597d2
(Fformat): Prevent a buffer overrun when the format
Gerd Moellmann <gerd@gnu.org>
parents:
34165
diff
changeset
|
4054 |
22698
ea6ef56295b4
(Fformat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents:
22669
diff
changeset
|
4055 if (maybe_combine_byte) |
ea6ef56295b4
(Fformat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents:
22669
diff
changeset
|
4056 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
|
4057 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
|
4058 |
20606
9331e7e88cf5
(Fformat): Do all the work directly--don't use doprnt.
Richard M. Stallman <rms@gnu.org>
parents:
20564
diff
changeset
|
4059 /* 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
|
4060 SAFE_FREE (); |
305 | 4061 |
25018 | 4062 /* If the format string has text properties, or any of the string |
4063 arguments has text properties, set up text properties of the | |
4064 result string. */ | |
30480 | 4065 |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4066 if (STRING_INTERVALS (args[0]) || arg_intervals) |
25018 | 4067 { |
4068 Lisp_Object len, new_len, props; | |
4069 struct gcpro gcpro1; | |
30480 | 4070 |
25018 | 4071 /* 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
|
4072 len = make_number (SCHARS (args[0])); |
25018 | 4073 props = text_property_list (args[0], make_number (0), len, Qnil); |
4074 GCPRO1 (props); | |
30480 | 4075 |
25018 | 4076 if (CONSP (props)) |
4077 { | |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4078 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
|
4079 Lisp_Object list; |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4080 |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4081 /* Adjust the bounds of each text property |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4082 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
|
4083 |
d2baef38bbd7
(Fformat): Handle format strings with multiple text
Kim F. Storm <storm@cua.dk>
parents:
56560
diff
changeset
|
4084 /* 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
|
4085 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
|
4086 space of the format string. */ |
d2baef38bbd7
(Fformat): Handle format strings with multiple text
Kim F. Storm <storm@cua.dk>
parents:
56560
diff
changeset
|
4087 props = Fnreverse (props); |
d2baef38bbd7
(Fformat): Handle format strings with multiple text
Kim F. Storm <storm@cua.dk>
parents:
56560
diff
changeset
|
4088 |
d2baef38bbd7
(Fformat): Handle format strings with multiple text
Kim F. Storm <storm@cua.dk>
parents:
56560
diff
changeset
|
4089 /* 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
|
4090 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
|
4091 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
|
4092 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
|
4093 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
|
4094 { |
50555
37d227b879ad
(Fformat): Lisp_Object/int mixup.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50499
diff
changeset
|
4095 Lisp_Object item; |
37d227b879ad
(Fformat): Lisp_Object/int mixup.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50499
diff
changeset
|
4096 int pos; |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4097 |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4098 item = XCAR (list); |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4099 |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4100 /* First adjust the property start position. */ |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4101 pos = XINT (XCAR (item)); |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4102 |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4103 /* Advance BYTEPOS, POSITION, TRANSLATED and ARGN |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4104 up to this position. */ |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4105 for (; position < pos; bytepos++) |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4106 { |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4107 if (! discarded[bytepos]) |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4108 position++, translated++; |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4109 else if (discarded[bytepos] == 1) |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4110 { |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4111 position++; |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4112 if (translated == info[argn].start) |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4113 { |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4114 translated += info[argn].end - info[argn].start; |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4115 argn++; |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4116 } |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4117 } |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4118 } |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4119 |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4120 XSETCAR (item, make_number (translated)); |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4121 |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4122 /* Likewise adjust the property end position. */ |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4123 pos = XINT (XCAR (XCDR (item))); |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4124 |
71865
47930f9fbcdf
(Fformat): Fix calculation of text property positions
Kenichi Handa <handa@m17n.org>
parents:
71832
diff
changeset
|
4125 for (; position < pos; bytepos++) |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4126 { |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4127 if (! discarded[bytepos]) |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4128 position++, translated++; |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4129 else if (discarded[bytepos] == 1) |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4130 { |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4131 position++; |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4132 if (translated == info[argn].start) |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4133 { |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4134 translated += info[argn].end - info[argn].start; |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4135 argn++; |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4136 } |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4137 } |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4138 } |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4139 |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4140 XSETCAR (XCDR (item), make_number (translated)); |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4141 } |
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4142 |
25018 | 4143 add_text_properties_from_list (val, props, make_number (0)); |
4144 } | |
4145 | |
4146 /* Add text properties from arguments. */ | |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4147 if (arg_intervals) |
25018 | 4148 for (n = 1; n < nargs; ++n) |
50499
0abd4951c0fb
(Fformat): Translate positions of text properties
Richard M. Stallman <rms@gnu.org>
parents:
50430
diff
changeset
|
4149 if (info[n].intervals) |
25018 | 4150 { |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
4151 len = make_number (SCHARS (args[n])); |
25018 | 4152 new_len = make_number (info[n].end - info[n].start); |
4153 props = text_property_list (args[n], make_number (0), len, Qnil); | |
4154 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
|
4155 /* 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
|
4156 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
|
4157 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
|
4158 make_composition_value_copy (props); |
25018 | 4159 add_text_properties_from_list (val, props, |
4160 make_number (info[n].start)); | |
4161 } | |
4162 | |
4163 UNGCPRO; | |
4164 } | |
4165 | |
20804
14fa73136e64
(CONVERTED_BYTE_SIZE): Fix the logic.
Kenichi Handa <handa@m17n.org>
parents:
20706
diff
changeset
|
4166 return val; |
305 | 4167 } |
4168 | |
4169 Lisp_Object | |
49443
f9f7612c767a
(format2): New function, replaces format1
Richard M. Stallman <rms@gnu.org>
parents:
49293
diff
changeset
|
4170 format2 (string1, arg0, arg1) |
305 | 4171 char *string1; |
49443
f9f7612c767a
(format2): New function, replaces format1
Richard M. Stallman <rms@gnu.org>
parents:
49293
diff
changeset
|
4172 Lisp_Object arg0, arg1; |
305 | 4173 { |
49443
f9f7612c767a
(format2): New function, replaces format1
Richard M. Stallman <rms@gnu.org>
parents:
49293
diff
changeset
|
4174 Lisp_Object args[3]; |
f9f7612c767a
(format2): New function, replaces format1
Richard M. Stallman <rms@gnu.org>
parents:
49293
diff
changeset
|
4175 args[0] = build_string (string1); |
f9f7612c767a
(format2): New function, replaces format1
Richard M. Stallman <rms@gnu.org>
parents:
49293
diff
changeset
|
4176 args[1] = arg0; |
f9f7612c767a
(format2): New function, replaces format1
Richard M. Stallman <rms@gnu.org>
parents:
49293
diff
changeset
|
4177 args[2] = arg1; |
f9f7612c767a
(format2): New function, replaces format1
Richard M. Stallman <rms@gnu.org>
parents:
49293
diff
changeset
|
4178 return Fformat (3, args); |
305 | 4179 } |
4180 | |
4181 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
|
4182 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
|
4183 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
|
4184 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
|
4185 (c1, c2) |
305 | 4186 register Lisp_Object c1, c2; |
4187 { | |
20688
16c458803c32
(Fchar_equal): Fix case-conversion code.
Richard M. Stallman <rms@gnu.org>
parents:
20606
diff
changeset
|
4188 int i1, i2; |
93038
a2c4bffe2b59
(Fchar_equal): Check they are valid characters.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
92954
diff
changeset
|
4189 /* Check they're chars, not just integers, otherwise we could get array |
a2c4bffe2b59
(Fchar_equal): Check they are valid characters.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
92954
diff
changeset
|
4190 bounds violations in DOWNCASE. */ |
a2c4bffe2b59
(Fchar_equal): Check they are valid characters.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
92954
diff
changeset
|
4191 CHECK_CHARACTER (c1); |
a2c4bffe2b59
(Fchar_equal): Check they are valid characters.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
92954
diff
changeset
|
4192 CHECK_CHARACTER (c2); |
305 | 4193 |
20688
16c458803c32
(Fchar_equal): Fix case-conversion code.
Richard M. Stallman <rms@gnu.org>
parents:
20606
diff
changeset
|
4194 if (XINT (c1) == XINT (c2)) |
305 | 4195 return Qt; |
20688
16c458803c32
(Fchar_equal): Fix case-conversion code.
Richard M. Stallman <rms@gnu.org>
parents:
20606
diff
changeset
|
4196 if (NILP (current_buffer->case_fold_search)) |
16c458803c32
(Fchar_equal): Fix case-conversion code.
Richard M. Stallman <rms@gnu.org>
parents:
20606
diff
changeset
|
4197 return Qnil; |
16c458803c32
(Fchar_equal): Fix case-conversion code.
Richard M. Stallman <rms@gnu.org>
parents:
20606
diff
changeset
|
4198 |
16c458803c32
(Fchar_equal): Fix case-conversion code.
Richard M. Stallman <rms@gnu.org>
parents:
20606
diff
changeset
|
4199 /* Do these in separate statements, |
16c458803c32
(Fchar_equal): Fix case-conversion code.
Richard M. Stallman <rms@gnu.org>
parents:
20606
diff
changeset
|
4200 then compare the variables. |
16c458803c32
(Fchar_equal): Fix case-conversion code.
Richard M. Stallman <rms@gnu.org>
parents:
20606
diff
changeset
|
4201 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
|
4202 i1 = XFASTINT (c1); |
1c45126c0974
(Fchar_equal): Fix for the unibyte case.
Kenichi Handa <handa@m17n.org>
parents:
89009
diff
changeset
|
4203 if (NILP (current_buffer->enable_multibyte_characters) |
1c45126c0974
(Fchar_equal): Fix for the unibyte case.
Kenichi Handa <handa@m17n.org>
parents:
89009
diff
changeset
|
4204 && ! ASCII_CHAR_P (i1)) |
1c45126c0974
(Fchar_equal): Fix for the unibyte case.
Kenichi Handa <handa@m17n.org>
parents:
89009
diff
changeset
|
4205 { |
1c45126c0974
(Fchar_equal): Fix for the unibyte case.
Kenichi Handa <handa@m17n.org>
parents:
89009
diff
changeset
|
4206 MAKE_CHAR_MULTIBYTE (i1); |
1c45126c0974
(Fchar_equal): Fix for the unibyte case.
Kenichi Handa <handa@m17n.org>
parents:
89009
diff
changeset
|
4207 } |
1c45126c0974
(Fchar_equal): Fix for the unibyte case.
Kenichi Handa <handa@m17n.org>
parents:
89009
diff
changeset
|
4208 i2 = XFASTINT (c2); |
1c45126c0974
(Fchar_equal): Fix for the unibyte case.
Kenichi Handa <handa@m17n.org>
parents:
89009
diff
changeset
|
4209 if (NILP (current_buffer->enable_multibyte_characters) |
1c45126c0974
(Fchar_equal): Fix for the unibyte case.
Kenichi Handa <handa@m17n.org>
parents:
89009
diff
changeset
|
4210 && ! ASCII_CHAR_P (i2)) |
1c45126c0974
(Fchar_equal): Fix for the unibyte case.
Kenichi Handa <handa@m17n.org>
parents:
89009
diff
changeset
|
4211 { |
1c45126c0974
(Fchar_equal): Fix for the unibyte case.
Kenichi Handa <handa@m17n.org>
parents:
89009
diff
changeset
|
4212 MAKE_CHAR_MULTIBYTE (i2); |
1c45126c0974
(Fchar_equal): Fix for the unibyte case.
Kenichi Handa <handa@m17n.org>
parents:
89009
diff
changeset
|
4213 } |
1c45126c0974
(Fchar_equal): Fix for the unibyte case.
Kenichi Handa <handa@m17n.org>
parents:
89009
diff
changeset
|
4214 i1 = DOWNCASE (i1); |
1c45126c0974
(Fchar_equal): Fix for the unibyte case.
Kenichi Handa <handa@m17n.org>
parents:
89009
diff
changeset
|
4215 i2 = DOWNCASE (i2); |
20688
16c458803c32
(Fchar_equal): Fix case-conversion code.
Richard M. Stallman <rms@gnu.org>
parents:
20606
diff
changeset
|
4216 return (i1 == i2 ? Qt : Qnil); |
305 | 4217 } |
7207
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 /* 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
|
4220 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
|
4221 differ in size). |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4222 |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
4223 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
|
4224 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
|
4225 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
|
4226 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
|
4227 |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4228 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
|
4229 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
|
4230 rest untouched. Most of this is copied from adjust_markers in insdel.c. |
30480 | 4231 |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
4232 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
|
4233 |
31016
b26ac1565dd4
(find_field): Formatting changes.
Gerd Moellmann <gerd@gnu.org>
parents:
30931
diff
changeset
|
4234 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
|
4235 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
|
4236 start1_byte, end1_byte, start2_byte, end2_byte) |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4237 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
|
4238 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
|
4239 { |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
4240 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
|
4241 register struct Lisp_Marker *marker; |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4242 |
7862
0b6f46029ea2
(transpose_markers): Allow for gap at start of region.
Karl Heuer <kwzh@gnu.org>
parents:
7710
diff
changeset
|
4243 /* 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
|
4244 if (PT < start1) |
987ab382275c
(Ftranspose_regions): Fix overlays after moving markers.
Karl Heuer <kwzh@gnu.org>
parents:
7506
diff
changeset
|
4245 ; |
987ab382275c
(Ftranspose_regions): Fix overlays after moving markers.
Karl Heuer <kwzh@gnu.org>
parents:
7506
diff
changeset
|
4246 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
|
4247 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
|
4248 PT_BYTE + (end2_byte - end1_byte)); |
7519
987ab382275c
(Ftranspose_regions): Fix overlays after moving markers.
Karl Heuer <kwzh@gnu.org>
parents:
7506
diff
changeset
|
4249 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
|
4250 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
|
4251 (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
|
4252 - (end1_byte - start1_byte))); |
7519
987ab382275c
(Ftranspose_regions): Fix overlays after moving markers.
Karl Heuer <kwzh@gnu.org>
parents:
7506
diff
changeset
|
4253 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
|
4254 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
|
4255 PT_BYTE - (start2_byte - start1_byte)); |
7519
987ab382275c
(Ftranspose_regions): Fix overlays after moving markers.
Karl Heuer <kwzh@gnu.org>
parents:
7506
diff
changeset
|
4256 |
7862
0b6f46029ea2
(transpose_markers): Allow for gap at start of region.
Karl Heuer <kwzh@gnu.org>
parents:
7710
diff
changeset
|
4257 /* 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
|
4258 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
|
4259 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
|
4260 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
|
4261 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
|
4262 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
|
4263 the dirty work to Fmarker_position, below. */ |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4264 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4265 /* The difference between the region's lengths */ |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4266 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
|
4267 diff_byte = (end2_byte - start2_byte) - (end1_byte - start1_byte); |
30480 | 4268 |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4269 /* 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
|
4270 region plus the distance between the regions. */ |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4271 amt1 = (end2 - start2) + (start2 - end1); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4272 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
|
4273 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
|
4274 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
|
4275 |
51670
beceb827c1ce
(save_excursion_restore, transpose_markers): Update for new types.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
51042
diff
changeset
|
4276 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
|
4277 { |
51670
beceb827c1ce
(save_excursion_restore, transpose_markers): Update for new types.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
51042
diff
changeset
|
4278 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
|
4279 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
|
4280 { |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
4281 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
|
4282 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
|
4283 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
|
4284 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
|
4285 else |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
4286 mpos -= amt2_byte; |
51670
beceb827c1ce
(save_excursion_restore, transpose_markers): Update for new types.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
51042
diff
changeset
|
4287 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
|
4288 } |
51670
beceb827c1ce
(save_excursion_restore, transpose_markers): Update for new types.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
51042
diff
changeset
|
4289 mpos = marker->charpos; |
7862
0b6f46029ea2
(transpose_markers): Allow for gap at start of region.
Karl Heuer <kwzh@gnu.org>
parents:
7710
diff
changeset
|
4290 if (mpos >= start1 && mpos < end2) |
0b6f46029ea2
(transpose_markers): Allow for gap at start of region.
Karl Heuer <kwzh@gnu.org>
parents:
7710
diff
changeset
|
4291 { |
0b6f46029ea2
(transpose_markers): Allow for gap at start of region.
Karl Heuer <kwzh@gnu.org>
parents:
7710
diff
changeset
|
4292 if (mpos < end1) |
0b6f46029ea2
(transpose_markers): Allow for gap at start of region.
Karl Heuer <kwzh@gnu.org>
parents:
7710
diff
changeset
|
4293 mpos += amt1; |
0b6f46029ea2
(transpose_markers): Allow for gap at start of region.
Karl Heuer <kwzh@gnu.org>
parents:
7710
diff
changeset
|
4294 else if (mpos < start2) |
0b6f46029ea2
(transpose_markers): Allow for gap at start of region.
Karl Heuer <kwzh@gnu.org>
parents:
7710
diff
changeset
|
4295 mpos += diff; |
0b6f46029ea2
(transpose_markers): Allow for gap at start of region.
Karl Heuer <kwzh@gnu.org>
parents:
7710
diff
changeset
|
4296 else |
0b6f46029ea2
(transpose_markers): Allow for gap at start of region.
Karl Heuer <kwzh@gnu.org>
parents:
7710
diff
changeset
|
4297 mpos -= amt2; |
0b6f46029ea2
(transpose_markers): Allow for gap at start of region.
Karl Heuer <kwzh@gnu.org>
parents:
7710
diff
changeset
|
4298 } |
51670
beceb827c1ce
(save_excursion_restore, transpose_markers): Update for new types.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
51042
diff
changeset
|
4299 marker->charpos = mpos; |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4300 } |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4301 } |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4302 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4303 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
|
4304 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
|
4305 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
|
4306 never changed in a transposition. |
1c2d486200f3
Put doc strings in comments.
Pavel Janík <Pavel@Janik.cz>
parents:
39962
diff
changeset
|
4307 |
55972
db2480202623
(Fuser_login_name, Ffloat_time, Fencode_time, Fcurrent_time_string)
Juanma Barranquero <lekktu@gmail.com>
parents:
55424
diff
changeset
|
4308 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
|
4309 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
|
4310 |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
4311 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
|
4312 (startr1, endr1, startr2, endr2, leave_markers) |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4313 Lisp_Object startr1, endr1, startr2, endr2, leave_markers; |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4314 { |
81793
935816f951c9
(Ftranspose_regions): Use EMACS_INT for positions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
81422
diff
changeset
|
4315 register EMACS_INT start1, end1, start2, end2; |
935816f951c9
(Ftranspose_regions): Use EMACS_INT for positions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
81422
diff
changeset
|
4316 EMACS_INT start1_byte, start2_byte, len1_byte, len2_byte; |
935816f951c9
(Ftranspose_regions): Use EMACS_INT for positions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
81422
diff
changeset
|
4317 EMACS_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
|
4318 unsigned char *start1_addr, *start2_addr, *temp; |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4319 |
77017
484daf850d1e
(Ftranspose_regions): Validate interval before setting text
Chong Yidong <cyd@stupidchicken.com>
parents:
76709
diff
changeset
|
4320 INTERVAL cur_intv, tmp_interval1, tmp_interval_mid, tmp_interval2, tmp_interval3; |
76703
556faea8ff02
(Ftranspose_regions): Use set_text_properties_1 instead of
Chong Yidong <cyd@stupidchicken.com>
parents:
76509
diff
changeset
|
4321 Lisp_Object buf; |
556faea8ff02
(Ftranspose_regions): Use set_text_properties_1 instead of
Chong Yidong <cyd@stupidchicken.com>
parents:
76509
diff
changeset
|
4322 |
556faea8ff02
(Ftranspose_regions): Use set_text_properties_1 instead of
Chong Yidong <cyd@stupidchicken.com>
parents:
76509
diff
changeset
|
4323 XSETBUFFER (buf, current_buffer); |
10308
90784ed0416f
Use SAVE_MODIFF and BUF_SAVE_MODIFF
Richard M. Stallman <rms@gnu.org>
parents:
9812
diff
changeset
|
4324 cur_intv = BUF_INTERVALS (current_buffer); |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4325 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4326 validate_region (&startr1, &endr1); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4327 validate_region (&startr2, &endr2); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4328 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4329 start1 = XFASTINT (startr1); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4330 end1 = XFASTINT (endr1); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4331 start2 = XFASTINT (startr2); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4332 end2 = XFASTINT (endr2); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4333 gap = GPT; |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4334 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4335 /* Swap the regions if they're reversed. */ |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4336 if (start2 < end1) |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4337 { |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4338 register int glumph = start1; |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4339 start1 = start2; |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4340 start2 = glumph; |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4341 glumph = end1; |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4342 end1 = end2; |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4343 end2 = glumph; |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4344 } |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4345 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4346 len1 = end1 - start1; |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4347 len2 = end2 - start2; |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4348 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4349 if (start2 < end1) |
21245
6cde55b7c9de
Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents:
21235
diff
changeset
|
4350 error ("Transposed regions overlap"); |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4351 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
|
4352 error ("Transposed region has length 0"); |
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 /* The possibilities are: |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4355 1. Adjacent (contiguous) regions, or separate but equal regions |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4356 (no, really equal, in this case!), or |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4357 2. Separate regions of unequal size. |
30480 | 4358 |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4359 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
|
4360 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
|
4361 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
|
4362 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
|
4363 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4364 /* 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
|
4365 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
|
4366 around it if necessary. This would be extremely efficient, |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4367 especially considering that people are likely to do |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4368 transpositions near where they are working interactively, which |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4369 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
|
4370 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
|
4371 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
|
4372 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
|
4373 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
|
4374 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
|
4375 |
67bb3bb1b62d
(Ftranspose_regions): Take addresses only after move gap.
Richard M. Stallman <rms@gnu.org>
parents:
7207
diff
changeset
|
4376 /* 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
|
4377 we will operate on. */ |
67bb3bb1b62d
(Ftranspose_regions): Take addresses only after move gap.
Richard M. Stallman <rms@gnu.org>
parents:
7207
diff
changeset
|
4378 if (start1 < gap && gap < end2) |
67bb3bb1b62d
(Ftranspose_regions): Take addresses only after move gap.
Richard M. Stallman <rms@gnu.org>
parents:
7207
diff
changeset
|
4379 { |
67bb3bb1b62d
(Ftranspose_regions): Take addresses only after move gap.
Richard M. Stallman <rms@gnu.org>
parents:
7207
diff
changeset
|
4380 if (gap - start1 < end2 - gap) |
67bb3bb1b62d
(Ftranspose_regions): Take addresses only after move gap.
Richard M. Stallman <rms@gnu.org>
parents:
7207
diff
changeset
|
4381 move_gap (start1); |
67bb3bb1b62d
(Ftranspose_regions): Take addresses only after move gap.
Richard M. Stallman <rms@gnu.org>
parents:
7207
diff
changeset
|
4382 else |
67bb3bb1b62d
(Ftranspose_regions): Take addresses only after move gap.
Richard M. Stallman <rms@gnu.org>
parents:
7207
diff
changeset
|
4383 move_gap (end2); |
67bb3bb1b62d
(Ftranspose_regions): Take addresses only after move gap.
Richard M. Stallman <rms@gnu.org>
parents:
7207
diff
changeset
|
4384 } |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
4385 |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
4386 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
|
4387 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
|
4388 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
|
4389 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
|
4390 |
29008
939760ef7379
(Fformat): Be sure to convert 8-bit characters to
Kenichi Handa <handa@m17n.org>
parents:
28545
diff
changeset
|
4391 #ifdef BYTE_COMBINING_DEBUG |
21245
6cde55b7c9de
Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents:
21235
diff
changeset
|
4392 if (end1 == start2) |
6cde55b7c9de
Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents:
21235
diff
changeset
|
4393 { |
29008
939760ef7379
(Fformat): Be sure to convert 8-bit characters to
Kenichi Handa <handa@m17n.org>
parents:
28545
diff
changeset
|
4394 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
|
4395 len2_byte, start1, start1_byte) |
939760ef7379
(Fformat): Be sure to convert 8-bit characters to
Kenichi Handa <handa@m17n.org>
parents:
28545
diff
changeset
|
4396 || 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
|
4397 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
|
4398 || 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
|
4399 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
|
4400 abort (); |
21245
6cde55b7c9de
Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents:
21235
diff
changeset
|
4401 } |
6cde55b7c9de
Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents:
21235
diff
changeset
|
4402 else |
6cde55b7c9de
Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents:
21235
diff
changeset
|
4403 { |
29008
939760ef7379
(Fformat): Be sure to convert 8-bit characters to
Kenichi Handa <handa@m17n.org>
parents:
28545
diff
changeset
|
4404 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
|
4405 len2_byte, start1, start1_byte) |
939760ef7379
(Fformat): Be sure to convert 8-bit characters to
Kenichi Handa <handa@m17n.org>
parents:
28545
diff
changeset
|
4406 || 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
|
4407 len1_byte, start2, start2_byte) |
939760ef7379
(Fformat): Be sure to convert 8-bit characters to
Kenichi Handa <handa@m17n.org>
parents:
28545
diff
changeset
|
4408 || 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
|
4409 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
|
4410 || 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
|
4411 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
|
4412 abort (); |
21245
6cde55b7c9de
Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents:
21235
diff
changeset
|
4413 } |
29008
939760ef7379
(Fformat): Be sure to convert 8-bit characters to
Kenichi Handa <handa@m17n.org>
parents:
28545
diff
changeset
|
4414 #endif |
939760ef7379
(Fformat): Be sure to convert 8-bit characters to
Kenichi Handa <handa@m17n.org>
parents:
28545
diff
changeset
|
4415 |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4416 /* 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
|
4417 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
|
4418 allocation... interesting. Later, don't fool with it now. */ |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4419 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4420 /* Working without memmove, for portability (sigh), so must be |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4421 careful of overlapping subsections of the array... */ |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4422 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4423 if (end1 == start2) /* adjacent regions */ |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4424 { |
72592
f6de516bbb4b
* buffer.h (struct buffer_text): New field chars_modiff.
Chong Yidong <cyd@stupidchicken.com>
parents:
72584
diff
changeset
|
4425 modify_region (current_buffer, start1, end2, 0); |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4426 record_change (start1, len1 + len2); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4427 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4428 tmp_interval1 = copy_intervals (cur_intv, start1, len1); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4429 tmp_interval2 = copy_intervals (cur_intv, start2, len2); |
76703
556faea8ff02
(Ftranspose_regions): Use set_text_properties_1 instead of
Chong Yidong <cyd@stupidchicken.com>
parents:
76509
diff
changeset
|
4430 /* Don't use Fset_text_properties: that can cause GC, which can |
556faea8ff02
(Ftranspose_regions): Use set_text_properties_1 instead of
Chong Yidong <cyd@stupidchicken.com>
parents:
76509
diff
changeset
|
4431 clobber objects stored in the tmp_intervals. */ |
77017
484daf850d1e
(Ftranspose_regions): Validate interval before setting text
Chong Yidong <cyd@stupidchicken.com>
parents:
76709
diff
changeset
|
4432 tmp_interval3 = validate_interval_range (buf, &startr1, &endr2, 0); |
484daf850d1e
(Ftranspose_regions): Validate interval before setting text
Chong Yidong <cyd@stupidchicken.com>
parents:
76709
diff
changeset
|
4433 if (!NULL_INTERVAL_P (tmp_interval3)) |
484daf850d1e
(Ftranspose_regions): Validate interval before setting text
Chong Yidong <cyd@stupidchicken.com>
parents:
76709
diff
changeset
|
4434 set_text_properties_1 (startr1, endr2, Qnil, buf, tmp_interval3); |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4435 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4436 /* 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
|
4437 if (len1_byte < len2_byte) |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4438 { |
56194
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
4439 USE_SAFE_ALLOCA; |
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
4440 |
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
4441 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
|
4442 |
0b6f46029ea2
(transpose_markers): Allow for gap at start of region.
Karl Heuer <kwzh@gnu.org>
parents:
7710
diff
changeset
|
4443 /* 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
|
4444 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
|
4445 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
|
4446 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
|
4447 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
|
4448 |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
4449 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
|
4450 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
|
4451 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
|
4452 SAFE_FREE (); |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4453 } |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4454 else |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4455 /* First region not smaller than second. */ |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4456 { |
56194
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
4457 USE_SAFE_ALLOCA; |
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
4458 |
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
4459 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
|
4460 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
|
4461 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
|
4462 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
|
4463 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
|
4464 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
|
4465 SAFE_FREE (); |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4466 } |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4467 graft_intervals_into_buffer (tmp_interval1, start1 + len2, |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4468 len1, current_buffer, 0); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4469 graft_intervals_into_buffer (tmp_interval2, start1, |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4470 len2, current_buffer, 0); |
26853
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
4471 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
|
4472 update_compositions (start1 + len2, end2, CHECK_TAIL); |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4473 } |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4474 /* Non-adjacent regions, because end1 != start2, bleagh... */ |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4475 else |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4476 { |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
4477 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
|
4478 |
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
4479 if (len1_byte == len2_byte) |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4480 /* Regions are same size, though, how nice. */ |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4481 { |
56194
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
4482 USE_SAFE_ALLOCA; |
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
4483 |
72592
f6de516bbb4b
* buffer.h (struct buffer_text): New field chars_modiff.
Chong Yidong <cyd@stupidchicken.com>
parents:
72584
diff
changeset
|
4484 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
|
4485 modify_region (current_buffer, start2, end2, 0); |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4486 record_change (start1, len1); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4487 record_change (start2, len2); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4488 tmp_interval1 = copy_intervals (cur_intv, start1, len1); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4489 tmp_interval2 = copy_intervals (cur_intv, start2, len2); |
77017
484daf850d1e
(Ftranspose_regions): Validate interval before setting text
Chong Yidong <cyd@stupidchicken.com>
parents:
76709
diff
changeset
|
4490 |
484daf850d1e
(Ftranspose_regions): Validate interval before setting text
Chong Yidong <cyd@stupidchicken.com>
parents:
76709
diff
changeset
|
4491 tmp_interval3 = validate_interval_range (buf, &startr1, &endr1, 0); |
484daf850d1e
(Ftranspose_regions): Validate interval before setting text
Chong Yidong <cyd@stupidchicken.com>
parents:
76709
diff
changeset
|
4492 if (!NULL_INTERVAL_P (tmp_interval3)) |
484daf850d1e
(Ftranspose_regions): Validate interval before setting text
Chong Yidong <cyd@stupidchicken.com>
parents:
76709
diff
changeset
|
4493 set_text_properties_1 (startr1, endr1, Qnil, buf, tmp_interval3); |
484daf850d1e
(Ftranspose_regions): Validate interval before setting text
Chong Yidong <cyd@stupidchicken.com>
parents:
76709
diff
changeset
|
4494 |
484daf850d1e
(Ftranspose_regions): Validate interval before setting text
Chong Yidong <cyd@stupidchicken.com>
parents:
76709
diff
changeset
|
4495 tmp_interval3 = validate_interval_range (buf, &startr2, &endr2, 0); |
484daf850d1e
(Ftranspose_regions): Validate interval before setting text
Chong Yidong <cyd@stupidchicken.com>
parents:
76709
diff
changeset
|
4496 if (!NULL_INTERVAL_P (tmp_interval3)) |
484daf850d1e
(Ftranspose_regions): Validate interval before setting text
Chong Yidong <cyd@stupidchicken.com>
parents:
76709
diff
changeset
|
4497 set_text_properties_1 (startr2, endr2, Qnil, buf, tmp_interval3); |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4498 |
56194
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
4499 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
|
4500 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
|
4501 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
|
4502 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
|
4503 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
|
4504 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
|
4505 SAFE_FREE (); |
56194
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
4506 |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4507 graft_intervals_into_buffer (tmp_interval1, start2, |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4508 len1, current_buffer, 0); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4509 graft_intervals_into_buffer (tmp_interval2, start1, |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4510 len2, current_buffer, 0); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4511 } |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4512 |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
4513 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
|
4514 /* 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
|
4515 { |
56194
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
4516 USE_SAFE_ALLOCA; |
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
4517 |
72592
f6de516bbb4b
* buffer.h (struct buffer_text): New field chars_modiff.
Chong Yidong <cyd@stupidchicken.com>
parents:
72584
diff
changeset
|
4518 modify_region (current_buffer, start1, end2, 0); |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4519 record_change (start1, (end2 - start1)); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4520 tmp_interval1 = copy_intervals (cur_intv, start1, len1); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4521 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
|
4522 tmp_interval2 = copy_intervals (cur_intv, start2, len2); |
77017
484daf850d1e
(Ftranspose_regions): Validate interval before setting text
Chong Yidong <cyd@stupidchicken.com>
parents:
76709
diff
changeset
|
4523 |
484daf850d1e
(Ftranspose_regions): Validate interval before setting text
Chong Yidong <cyd@stupidchicken.com>
parents:
76709
diff
changeset
|
4524 tmp_interval3 = validate_interval_range (buf, &startr1, &endr2, 0); |
484daf850d1e
(Ftranspose_regions): Validate interval before setting text
Chong Yidong <cyd@stupidchicken.com>
parents:
76709
diff
changeset
|
4525 if (!NULL_INTERVAL_P (tmp_interval3)) |
484daf850d1e
(Ftranspose_regions): Validate interval before setting text
Chong Yidong <cyd@stupidchicken.com>
parents:
76709
diff
changeset
|
4526 set_text_properties_1 (startr1, endr2, Qnil, buf, tmp_interval3); |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4527 |
7250
67bb3bb1b62d
(Ftranspose_regions): Take addresses only after move gap.
Richard M. Stallman <rms@gnu.org>
parents:
7207
diff
changeset
|
4528 /* holds region 2 */ |
56194
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
4529 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
|
4530 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
|
4531 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
|
4532 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
|
4533 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
|
4534 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
|
4535 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
|
4536 SAFE_FREE (); |
56194
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
4537 |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4538 graft_intervals_into_buffer (tmp_interval1, end2 - len1, |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4539 len1, current_buffer, 0); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4540 graft_intervals_into_buffer (tmp_interval_mid, start1 + len2, |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4541 len_mid, current_buffer, 0); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4542 graft_intervals_into_buffer (tmp_interval2, start1, |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4543 len2, current_buffer, 0); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4544 } |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4545 else |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4546 /* Second region smaller than first. */ |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4547 { |
56194
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
4548 USE_SAFE_ALLOCA; |
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
4549 |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4550 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
|
4551 modify_region (current_buffer, start1, end2, 0); |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4552 |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4553 tmp_interval1 = copy_intervals (cur_intv, start1, len1); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4554 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
|
4555 tmp_interval2 = copy_intervals (cur_intv, start2, len2); |
77017
484daf850d1e
(Ftranspose_regions): Validate interval before setting text
Chong Yidong <cyd@stupidchicken.com>
parents:
76709
diff
changeset
|
4556 |
484daf850d1e
(Ftranspose_regions): Validate interval before setting text
Chong Yidong <cyd@stupidchicken.com>
parents:
76709
diff
changeset
|
4557 tmp_interval3 = validate_interval_range (buf, &startr1, &endr2, 0); |
484daf850d1e
(Ftranspose_regions): Validate interval before setting text
Chong Yidong <cyd@stupidchicken.com>
parents:
76709
diff
changeset
|
4558 if (!NULL_INTERVAL_P (tmp_interval3)) |
484daf850d1e
(Ftranspose_regions): Validate interval before setting text
Chong Yidong <cyd@stupidchicken.com>
parents:
76709
diff
changeset
|
4559 set_text_properties_1 (startr1, endr2, Qnil, buf, tmp_interval3); |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4560 |
7250
67bb3bb1b62d
(Ftranspose_regions): Take addresses only after move gap.
Richard M. Stallman <rms@gnu.org>
parents:
7207
diff
changeset
|
4561 /* holds region 1 */ |
56194
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
4562 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
|
4563 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
|
4564 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
|
4565 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
|
4566 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
|
4567 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
|
4568 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
|
4569 SAFE_FREE (); |
56194
e1f0d4beb4ba
(Fformat, Ftranspose_regions): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents:
55972
diff
changeset
|
4570 |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4571 graft_intervals_into_buffer (tmp_interval1, end2 - len1, |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4572 len1, current_buffer, 0); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4573 graft_intervals_into_buffer (tmp_interval_mid, start1 + len2, |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4574 len_mid, current_buffer, 0); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4575 graft_intervals_into_buffer (tmp_interval2, start1, |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4576 len2, current_buffer, 0); |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4577 } |
26853
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
4578 |
bf700e4957ec
(Fchar_to_string): Adjusted for the change of
Kenichi Handa <handa@m17n.org>
parents:
26742
diff
changeset
|
4579 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
|
4580 update_compositions (end2 - len1, end2, CHECK_BORDER); |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4581 } |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4582 |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
4583 /* 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
|
4584 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
|
4585 should be organized in some sorted data tree. */ |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4586 if (NILP (leave_markers)) |
7519
987ab382275c
(Ftranspose_regions): Fix overlays after moving markers.
Karl Heuer <kwzh@gnu.org>
parents:
7506
diff
changeset
|
4587 { |
20558
d19346dc4453
(Fgoto_char): When arg is a marker, copy char and byte
Richard M. Stallman <rms@gnu.org>
parents:
20338
diff
changeset
|
4588 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
|
4589 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
|
4590 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
|
4591 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
|
4592 } |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4593 |
77661
6634ebb68050
(Ftranspose_regions): Yet another int/Lisp_Object mixup (YAILOM)
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
77017
diff
changeset
|
4594 signal_after_change (start1, end2 - start1, end2 - start1); |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4595 return Qnil; |
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4596 } |
305 | 4597 |
4598 | |
4599 void | |
4600 syms_of_editfns () | |
4601 { | |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
4602 environbuf = 0; |
92954
f0f1c359cd43
(initial_tz): New variable.
Jason Rumney <jasonr@gnu.org>
parents:
92236
diff
changeset
|
4603 initial_tz = 0; |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
4604 |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
4605 Qbuffer_access_fontify_functions |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
4606 = intern ("buffer-access-fontify-functions"); |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
4607 staticpro (&Qbuffer_access_fontify_functions); |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
4608 |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
4609 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
|
4610 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
|
4611 Vinhibit_field_text_motion = Qnil; |
19a664c654ab
(Vinhibit_field_text_motion): New variable.
Gerd Moellmann <gerd@gnu.org>
parents:
26853
diff
changeset
|
4612 |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
4613 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
|
4614 &Vbuffer_access_fontify_functions, |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
4615 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
|
4616 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
|
4617 of the buffer being accessed. */); |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
4618 Vbuffer_access_fontify_functions = Qnil; |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
4619 |
14440
e99b3302c154
(syms_of_editfns): Make buffer-access-fontify-functions
Richard M. Stallman <rms@gnu.org>
parents:
14391
diff
changeset
|
4620 { |
e99b3302c154
(syms_of_editfns): Make buffer-access-fontify-functions
Richard M. Stallman <rms@gnu.org>
parents:
14391
diff
changeset
|
4621 Lisp_Object obuf; |
e99b3302c154
(syms_of_editfns): Make buffer-access-fontify-functions
Richard M. Stallman <rms@gnu.org>
parents:
14391
diff
changeset
|
4622 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
|
4623 obuf = Fcurrent_buffer (); |
e99b3302c154
(syms_of_editfns): Make buffer-access-fontify-functions
Richard M. Stallman <rms@gnu.org>
parents:
14391
diff
changeset
|
4624 /* 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
|
4625 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
|
4626 /* 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
|
4627 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
|
4628 Qnil); |
e99b3302c154
(syms_of_editfns): Make buffer-access-fontify-functions
Richard M. Stallman <rms@gnu.org>
parents:
14391
diff
changeset
|
4629 Fset_buffer (obuf); |
e99b3302c154
(syms_of_editfns): Make buffer-access-fontify-functions
Richard M. Stallman <rms@gnu.org>
parents:
14391
diff
changeset
|
4630 } |
e99b3302c154
(syms_of_editfns): Make buffer-access-fontify-functions
Richard M. Stallman <rms@gnu.org>
parents:
14391
diff
changeset
|
4631 |
14220 | 4632 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
|
4633 &Vbuffer_access_fontified_property, |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
4634 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
|
4635 `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
|
4636 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
|
4637 Vbuffer_access_fontified_property = Qnil; |
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
4638 |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
4639 DEFVAR_LISP ("system-name", &Vsystem_name, |
72751
9128a4531448
(Fsystem_name): Mention "host" in the doc string.
Eli Zaretskii <eliz@gnu.org>
parents:
72669
diff
changeset
|
4640 doc: /* The host name of the machine Emacs is running on. */); |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
4641 |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
4642 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
|
4643 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
|
4644 |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
4645 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
|
4646 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
|
4647 |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39966
diff
changeset
|
4648 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
|
4649 doc: /* The user's name, based upon the real uid only. */); |
305 | 4650 |
59644
d8d85276ffed
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
58029
diff
changeset
|
4651 DEFVAR_LISP ("operating-system-release", &Voperating_system_release, |
d8d85276ffed
* editfns.c (Voperating_system_release): Added.
Steven Tamm <steventamm@mac.com>
parents:
58029
diff
changeset
|
4652 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
|
4653 |
25833
65cab65c4a28
(Fpropertize): Renamed from Fproperties.
Gerd Moellmann <gerd@gnu.org>
parents:
25815
diff
changeset
|
4654 defsubr (&Spropertize); |
305 | 4655 defsubr (&Schar_equal); |
4656 defsubr (&Sgoto_char); | |
4657 defsubr (&Sstring_to_char); | |
4658 defsubr (&Schar_to_string); | |
4659 defsubr (&Sbuffer_substring); | |
13767
862fff660446
(Fset_time_zone_rule): Move static var environbuf
Karl Heuer <kwzh@gnu.org>
parents:
13618
diff
changeset
|
4660 defsubr (&Sbuffer_substring_no_properties); |
305 | 4661 defsubr (&Sbuffer_string); |
4662 | |
4663 defsubr (&Spoint_marker); | |
4664 defsubr (&Smark_marker); | |
4665 defsubr (&Spoint); | |
4666 defsubr (&Sregion_beginning); | |
4667 defsubr (&Sregion_end); | |
20861
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
4668 |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
4669 staticpro (&Qfield); |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
4670 Qfield = intern ("field"); |
30439
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
4671 staticpro (&Qboundary); |
c084f49c2a7f
(find_field): Honor special `boundary' fields.
Miles Bader <miles@gnu.org>
parents:
30244
diff
changeset
|
4672 Qboundary = intern ("boundary"); |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
4673 defsubr (&Sfield_beginning); |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
4674 defsubr (&Sfield_end); |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
4675 defsubr (&Sfield_string); |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
4676 defsubr (&Sfield_string_no_properties); |
26347
7fd9f4ecdd29
(Fdelete_field): Renamed from Ferase_field.
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
4677 defsubr (&Sdelete_field); |
26058
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
4678 defsubr (&Sconstrain_to_field); |
c11f0832a7c5
(Fconstrain_to_field): Make sure we don't violate the
Gerd Moellmann <gerd@gnu.org>
parents:
25833
diff
changeset
|
4679 |
20861
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
4680 defsubr (&Sline_beginning_position); |
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
4681 defsubr (&Sline_end_position); |
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
4682 |
305 | 4683 /* defsubr (&Smark); */ |
4684 /* defsubr (&Sset_mark); */ | |
4685 defsubr (&Ssave_excursion); | |
16298
17304eb73f97
(Fsave_current_buffer): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16269
diff
changeset
|
4686 defsubr (&Ssave_current_buffer); |
305 | 4687 |
4688 defsubr (&Sbufsize); | |
4689 defsubr (&Spoint_max); | |
4690 defsubr (&Spoint_min); | |
4691 defsubr (&Spoint_min_marker); | |
4692 defsubr (&Spoint_max_marker); | |
21821
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
4693 defsubr (&Sgap_position); |
9e82920b194d
(Fgap_position, Fgap_size): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
21717
diff
changeset
|
4694 defsubr (&Sgap_size); |
20861
9f9937a74050
(Fformat): Handle a symbol of which name contains
Richard M. Stallman <rms@gnu.org>
parents:
20834
diff
changeset
|
4695 defsubr (&Sposition_bytes); |
22645
e5b201634497
(Fbyte_to_position): New function.
Richard M. Stallman <rms@gnu.org>
parents:
22199
diff
changeset
|
4696 defsubr (&Sbyte_to_position); |
16639
b6ba5d371c1c
(Fline_beginning_position, Fline_end_position): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
16526
diff
changeset
|
4697 |
305 | 4698 defsubr (&Sbobp); |
4699 defsubr (&Seobp); | |
4700 defsubr (&Sbolp); | |
4701 defsubr (&Seolp); | |
512 | 4702 defsubr (&Sfollowing_char); |
4703 defsubr (&Sprevious_char); | |
305 | 4704 defsubr (&Schar_after); |
17031 | 4705 defsubr (&Schar_before); |
305 | 4706 defsubr (&Sinsert); |
4707 defsubr (&Sinsert_before_markers); | |
4714
350231e38e68
(Finsert_and_inherit): New function.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
4708 defsubr (&Sinsert_and_inherit); |
350231e38e68
(Finsert_and_inherit): New function.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
4709 defsubr (&Sinsert_and_inherit_before_markers); |
305 | 4710 defsubr (&Sinsert_char); |
89034
63f566c131d7
(Finsert_byte): New function.
Kenichi Handa <handa@m17n.org>
parents:
89025
diff
changeset
|
4711 defsubr (&Sinsert_byte); |
305 | 4712 |
4713 defsubr (&Suser_login_name); | |
4714 defsubr (&Suser_real_login_name); | |
4715 defsubr (&Suser_uid); | |
4716 defsubr (&Suser_real_uid); | |
4717 defsubr (&Suser_full_name); | |
5373
a70b89d2d6bb
(Femacs_pid): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5242
diff
changeset
|
4718 defsubr (&Semacs_pid); |
448 | 4719 defsubr (&Scurrent_time); |
57987
db8c9a3a77cd
(Fget_internal_run_time): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
57736
diff
changeset
|
4720 defsubr (&Sget_internal_run_time); |
9154
b4739bcefc44
(Fformat_time_string): Mostly rewritten, to handle
Richard M. Stallman <rms@gnu.org>
parents:
8981
diff
changeset
|
4721 defsubr (&Sformat_time_string); |
30480 | 4722 defsubr (&Sfloat_time); |
9801
7003b5184aec
(init_editfns): Get the username from the environment
Richard M. Stallman <rms@gnu.org>
parents:
9657
diff
changeset
|
4723 defsubr (&Sdecode_time); |
11402
66d935214d8e
(Fencode_time): Use XINT to examine `zone'.
Richard M. Stallman <rms@gnu.org>
parents:
11263
diff
changeset
|
4724 defsubr (&Sencode_time); |
305 | 4725 defsubr (&Scurrent_time_string); |
962
3533821d6edc
* editfns.c (Fcurrent_time_zone): Doc fix.
Jim Blandy <jimb@redhat.com>
parents:
690
diff
changeset
|
4726 defsubr (&Scurrent_time_zone); |
13019
5381e2022370
(Fset_time_zone_rule): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13013
diff
changeset
|
4727 defsubr (&Sset_time_zone_rule); |
305 | 4728 defsubr (&Ssystem_name); |
4729 defsubr (&Smessage); | |
8975
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
4730 defsubr (&Smessage_box); |
e8a4c71251cb
(Fmessage_box): Renamed from Fbox_message.
Richard M. Stallman <rms@gnu.org>
parents:
8824
diff
changeset
|
4731 defsubr (&Smessage_or_box); |
18937
ddb91108a9d2
(Fcurrent_message): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18756
diff
changeset
|
4732 defsubr (&Scurrent_message); |
305 | 4733 defsubr (&Sformat); |
4734 | |
4735 defsubr (&Sinsert_buffer_substring); | |
1853
8866e36c0ed5
(Fcompare_buffer_substrings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1748
diff
changeset
|
4736 defsubr (&Scompare_buffer_substrings); |
305 | 4737 defsubr (&Ssubst_char_in_region); |
57644
c0f2bdd90b5d
(Ftranslate_region_internal): New function.
Kenichi Handa <handa@m17n.org>
parents:
57606
diff
changeset
|
4738 defsubr (&Stranslate_region_internal); |
305 | 4739 defsubr (&Sdelete_region); |
26742
936b39bd05b4
* editfns.c (Fdelete_and_extract_region): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
26699
diff
changeset
|
4740 defsubr (&Sdelete_and_extract_region); |
305 | 4741 defsubr (&Swiden); |
4742 defsubr (&Snarrow_to_region); | |
4743 defsubr (&Ssave_restriction); | |
7207
c83b161fe62c
(Ftranspose_regions): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6878
diff
changeset
|
4744 defsubr (&Stranspose_regions); |
305 | 4745 } |
52401 | 4746 |
4747 /* arch-tag: fc3827d8-6f60-4067-b11e-c3218031b018 | |
4748 (do not change this comment) */ |