annotate src/editfns.c @ 4407:4ee73bbe4f8e

Always use boyer_moore in ASCII or Latin-1 buffers with ASCII search strings. 2007-12-26 Aidan Kehoe <kehoea@parhasard.net> * casetab.c: Extend and correct some case table documentation. * search.c (search_buffer): Correct a bug where only the first entry for a character in the case equivalence table was examined in determining if the Boyer-Moore search algorithm is appropriate. If there are case mappings outside of the charset and row of the characters specified in the search string, those case mappings can be safely ignored (and Boyer-Moore search can be used) if we know from the buffer statistics that the corresponding characters cannot occur. * search.c (boyer_moore): Assert that we haven't been passed a string with varying characters sets or rows within character sets. That's what simple_search is for. In the very rare event that a character in the search string has a canonical case mapping that is not in the same character set and row, don't try to search for the canonical character, search for some other character that is in the the desired character set and row. Assert that the case table isn't corrupt. Do not search for any character case mappings that cannot possibly occur in the buffer, given the buffer metadata about its contents.
author Aidan Kehoe <kehoea@parhasard.net>
date Wed, 26 Dec 2007 17:30:16 +0100
parents d9eb5ea14f65
children c661944aa259
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1 /* Lisp functions pertaining to editing.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2 Copyright (C) 1985-1987, 1989, 1992-1995 Free Software Foundation, Inc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3 Copyright (C) 1995 Tinker Systems and INS Engineering Corp.
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
4 Copyright (C) 1996, 2001, 2002, 2004 Ben Wing.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6 This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8 XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9 under the terms of the GNU General Public License as published by the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10 Free Software Foundation; either version 2, or (at your option) any
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11 later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13 XEmacs is distributed in the hope that it will be useful, but WITHOUT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16 for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18 You should have received a copy of the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19 along with XEmacs; see the file COPYING. If not, write to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21 Boston, MA 02111-1307, USA. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23 /* Synched up with: Mule 2.0, FSF 19.30. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
25 /* This file has been Mule-ized, June 2001. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
26
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
27 /* Hacked on for Mule by Ben Wing, December 1994. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
28
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
29 #include <config.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
30 #include "lisp.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
31
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
32 #include "buffer.h"
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
33 #include "casetab.h"
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
34 #include "chartab.h"
877
e54d47b2d736 [xemacs-hg @ 2002-06-23 09:54:35 by stephent]
stephent
parents: 872
diff changeset
35 #include "commands.h" /* for zmacs_region functions */
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
36 #include "device.h"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37 #include "events.h" /* for EVENTP */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38 #include "frame.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39 #include "insdel.h"
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
40 #include "line-number.h"
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
41 #include "process.h"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42 #include "window.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
44 #include "sysdep.h"
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
45 #include "sysdir.h"
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
46 #include "sysfile.h"
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
47 #include "sysproc.h" /* for qxe_getpid() */
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
48 #include "syspwd.h"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49 #include "systime.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51 /* Some static data, and a function to initialize it for each run */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53 Lisp_Object Vsystem_name; /* #### - I don't see why this should be */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54 /* static, either... --Stig */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55 #if 0 /* XEmacs - this is now dynamic */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56 /* if at some point it's deemed desirable to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57 use lisp variables here, then they can be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58 initialized to nil and then set to their
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
59 real values upon the first call to the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60 functions that generate them. --stig */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61 Lisp_Object Vuser_real_login_name; /* login name of current user ID */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62 Lisp_Object Vuser_login_name; /* user name from LOGNAME or USER. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65 /* It's useful to be able to set this as user customization, so we'll
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66 keep it. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67 Lisp_Object Vuser_full_name;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68 EXFUN (Fuser_full_name, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70 Lisp_Object Qformat;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72 Lisp_Object Qpoint, Qmark, Qregion_beginning, Qregion_end;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
74 Lisp_Object Quser_files_and_directories;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76 /* This holds the value of `environ' produced by the previous
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77 call to Fset_time_zone_rule, or 0 if Fset_time_zone_rule
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
78 has never been called. */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
79 static Extbyte **environbuf;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
80
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
81 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
82 init_editfns (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84 /* Only used in removed code below. */
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
85 Ibyte *p;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
87 environbuf = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89 /* Set up system_name even when dumping. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90 init_system_name ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92 if (!initialized)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
95 if ((p = egetenv ("NAME")))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96 /* I don't think it's the right thing to do the ampersand
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97 modification on NAME. Not that it matters anymore... -hniksic */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
98 Vuser_full_name = build_intstring (p);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100 Vuser_full_name = Fuser_full_name (Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
101 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
103 DEFUN ("char-to-string", Fchar_to_string, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
104 Convert CHARACTER to a one-character string containing that character.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
105 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
106 (character))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
108 Bytecount len;
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
109 Ibyte str[MAX_ICHAR_LEN];
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
110
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
111 if (EVENTP (character))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
112 {
2862
b95fe16005fd [xemacs-hg @ 2005-07-17 20:08:40 by aidan]
aidan
parents: 2828
diff changeset
113 Lisp_Object ch2 = Fevent_to_character (character, Qt, Qnil, Qnil);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
114 if (NILP (ch2))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 487
diff changeset
115 invalid_argument
2828
a25c824ed558 [xemacs-hg @ 2005-06-26 18:04:49 by aidan]
aidan
parents: 2421
diff changeset
116 ("key has no character equivalent:", Fcopy_event (character, Qnil));
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
117 character = ch2;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
118 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
120 CHECK_CHAR_COERCE_INT (character);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
121
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
122 len = set_itext_ichar (str, XCHAR (character));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123 return make_string (str, len);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
124 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
125
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
126 DEFUN ("string-to-char", Fstring_to_char, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
127 Convert arg STRING to a character, the first character of that string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
128 An empty string will return the constant `nil'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
129 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
130 (string))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
131 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
132 CHECK_STRING (string);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
133
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
134 if (XSTRING_LENGTH (string) != 0)
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
135 return make_char (string_ichar (string, 0));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
136 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
137 /* This used to return Qzero. That is broken, broken, broken. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
138 /* It might be kinder to signal an error directly. -slb */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
139 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
140 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
141
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
142
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
143 static Lisp_Object
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
144 buildmark (Charbpos val, Lisp_Object buffer)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
145 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
146 Lisp_Object mark = Fmake_marker ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
147 Fset_marker (mark, make_int (val), buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
148 return mark;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
149 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
150
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
151 DEFUN ("point", Fpoint, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
152 Return value of point, as an integer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
153 Beginning of buffer is position (point-min).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
154 If BUFFER is nil, the current buffer is assumed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
156 (buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158 struct buffer *b = decode_buffer (buffer, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
159 return make_int (BUF_PT (b));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
160 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
161
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
162 DEFUN ("point-marker", Fpoint_marker, 0, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
163 Return value of point, as a marker object.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
164 This marker is a copy; you may modify it with reckless abandon.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
165 If optional argument DONT-COPY-P is non-nil, then it returns the real
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
166 point-marker; modifying the position of this marker will move point.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
167 It is illegal to change the buffer of it, or make it point nowhere.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
168 If BUFFER is nil, the current buffer is assumed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
169 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
170 (dont_copy_p, buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
171 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
172 struct buffer *b = decode_buffer (buffer, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
173 if (NILP (dont_copy_p))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
174 return Fcopy_marker (b->point_marker, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
175 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
176 return b->point_marker;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
177 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
178
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
179 /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
180 * Chuck says:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
181 * There is no absolute way to determine if goto-char is the function
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
182 * being run. this-command doesn't work because it is often eval'd
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
183 * and this-command ends up set to eval-expression. So this flag gets
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
184 * added for now.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
185 *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186 * Jamie thinks he's wrong, but we'll leave this in for now.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
187 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
188 int atomic_extent_goto_char_p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
190 DEFUN ("goto-char", Fgoto_char, 1, 2, "NGoto char: ", /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
191 Set point to POSITION, a number or marker.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
192 Beginning of buffer is position (point-min), end is (point-max).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
193 If BUFFER is nil, the current buffer is assumed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194 Return value of POSITION, as an integer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
195 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
196 (position, buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
197 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
198 struct buffer *b = decode_buffer (buffer, 1);
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
199 Charbpos n = get_buffer_pos_char (b, position, GB_COERCE_RANGE);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
200 BUF_SET_PT (b, n);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
201 atomic_extent_goto_char_p = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
202 return make_int (n);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
203 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
204
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
205 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
206 region_limit (int beginningp, struct buffer *b)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
207 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
208 Lisp_Object m;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
209
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
210 #if 0 /* FSFmacs */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
211 if (!NILP (Vtransient_mark_mode) && NILP (Vmark_even_if_inactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
212 && NILP (b->mark_active))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
213 Fsignal (Qmark_inactive, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
214 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
215 m = Fmarker_position (b->mark);
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 487
diff changeset
216 if (NILP (m)) invalid_operation ("There is no region now", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
217 if (!!(BUF_PT (b) < XINT (m)) == !!beginningp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
218 return make_int (BUF_PT (b));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
219 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
220 return m;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
221 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
222
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
223 DEFUN ("region-beginning", Fregion_beginning, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
224 Return position of beginning of region in BUFFER, as an integer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
225 If BUFFER is nil, the current buffer is assumed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
226 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
227 (buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
228 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
229 return region_limit (1, decode_buffer (buffer, 1));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
230 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
231
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
232 DEFUN ("region-end", Fregion_end, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
233 Return position of end of region in BUFFER, as an integer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234 If BUFFER is nil, the current buffer is assumed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
236 (buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
237 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
238 return region_limit (0, decode_buffer (buffer, 1));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
239 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241 /* Whether to use lispm-style active-regions */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
242 int zmacs_regions;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
243
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244 /* Whether the zmacs region is active. This is not per-buffer because
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
245 there can be only one active region at a time. #### Now that the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
246 zmacs region are not directly tied to the X selections this may not
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
247 necessarily have to be true. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248 int zmacs_region_active_p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
250 int zmacs_region_stays;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
251
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
252 Lisp_Object Qzmacs_update_region, Qzmacs_deactivate_region;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253 Lisp_Object Qzmacs_region_buffer;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
255 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
256 zmacs_update_region (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
257 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
258 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
259 if (zmacs_region_active_p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
260 call0 (Qzmacs_update_region);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
261 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
262
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
263 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
264 zmacs_deactivate_region (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
265 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
266 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
267 if (zmacs_region_active_p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
268 call0 (Qzmacs_deactivate_region);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
269 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
270
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
271 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
272 zmacs_region_buffer (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
273 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274 if (zmacs_region_active_p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
275 return call0 (Qzmacs_region_buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
276 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
277 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
278 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
279
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
280 DEFUN ("mark-marker", Fmark_marker, 0, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
281 Return this buffer's mark, as a marker object.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
282 If `zmacs-regions' is true, then this returns nil unless the region is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
283 currently in the active (highlighted) state. If optional argument FORCE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
284 is t, this returns the mark (if there is one) regardless of the zmacs-region
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
285 state. You should *generally* not use the mark unless the region is active,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
286 if the user has expressed a preference for the zmacs-region model.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
287 Watch out! Moving this marker changes the mark position.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
288 If you set the marker not to point anywhere, the buffer will have no mark.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
289 If BUFFER is nil, the current buffer is assumed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
290 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
291 (force, buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
292 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
293 struct buffer *b = decode_buffer (buffer, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
294 if (! zmacs_regions || zmacs_region_active_p || !NILP (force))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
295 return b->mark;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
296 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
297 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
298
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
299
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
300 /* The saved object is a cons:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
301
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
302 (COPY-OF-POINT-MARKER . COPY-OF-MARK)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
303
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
304 We used to have another cons for a VISIBLE-P element, which was t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
305 if `(eq (current-buffer) (window-buffer (selected-window)))' but it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
306 was unused for a long time, so I removed it. --hniksic */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
307 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
308 save_excursion_save (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
310 struct buffer *b;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
312 /* There was once a check for preparing_for_armageddon here, which
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
313 did nothing; perhaps a left-over from FSF Emacs. Obviously
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
314 incorrect. --ben */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
315
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
316 #ifdef ERROR_CHECK_TEXT
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
317 assert (XINT (Fpoint (Qnil)) ==
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
318 XINT (Fmarker_position (Fpoint_marker (Qt, Qnil))));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
319 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
321 b = current_buffer;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
322
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
323 return noseeum_cons (noseeum_copy_marker (b->point_marker, Qnil),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
324 noseeum_copy_marker (b->mark, Qnil));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
325 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
326
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
327 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
328 save_excursion_restore (Lisp_Object info)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
329 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
330 Lisp_Object buffer = Fmarker_buffer (XCAR (info));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
331
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
332 /* If buffer being returned to is now deleted, avoid error --
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
333 otherwise could get error here while unwinding to top level and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
334 crash. In that case, Fmarker_buffer returns nil now. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
335 if (!NILP (buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
336 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
337 struct buffer *buf = XBUFFER (buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
338 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
339 GCPRO1 (info);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
340 set_buffer_internal (buf);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
341 Fgoto_char (XCAR (info), buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
342 Fset_marker (buf->mark, XCDR (info), buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
343
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
344 #if 0 /* We used to make the current buffer visible in the selected window
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
345 if that was true previously. That avoids some anomalies.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
346 But it creates others, and it wasn't documented, and it is simpler
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
347 and cleaner never to alter the window/buffer connections. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
348 /* I'm certain some code somewhere depends on this behavior. --jwz */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349 /* Even if it did, it certainly doesn't matter anymore, because
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
350 this has been the behavior for countless XEmacs releases
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
351 now. --hniksic */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
352 if (visible
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
353 && (current_buffer != XBUFFER (XWINDOW (selected_window)->buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
354 switch_to_buffer (Fcurrent_buffer (), Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
355 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
356
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
357 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
358 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
359
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
360 /* Free all the junk we allocated, so that a `save-excursion' comes
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
361 for free in terms of GC junk. */
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 877
diff changeset
362 free_marker (XCAR (info));
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 877
diff changeset
363 free_marker (XCDR (info));
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
364 free_cons (info);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
366 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
367
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
368 DEFUN ("save-excursion", Fsave_excursion, 0, UNEVALLED, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
369 Save point, mark, and current buffer; execute BODY; restore those things.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
370 Executes BODY just like `progn'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
371 The values of point, mark and the current buffer are restored
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
372 even in case of abnormal exit (throw or error).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
373 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
374 (args))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
375 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
376 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
377 int speccount = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
378
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
379 record_unwind_protect (save_excursion_restore, save_excursion_save ());
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
380
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
381 return unbind_to_1 (speccount, Fprogn (args));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
382 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
383
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
384 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
385 save_current_buffer_restore (Lisp_Object buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
386 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
387 struct buffer *buf = XBUFFER (buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
388 /* Avoid signaling an error if the buffer is no longer alive. This
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
389 is for consistency with save-excursion. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
390 if (BUFFER_LIVE_P (buf))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
391 set_buffer_internal (buf);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
392 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
393 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
394
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
395 DEFUN ("save-current-buffer", Fsave_current_buffer, 0, UNEVALLED, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
396 Save the current buffer; execute BODY; restore the current buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
397 Executes BODY just like `progn'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
398 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
399 (args))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
400 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
401 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
402 int speccount = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
403
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
404 record_unwind_protect (save_current_buffer_restore, Fcurrent_buffer ());
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
405
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
406 return unbind_to_1 (speccount, Fprogn (args));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
407 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
408
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
409 DEFUN ("buffer-size", Fbuffer_size, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410 Return the number of characters in BUFFER.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
411 If BUFFER is nil, the current buffer is assumed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
412 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
413 (buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
414 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
415 struct buffer *b = decode_buffer (buffer, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
416 return make_int (BUF_SIZE (b));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
417 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
418
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
419 DEFUN ("point-min", Fpoint_min, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
420 Return the minimum permissible value of point in BUFFER.
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
421 This is 1, unless narrowing (a buffer restriction)
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
422 is in effect, in which case it may be greater.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
423 If BUFFER is nil, the current buffer is assumed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
424 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
425 (buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
426 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
427 struct buffer *b = decode_buffer (buffer, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
428 return make_int (BUF_BEGV (b));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
429 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
430
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
431 DEFUN ("point-min-marker", Fpoint_min_marker, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
432 Return a marker to the minimum permissible value of point in BUFFER.
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
433 This is the beginning, unless narrowing (a buffer restriction)
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
434 is in effect, in which case it may be greater.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
435 If BUFFER is nil, the current buffer is assumed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
436 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
437 (buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
438 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
439 struct buffer *b = decode_buffer (buffer, 1);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
440 return buildmark (BUF_BEGV (b), wrap_buffer (b));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
441 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
442
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
443 DEFUN ("point-max", Fpoint_max, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
444 Return the maximum permissible value of point in BUFFER.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
445 This is (1+ (buffer-size)), unless narrowing (a buffer restriction)
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
446 is in effect, in which case it may be less.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
447 If BUFFER is nil, the current buffer is assumed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
448 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
449 (buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
450 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
451 struct buffer *b = decode_buffer (buffer, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
452 return make_int (BUF_ZV (b));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
453 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
454
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
455 DEFUN ("point-max-marker", Fpoint_max_marker, 0, 1, 0, /*
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
456 Return a marker to the maximum permissible value of point in BUFFER.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
457 This is (1+ (buffer-size)), unless narrowing (a buffer restriction)
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
458 is in effect, in which case it may be less.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
459 If BUFFER is nil, the current buffer is assumed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
460 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
461 (buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
462 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
463 struct buffer *b = decode_buffer (buffer, 1);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
464 return buildmark (BUF_ZV (b), wrap_buffer (b));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
465 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
466
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
467 DEFUN ("following-char", Ffollowing_char, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
468 Return the character following point.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
469 At the end of the buffer or accessible region, return 0.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
470 If BUFFER is nil, the current buffer is assumed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
471 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
472 (buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
473 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
474 struct buffer *b = decode_buffer (buffer, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
475 if (BUF_PT (b) >= BUF_ZV (b))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
476 return Qzero; /* #### Gag me! */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
477 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
478 return make_char (BUF_FETCH_CHAR (b, BUF_PT (b)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
479 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
480
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
481 DEFUN ("preceding-char", Fpreceding_char, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
482 Return the character preceding point.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
483 At the beginning of the buffer or accessible region, return 0.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
484 If BUFFER is nil, the current buffer is assumed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
485 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
486 (buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
487 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
488 struct buffer *b = decode_buffer (buffer, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
489 if (BUF_PT (b) <= BUF_BEGV (b))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
490 return Qzero; /* #### Gag me! */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
491 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
492 return make_char (BUF_FETCH_CHAR (b, BUF_PT (b) - 1));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
493 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
494
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
495 DEFUN ("bobp", Fbobp, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
496 Return t if point is at the beginning of the buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
497 If the buffer is narrowed, this means the beginning of the narrowed part.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
498 If BUFFER is nil, the current buffer is assumed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
499 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
500 (buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
501 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
502 struct buffer *b = decode_buffer (buffer, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
503 return BUF_PT (b) == BUF_BEGV (b) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
504 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
505
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
506 DEFUN ("eobp", Feobp, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
507 Return t if point is at the end of the buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
508 If the buffer is narrowed, this means the end of the narrowed part.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
509 If BUFFER is nil, the current buffer is assumed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
510 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
511 (buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
512 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
513 struct buffer *b = decode_buffer (buffer, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
514 return BUF_PT (b) == BUF_ZV (b) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
515 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
516
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
517 int
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
518 beginning_of_line_p (struct buffer *b, Charbpos pt)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
519 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
520 return pt <= BUF_BEGV (b) || BUF_FETCH_CHAR (b, pt - 1) == '\n';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
521 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
522
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
523
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
524 DEFUN ("bolp", Fbolp, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
525 Return t if point is at the beginning of a line.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
526 If BUFFER is nil, the current buffer is assumed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
527 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
528 (buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
529 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
530 struct buffer *b = decode_buffer (buffer, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
531 return beginning_of_line_p (b, BUF_PT (b)) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
532 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
533
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
534 DEFUN ("eolp", Feolp, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
535 Return t if point is at the end of a line.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
536 `End of a line' includes point being at the end of the buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
537 If BUFFER is nil, the current buffer is assumed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
538 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
539 (buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
540 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
541 struct buffer *b = decode_buffer (buffer, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
542 return (BUF_PT (b) == BUF_ZV (b) || BUF_FETCH_CHAR (b, BUF_PT (b)) == '\n')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
543 ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
544 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
545
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
546 DEFUN ("char-after", Fchar_after, 0, 2, 0, /*
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
547 Return the character at position POS in BUFFER.
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
548 POS is an integer or a marker.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
549 If POS is out of range, the value is nil.
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
550 if POS is nil, the value of point is assumed.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
551 If BUFFER is nil, the current buffer is assumed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
552 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
553 (pos, buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
554 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
555 struct buffer *b = decode_buffer (buffer, 1);
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
556 Charbpos n = (NILP (pos) ? BUF_PT (b) :
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
557 get_buffer_pos_char (b, pos, GB_NO_ERROR_IF_BAD));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
558
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
559 if (n < 0 || n == BUF_ZV (b))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
560 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
561 return make_char (BUF_FETCH_CHAR (b, n));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
562 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
563
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
564 DEFUN ("char-before", Fchar_before, 0, 2, 0, /*
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
565 Return the character preceding position POS in BUFFER.
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
566 POS is an integer or a marker.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
567 If POS is out of range, the value is nil.
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
568 if POS is nil, the value of point is assumed.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
569 If BUFFER is nil, the current buffer is assumed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
570 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
571 (pos, buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
572 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
573 struct buffer *b = decode_buffer (buffer, 1);
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
574 Charbpos n = (NILP (pos) ? BUF_PT (b) :
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
575 get_buffer_pos_char (b, pos, GB_NO_ERROR_IF_BAD));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
576
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
577 n--;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
578
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
579 if (n < BUF_BEGV (b))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
580 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
581 return make_char (BUF_FETCH_CHAR (b, n));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
582 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
583
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
584
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
585 DEFUN ("temp-directory", Ftemp_directory, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
586 Return the pathname to the directory to use for temporary files.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
587 On MS Windows, this is obtained from the TEMP or TMP environment variables,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
588 defaulting to c:\\ if they are both undefined.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
589 On Unix it is obtained from TMPDIR, with /tmp as the default.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
590 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
591 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
592 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
593 Ibyte *tmpdir;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
594 #if defined(WIN32_NATIVE)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
595 tmpdir = egetenv ("TEMP");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
596 if (!tmpdir)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
597 tmpdir = egetenv ("TMP");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
598 if (!tmpdir)
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
599 tmpdir = (Ibyte *) "c:\\";
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
600 #else /* WIN32_NATIVE */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
601 tmpdir = egetenv ("TMPDIR");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
602 if (!tmpdir)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
603 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
604 struct stat st;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
605 int myuid = getuid ();
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
606 Ibyte *login_name = user_login_name (NULL);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
607 DECLARE_EISTRING (eipath);
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
608 Ibyte *path;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
609
2421
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben]
ben
parents: 2367
diff changeset
610 eicpy_ascii (eipath, "/tmp/");
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
611 eicat_rawz (eipath, login_name);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
612 path = eidata (eipath);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
613 if (qxe_lstat (path, &st) < 0 && errno == ENOENT)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
614 qxe_mkdir (path, 0700); /* ignore retval -- checked next anyway. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
615 if (qxe_lstat (path, &st) == 0 && (int) st.st_uid == myuid
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
616 && S_ISDIR (st.st_mode))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
617 tmpdir = path;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
618 else
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
619 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
620 eicpy_rawz (eipath, egetenv ("HOME"));
2421
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben]
ben
parents: 2367
diff changeset
621 eicat_ascii (eipath, "/tmp/");
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
622 path = eidata (eipath);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
623 if (qxe_stat (path, &st) < 0 && errno == ENOENT)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
624 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
625 int fd;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
626 DECLARE_EISTRING (eiwarnpath);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
627
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
628 qxe_mkdir (path, 0700); /* ignore retvals */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
629 eicpy_ei (eiwarnpath, eipath);
2421
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben]
ben
parents: 2367
diff changeset
630 eicat_ascii (eiwarnpath, ".created_by_xemacs");
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
631 if ((fd = qxe_open (eidata (eiwarnpath),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
632 O_WRONLY | O_CREAT, 0644)) > 0)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
633 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
634 retry_write (fd, "XEmacs created this directory because "
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
635 "/tmp/<yourname> was unavailable -- \n"
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
636 "Please check !\n", 89);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
637 retry_close (fd);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
638 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
639 }
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
640 if (qxe_stat (path, &st) == 0 && S_ISDIR (st.st_mode))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
641 tmpdir = path;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
642 else
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
643 tmpdir = (Ibyte *) "/tmp";
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
644 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
645 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
646 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
647
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
648 return build_intstring (tmpdir);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
649 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
650
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
651 DEFUN ("user-login-name", Fuser_login_name, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
652 Return the name under which the user logged in, as a string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
653 This is based on the effective uid, not the real uid.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
654 Also, if the environment variable LOGNAME or USER is set,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
655 that determines the value of this function.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
656 If the optional argument UID is present, then environment variables are
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
657 ignored and this function returns the login name for that UID, or nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
658 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
659 (uid))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
660 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
661 Ibyte *returned_name;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
662 uid_t local_uid;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
663
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
664 if (!NILP (uid))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
665 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
666 CHECK_INT (uid);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
667 local_uid = XINT (uid);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
668 returned_name = user_login_name (&local_uid);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
669 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
670 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
671 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
672 returned_name = user_login_name (NULL);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
673 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
674 /* #### - I believe this should return nil instead of "unknown" when pw==0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
675 pw=0 is indicated by a null return from user_login_name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
676 */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
677 return returned_name ? build_intstring (returned_name) : Qnil;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
678 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
679
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
680 /* This function may be called from other C routines when a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
681 character string representation of the user_login_name is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
682 needed but a Lisp Object is not. The UID is passed by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
683 reference. If UID == NULL, then the USER name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
684 for the user running XEmacs will be returned. This
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
685 corresponds to a nil argument to Fuser_login_name.
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
686
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
687 WARNING: The string returned comes from the data of a Lisp string and
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
688 therefore will become garbage after the next GC.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
689 */
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
690 Ibyte *
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
691 user_login_name (uid_t *uid)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
692 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
693 /* uid == NULL to return name of this user */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
694 if (uid != NULL)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
695 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
696 struct passwd *pw = qxe_getpwuid (*uid);
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
697 return pw ? (Ibyte *) pw->pw_name : NULL;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
698 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
699 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
700 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
701 /* #### - when euid != uid, then LOGNAME and USER are leftovers from the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
702 old environment (I site observed behavior on sunos and linux), so the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
703 environment variables should be disregarded in that case. --Stig */
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
704 Ibyte *user_name = egetenv ("LOGNAME");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
705 if (!user_name)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
706 user_name = egetenv (
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
707 #ifdef WIN32_NATIVE
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
708 "USERNAME" /* it's USERNAME on NT */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
709 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
710 "USER"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
711 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
712 );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
713 if (user_name)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
714 return user_name;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
715 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
716 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
717 struct passwd *pw = qxe_getpwuid (geteuid ());
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
718 #ifdef CYGWIN
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
719 /* Since the Cygwin environment may not have an /etc/passwd,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
720 return "unknown" instead of the null if the username
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
721 cannot be determined.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
722 */
593
5fd7ba8b56e7 [xemacs-hg @ 2001-05-31 12:45:27 by ben]
ben
parents: 563
diff changeset
723 /* !!#### fix up in my mule ws */
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
724 return (Ibyte *) (pw ? pw->pw_name : "unknown");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
725 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
726 /* For all but Cygwin return NULL (nil) */
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 877
diff changeset
727 return pw ? (Ibyte *) pw->pw_name : NULL;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
728 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
729 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
730 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
731 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
732
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
733 DEFUN ("user-real-login-name", Fuser_real_login_name, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
734 Return the name of the user's real uid, as a string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
735 This ignores the environment variables LOGNAME and USER, so it differs from
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
736 `user-login-name' when running under `su'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
737 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
738 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
739 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
740 struct passwd *pw = qxe_getpwuid (getuid ());
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
741 /* #### - I believe this should return nil instead of "unknown" when pw==0 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
742
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
743 return build_string (pw ? pw->pw_name : "unknown");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
744 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
745
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
746 DEFUN ("user-uid", Fuser_uid, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
747 Return the effective uid of Emacs, as an integer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
748 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
749 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
750 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
751 return make_int (geteuid ());
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
752 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
753
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
754 DEFUN ("user-real-uid", Fuser_real_uid, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
755 Return the real uid of Emacs, as an integer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
756 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
757 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
758 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
759 return make_int (getuid ());
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
760 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
761
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
762 DEFUN ("user-full-name", Fuser_full_name, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
763 Return the full name of the user logged in, as a string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
764 If the optional argument USER is given, then the full name for that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
765 user is returned, or nil. USER may be either a login name or a uid.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
766
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
767 If USER is nil, and `user-full-name' contains a string, the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
768 value of `user-full-name' is returned.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
769 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
770 (user))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
771 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
772 Lisp_Object user_name;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
773 struct passwd *pw = NULL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
774 Lisp_Object tem;
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
775 const Ibyte *p, *q;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
776
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
777 if (NILP (user) && STRINGP (Vuser_full_name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
778 return Vuser_full_name;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
779
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
780 user_name = (STRINGP (user) ? user : Fuser_login_name (user));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
781 if (!NILP (user_name)) /* nil when nonexistent UID passed as arg */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
782 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
783 /* Fuck me. getpwnam() can call select() and (under IRIX at least)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
784 things get wedged if a SIGIO arrives during this time. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
785 slow_down_interrupts ();
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
786 pw = qxe_getpwnam (XSTRING_DATA (user_name));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
787 speed_up_interrupts ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
788 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
789
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
790 /* #### - Stig sez: this should return nil instead of "unknown" when pw==0 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
791 /* Ben sez: bad idea because it's likely to break something */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
792 #ifndef AMPERSAND_FULL_NAME
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
793 p = (Ibyte *) (pw ? USER_FULL_NAME : "unknown"); /* don't gettext */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
794 q = qxestrchr (p, ',');
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
795 #else
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
796 p = (Ibyte *) (pw ? USER_FULL_NAME : "unknown"); /* don't gettext */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
797 q = qxestrchr (p, ',');
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
798 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
799 tem = ((!NILP (user) && !pw)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
800 ? Qnil
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 800
diff changeset
801 : make_string (p, (q ? (Bytecount) (q - p) : qxestrlen (p))));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
802
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
803 #ifdef AMPERSAND_FULL_NAME
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
804 if (!NILP (tem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
805 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
806 p = XSTRING_DATA (tem);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
807 q = qxestrchr (p, '&');
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
808 /* Substitute the login name for the &, upcasing the first character. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
809 if (q)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
810 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
811 DECLARE_EISTRING (r);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
812 eicpy_raw (r, p, q - p);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
813 eicat_lstr (r, user_name);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
814 eisetch (r, q - p, UPCASE (0, eigetch (r, q - p)));
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
815 eicat_rawz (r, q + 1);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
816 tem = eimake_string (r);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
817 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
818 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
819 #endif /* AMPERSAND_FULL_NAME */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
820
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
821 return tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
822 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
823
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
824 static Ibyte *cached_home_directory;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
825
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
826 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
827 uncache_home_directory (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
828 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
829 if (cached_home_directory)
1726
a8d8f419b459 [xemacs-hg @ 2003-09-30 15:26:34 by james]
james
parents: 1330
diff changeset
830 xfree (cached_home_directory, Ibyte *);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
831 cached_home_directory = NULL;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
832 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
833
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
834 /* Returns the home directory */
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
835 Ibyte *
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
836 get_home_directory (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
837 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
838 int output_home_warning = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
839
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
840 if (cached_home_directory == NULL)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
841 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
842 cached_home_directory = egetenv ("HOME");
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
843 if (cached_home_directory)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
844 cached_home_directory = qxestrdup (cached_home_directory);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
845 else
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
846 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
847 #if defined (WIN32_NATIVE)
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
848 Ibyte *homedrive, *homepath;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
849
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
850 if ((homedrive = egetenv ("HOMEDRIVE")) != NULL &&
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
851 (homepath = egetenv ("HOMEPATH")) != NULL)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
852 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
853 cached_home_directory =
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
854 xnew_ibytes (qxestrlen (homedrive) + qxestrlen (homepath) +
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
855 ITEXT_ZTERM_SIZE);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
856 qxesprintf (cached_home_directory, "%s%s",
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
857 homedrive,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
858 homepath);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
859 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
860 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
861 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
862 cached_home_directory = qxestrdup ((Ibyte *) "C:\\");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
863 output_home_warning = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
864 }
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
865 #else /* !WIN32_NATIVE */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
866 /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
867 * Unix, typically.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
868 * Using "/" isn't quite right, but what should we do?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
869 * We probably should try to extract pw_dir from /etc/passwd,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
870 * before falling back to this.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
871 */
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
872 cached_home_directory = qxestrdup ((Ibyte *) "/");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
873 output_home_warning = 1;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
874 #endif /* !WIN32_NATIVE */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
875 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
876 if (initialized && output_home_warning)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
877 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
878 warn_when_safe (Quser_files_and_directories, Qwarning, "\n"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
879 " XEmacs was unable to determine a good value for the user's $HOME\n"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
880 " directory, and will be using the value:\n"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
881 " %s\n"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
882 " This is probably incorrect.",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
883 cached_home_directory
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
884 );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
885 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
886 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
887 return cached_home_directory;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
888 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
889
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
890 DEFUN ("user-home-directory", Fuser_home_directory, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
891 Return the user's home directory, as a string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
892 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
893 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
894 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
895 Ibyte *path = get_home_directory ();
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
896
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
897 return !path ? Qnil :
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
898 Fexpand_file_name (Fsubstitute_in_file_name (build_intstring (path)),
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
899 Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
900 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
901
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
902 DEFUN ("system-name", Fsystem_name, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
903 Return the name of the machine you are running on, as a string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
904 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
905 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
906 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
907 return Fcopy_sequence (Vsystem_name);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
908 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
909
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
910 DEFUN ("emacs-pid", Femacs_pid, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
911 Return the process ID of Emacs, as an integer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
912 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
913 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
914 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
915 return make_int (qxe_getpid ());
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
916 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
917
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
918 DEFUN ("current-time", Fcurrent_time, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
919 Return the current time, as the number of seconds since 1970-01-01 00:00:00.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
920 The time is returned as a list of three integers. The first has the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
921 most significant 16 bits of the seconds, while the second has the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
922 least significant 16 bits. The third integer gives the microsecond
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
923 count.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
924
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
925 The microsecond count is zero on systems that do not provide
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
926 resolution finer than a second.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
927 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
928 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
929 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
930 EMACS_TIME t;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
931
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
932 EMACS_GET_TIME (t);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
933 return list3 (make_int ((EMACS_SECS (t) >> 16) & 0xffff),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
934 make_int ((EMACS_SECS (t) >> 0) & 0xffff),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
935 make_int (EMACS_USECS (t)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
936 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
937
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
938 DEFUN ("current-process-time", Fcurrent_process_time, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
939 Return the amount of time used by this XEmacs process so far.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
940 The return value is a list of three floating-point numbers, expressing
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
941 the user, system, and real times used by the process. The user time
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
942 measures the time actually spent by the CPU executing the code in this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
943 process. The system time measures time spent by the CPU executing kernel
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
944 code on behalf of this process (e.g. I/O requests made by the process).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
945
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
946 Note that the user and system times measure processor time, as opposed
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
947 to real time, and only accrue when the processor is actually doing
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
948 something: Time spent in an idle wait (waiting for user events to come
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
949 in or for I/O on a disk drive or other device to complete) does not
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
950 count. Thus, the user and system times will often be considerably
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
951 less than the real time.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
952
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
953 Some systems do not allow the user and system times to be distinguished.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
954 In this case, the user time will be the total processor time used by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
955 the process, and the system time will be 0.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
956
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
957 Some systems do not allow the real and processor times to be distinguished.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
958 In this case, the user and real times will be the same and the system
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
959 time will be 0.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
960 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
961 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
962 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
963 double user, sys, real;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
964
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
965 get_process_times (&user, &sys, &real);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
966 return list3 (make_float (user), make_float (sys), make_float (real));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
967 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
968
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
969
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
970 int lisp_to_time (Lisp_Object specified_time, time_t *result);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
971 int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
972 lisp_to_time (Lisp_Object specified_time, time_t *result)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
973 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
974 Lisp_Object high, low;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
975
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
976 if (NILP (specified_time))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
977 return time (result) != -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
978
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
979 CHECK_CONS (specified_time);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
980 high = XCAR (specified_time);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
981 low = XCDR (specified_time);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
982 if (CONSP (low))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
983 low = XCAR (low);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
984 CHECK_INT (high);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
985 CHECK_INT (low);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
986 *result = (XINT (high) << 16) + (XINT (low) & 0xffff);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
987 return *result >> 16 == XINT (high);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
988 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
989
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
990 Lisp_Object time_to_lisp (time_t the_time);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
991 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
992 time_to_lisp (time_t the_time)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
993 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
994 unsigned int item = (unsigned int) the_time;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
995 return Fcons (make_int (item >> 16), make_int (item & 0xffff));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
996 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
997
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
998 size_t emacs_strftime (Extbyte *string, size_t max, const Extbyte *format,
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
999 const struct tm *tm);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1000 static long difftm (const struct tm *a, const struct tm *b);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1001
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1002
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1003 DEFUN ("format-time-string", Fformat_time_string, 1, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1004 Use FORMAT-STRING to format the time TIME.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1005 TIME is specified as (HIGH LOW . IGNORED) or (HIGH . LOW), as from
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1006 `current-time' and `file-attributes'. If TIME is not specified it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1007 defaults to the current time.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1008 FORMAT-STRING may contain %-sequences to substitute parts of the time.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1009 %a is replaced by the abbreviated name of the day of week.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1010 %A is replaced by the full name of the day of week.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1011 %b is replaced by the abbreviated name of the month.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1012 %B is replaced by the full name of the month.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1013 %c is a synonym for "%x %X".
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1014 %C is a locale-specific synonym, which defaults to "%A, %B %e, %Y" in the C locale.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1015 %d is replaced by the day of month, zero-padded.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1016 %D is a synonym for "%m/%d/%y".
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1017 %e is replaced by the day of month, blank-padded.
4203
0a63e5de7bdc [xemacs-hg @ 2007-10-02 19:31:30 by aidan]
aidan
parents: 2862
diff changeset
1018 %G is replaced by the year containing the ISO 8601 week
0a63e5de7bdc [xemacs-hg @ 2007-10-02 19:31:30 by aidan]
aidan
parents: 2862
diff changeset
1019 %g is replaced by the year of the ISO 8601 week within the century (00-99)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1020 %h is a synonym for "%b".
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1021 %H is replaced by the hour (00-23).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1022 %I is replaced by the hour (00-12).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1023 %j is replaced by the day of the year (001-366).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1024 %k is replaced by the hour (0-23), blank padded.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1025 %l is replaced by the hour (1-12), blank padded.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1026 %m is replaced by the month (01-12).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1027 %M is replaced by the minute (00-59).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1028 %n is a synonym for "\\n".
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1029 %p is replaced by AM or PM, as appropriate.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1030 %r is a synonym for "%I:%M:%S %p".
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1031 %R is a synonym for "%H:%M".
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1032 %s is replaced by the time in seconds since 00:00:00, Jan 1, 1970 (a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1033 nonstandard extension)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1034 %S is replaced by the second (00-60).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1035 %t is a synonym for "\\t".
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1036 %T is a synonym for "%H:%M:%S".
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1037 %U is replaced by the week of the year (00-53), first day of week is Sunday.
4203
0a63e5de7bdc [xemacs-hg @ 2007-10-02 19:31:30 by aidan]
aidan
parents: 2862
diff changeset
1038 %V is replaced by the ISO 8601 week number
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1039 %w is replaced by the day of week (0-6), Sunday is day 0.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1040 %W is replaced by the week of the year (00-53), first day of week is Monday.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1041 %x is a locale-specific synonym, which defaults to "%D" in the C locale.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1042 %X is a locale-specific synonym, which defaults to "%T" in the C locale.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1043 %y is replaced by the year without century (00-99).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1044 %Y is replaced by the year with century.
4203
0a63e5de7bdc [xemacs-hg @ 2007-10-02 19:31:30 by aidan]
aidan
parents: 2862
diff changeset
1045 %z is replaced by the time zone as a numeric offset (e.g +0530, -0800 etc.)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1046 %Z is replaced by the time zone abbreviation.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1047
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1048 The number of options reflects the `strftime' function.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1049
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1050 BUG: If the charset used by the current locale is not ISO 8859-1, the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1051 characters appearing in the day and month names may be incorrect.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1052 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1053 (format_string, time_))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1054 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1055 time_t value;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
1056 Bytecount size;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1057
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1058 CHECK_STRING (format_string);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1059
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1060 if (! lisp_to_time (time_, &value))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 487
diff changeset
1061 invalid_argument ("Invalid time specification", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1062
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1063 /* This is probably enough. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1064 size = XSTRING_LENGTH (format_string) * 6 + 50;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1065
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1066 while (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1067 {
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1068 Extbyte *buf = alloca_extbytes (size);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1069 Extbyte *formext;
4203
0a63e5de7bdc [xemacs-hg @ 2007-10-02 19:31:30 by aidan]
aidan
parents: 2862
diff changeset
1070 /* make a copy of the static buffer returned by localtime() */
0a63e5de7bdc [xemacs-hg @ 2007-10-02 19:31:30 by aidan]
aidan
parents: 2862
diff changeset
1071 struct tm tm = * localtime(&value);
0a63e5de7bdc [xemacs-hg @ 2007-10-02 19:31:30 by aidan]
aidan
parents: 2862
diff changeset
1072
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1073 *buf = 1;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1074
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1075 /* !!#### this use of external here is not totally safe, and
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1076 potentially data lossy. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1077 LISP_STRING_TO_EXTERNAL (format_string, formext, Qnative);
4203
0a63e5de7bdc [xemacs-hg @ 2007-10-02 19:31:30 by aidan]
aidan
parents: 2862
diff changeset
1078 if (emacs_strftime (buf, size, formext, &tm)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1079 || !*buf)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1080 return build_ext_string (buf, Qnative);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1081 /* If buffer was too small, make it bigger. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1082 size *= 2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1083 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1084 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1085
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1086 DEFUN ("decode-time", Fdecode_time, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1087 Decode a time value as (SEC MINUTE HOUR DAY MONTH YEAR DOW DST ZONE).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1088 The optional SPECIFIED-TIME should be a list of (HIGH LOW . IGNORED)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1089 or (HIGH . LOW), as from `current-time' and `file-attributes', or `nil'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1090 to use the current time. The list has the following nine members:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1091 SEC is an integer between 0 and 60; SEC is 60 for a leap second, which
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1092 only some operating systems support. MINUTE is an integer between 0 and 59.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1093 HOUR is an integer between 0 and 23. DAY is an integer between 1 and 31.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1094 MONTH is an integer between 1 and 12. YEAR is an integer indicating the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1095 four-digit year. DOW is the day of week, an integer between 0 and 6, where
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1096 0 is Sunday. DST is t if daylight savings time is effect, otherwise nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1097 ZONE is an integer indicating the number of seconds east of Greenwich.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1098 \(Note that Common Lisp has different meanings for DOW and ZONE.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1099 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1100 (specified_time))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1101 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1102 time_t time_spec;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1103 struct tm save_tm;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1104 struct tm *decoded_time;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1105 Lisp_Object list_args[9];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1106
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1107 if (! lisp_to_time (specified_time, &time_spec))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 487
diff changeset
1108 invalid_argument ("Invalid time specification", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1109
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1110 decoded_time = localtime (&time_spec);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1111 list_args[0] = make_int (decoded_time->tm_sec);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1112 list_args[1] = make_int (decoded_time->tm_min);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1113 list_args[2] = make_int (decoded_time->tm_hour);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1114 list_args[3] = make_int (decoded_time->tm_mday);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1115 list_args[4] = make_int (decoded_time->tm_mon + 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1116 list_args[5] = make_int (decoded_time->tm_year + 1900);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1117 list_args[6] = make_int (decoded_time->tm_wday);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1118 list_args[7] = (decoded_time->tm_isdst)? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1119
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1120 /* Make a copy, in case gmtime modifies the struct. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1121 save_tm = *decoded_time;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1122 decoded_time = gmtime (&time_spec);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1123 if (decoded_time == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1124 list_args[8] = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1125 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1126 list_args[8] = make_int (difftm (&save_tm, decoded_time));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1127 return Flist (9, list_args);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1128 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1129
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1130 static void set_time_zone_rule (Extbyte *tzstring);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1131
707
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 665
diff changeset
1132 /* from GNU Emacs 21, per Simon Josefsson, modified by stephen
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 665
diff changeset
1133 The slight inefficiency is justified since negative times are weird. */
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 665
diff changeset
1134 Lisp_Object
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1135 make_time (time_t tiempo)
707
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 665
diff changeset
1136 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1137 return list2 (make_int (tiempo < 0 ? tiempo / 0x10000 : tiempo >> 16),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1138 make_int (tiempo & 0xFFFF));
707
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 665
diff changeset
1139 }
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 665
diff changeset
1140
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1141 DEFUN ("encode-time", Fencode_time, 6, MANY, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1142 Convert SECOND, MINUTE, HOUR, DAY, MONTH, YEAR and ZONE to internal time.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1143 This is the reverse operation of `decode-time', which see.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1144 ZONE defaults to the current time zone rule. This can
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1145 be a string (as from `set-time-zone-rule'), or it can be a list
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1146 \(as from `current-time-zone') or an integer (as from `decode-time')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1147 applied without consideration for daylight savings time.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1148
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1149 You can pass more than 7 arguments; then the first six arguments
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1150 are used as SECOND through YEAR, and the *last* argument is used as ZONE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1151 The intervening arguments are ignored.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1152 This feature lets (apply 'encode-time (decode-time ...)) work.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1153
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1154 Out-of-range values for SEC, MINUTE, HOUR, DAY, or MONTH are allowed;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1155 for example, a DAY of 0 means the day preceding the given month.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1156 Year numbers less than 100 are treated just like other year numbers.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1157 If you want them to stand for years in this century, you must do that yourself.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1158 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1159 (int nargs, Lisp_Object *args))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1160 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1161 time_t the_time;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1162 struct tm tm;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1163 Lisp_Object zone = (nargs > 6) ? args[nargs - 1] : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1164
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1165 CHECK_INT (*args); tm.tm_sec = XINT (*args++); /* second */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1166 CHECK_INT (*args); tm.tm_min = XINT (*args++); /* minute */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1167 CHECK_INT (*args); tm.tm_hour = XINT (*args++); /* hour */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1168 CHECK_INT (*args); tm.tm_mday = XINT (*args++); /* day */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1169 CHECK_INT (*args); tm.tm_mon = XINT (*args++) - 1; /* month */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1170 CHECK_INT (*args); tm.tm_year = XINT (*args++) - 1900;/* year */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1171
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1172 tm.tm_isdst = -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1173
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1174 if (CONSP (zone))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1175 zone = XCAR (zone);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1176 if (NILP (zone))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1177 the_time = mktime (&tm);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1178 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1179 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1180 /* #### This business of modifying environ is horrendous!
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1181 Why don't we just putenv()? Why don't we implement our own
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1182 funs that don't require this futzing? */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1183 Extbyte tzbuf[100];
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1184 Extbyte *tzstring;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1185 Extbyte **oldenv = environ, **newenv;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1186
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1187 if (STRINGP (zone))
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1188 LISP_STRING_TO_EXTERNAL (zone, tzstring, Qnative);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1189 else if (INTP (zone))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1190 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1191 int abszone = abs (XINT (zone));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1192 sprintf (tzbuf, "XXX%s%d:%02d:%02d", "-" + (XINT (zone) < 0),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1193 abszone / (60*60), (abszone/60) % 60, abszone % 60);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1194 tzstring = tzbuf;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1195 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1196 else
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1197 invalid_argument ("Invalid time zone specification", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1198
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1199 /* Set TZ before calling mktime; merely adjusting mktime's returned
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1200 value doesn't suffice, since that would mishandle leap seconds. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1201 set_time_zone_rule (tzstring);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1202
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1203 the_time = mktime (&tm);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1204
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1205 /* Restore TZ to previous value. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1206 newenv = environ;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1207 environ = oldenv;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1208 free (newenv);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1209 #ifdef LOCALTIME_CACHE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1210 tzset ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1211 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1212 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1213
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1214 if (the_time == (time_t) -1)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 487
diff changeset
1215 invalid_argument ("Specified time is not representable", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1216
707
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 665
diff changeset
1217 return make_time (the_time);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1218 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1219
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1220 DEFUN ("current-time-string", Fcurrent_time_string, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1221 Return the current time, as a human-readable string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1222 Programs can use this function to decode a time,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1223 since the number of columns in each field is fixed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1224 The format is `Sun Sep 16 01:03:52 1973'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1225 If an argument is given, it specifies a time to format
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1226 instead of the current time. The argument should have the form:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1227 (HIGH . LOW)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1228 or the form:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1229 (HIGH LOW . IGNORED).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1230 Thus, you can use times obtained from `current-time'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1231 and from `file-attributes'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1232 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1233 (specified_time))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1234 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1235 time_t value;
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1236 Ibyte *the_ctime;
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 593
diff changeset
1237 EMACS_INT len; /* this is what make_ext_string() accepts; ####
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
1238 should it be an Bytecount? */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1239
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1240 if (! lisp_to_time (specified_time, &value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1241 value = -1;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1242 the_ctime = qxe_ctime (&value);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1243
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1244 /* ctime is documented as always returning a "\n\0"-terminated
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1245 26-byte American time string, but let's be careful anyways. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1246 for (len = 0; the_ctime[len] != '\n' && the_ctime[len] != '\0'; len++)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1247 ;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1248
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1249 return make_string (the_ctime, len);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1250 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1251
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1252 #define TM_YEAR_ORIGIN 1900
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1253
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1254 /* Yield A - B, measured in seconds. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1255 static long
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1256 difftm (const struct tm *a, const struct tm *b)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1257 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1258 int ay = a->tm_year + (TM_YEAR_ORIGIN - 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1259 int by = b->tm_year + (TM_YEAR_ORIGIN - 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1260 /* Some compilers can't handle this as a single return statement. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1261 long days = (
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1262 /* difference in day of year */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1263 a->tm_yday - b->tm_yday
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1264 /* + intervening leap days */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1265 + ((ay >> 2) - (by >> 2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1266 - (ay/100 - by/100)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1267 + ((ay/100 >> 2) - (by/100 >> 2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1268 /* + difference in years * 365 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1269 + (long)(ay-by) * 365
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1270 );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1271 return (60*(60*(24*days + (a->tm_hour - b->tm_hour))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1272 + (a->tm_min - b->tm_min))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1273 + (a->tm_sec - b->tm_sec));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1274 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1275
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1276 DEFUN ("current-time-zone", Fcurrent_time_zone, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1277 Return the offset and name for the local time zone.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1278 This returns a list of the form (OFFSET NAME).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1279 OFFSET is an integer number of seconds ahead of UTC (east of Greenwich).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1280 A negative value means west of Greenwich.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1281 NAME is a string giving the name of the time zone.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1282 If an argument is given, it specifies when the time zone offset is determined
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1283 instead of using the current time. The argument should have the form:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1284 (HIGH . LOW)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1285 or the form:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1286 (HIGH LOW . IGNORED).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1287 Thus, you can use times obtained from `current-time'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1288 and from `file-attributes'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1289
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1290 Some operating systems cannot provide all this information to Emacs;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1291 in this case, `current-time-zone' returns a list containing nil for
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1292 the data it can't find.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1293 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1294 (specified_time))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1295 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1296 time_t value;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1297 struct tm *t = NULL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1298
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1299 if (lisp_to_time (specified_time, &value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1300 && (t = gmtime (&value)) != 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1301 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1302 struct tm gmt = *t; /* Make a copy, in case localtime modifies *t. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1303 long offset;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1304 Extbyte *s;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1305 Lisp_Object tem;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1306
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1307 t = localtime (&value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1308 offset = difftm (t, &gmt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1309 s = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1310 #ifdef HAVE_TM_ZONE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1311 if (t->tm_zone)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1312 s = (Extbyte *) t->tm_zone;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1313 #else /* not HAVE_TM_ZONE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1314 #ifdef HAVE_TZNAME
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1315 if (t->tm_isdst == 0 || t->tm_isdst == 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1316 s = tzname[t->tm_isdst];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1317 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1318 #endif /* not HAVE_TM_ZONE */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1319 if (s)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1320 tem = build_ext_string (s, Qnative);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1321 else
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1322 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1323 Ibyte buf[6];
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1324
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1325 /* No local time zone name is available; use "+-NNNN" instead. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1326 int am = (offset < 0 ? -offset : offset) / 60;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1327 qxesprintf (buf, "%c%02d%02d", (offset < 0 ? '-' : '+'), am/60,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1328 am%60);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1329 tem = build_intstring (buf);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1330 }
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1331 return list2 (make_int (offset), tem);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1332 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1333 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1334 return list2 (Qnil, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1335 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1336
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1337 #ifdef LOCALTIME_CACHE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1338
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1339 /* These two values are known to load tz files in buggy implementations,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1340 i.e. Solaris 1 executables running under either Solaris 1 or Solaris 2.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1341 Their values shouldn't matter in non-buggy implementations.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1342 We don't use string literals for these strings,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1343 since if a string in the environment is in readonly
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1344 storage, it runs afoul of bugs in SVR4 and Solaris 2.3.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1345 See Sun bugs 1113095 and 1114114, ``Timezone routines
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1346 improperly modify environment''. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1347
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1348 static Ascbyte set_time_zone_rule_tz1[] = "TZ=GMT+0";
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1349 static Ascbyte set_time_zone_rule_tz2[] = "TZ=GMT+1";
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1350
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1351 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1352
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1353 /* Set the local time zone rule to TZSTRING.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1354 This allocates memory into `environ', which it is the caller's
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1355 responsibility to free. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1356 static void
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1357 set_time_zone_rule (Extbyte *tzstring)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1358 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1359 int envptrs;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1360 Extbyte **from, **to, **newenv;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1361
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1362 for (from = environ; *from; from++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1363 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1364 envptrs = from - environ + 2;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1365 newenv = to = (Extbyte **) xmalloc (envptrs * sizeof (Extbyte *)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1366 + (tzstring ? strlen (tzstring) + 4 : 0));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1367 if (tzstring)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1368 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1369 Extbyte *t = (Extbyte *) (to + envptrs);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1370 strcpy (t, "TZ=");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1371 strcat (t, tzstring);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1372 *to++ = t;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1373 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1374
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1375 for (from = environ; *from; from++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1376 if (strncmp (*from, "TZ=", 3) != 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1377 *to++ = *from;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1378 *to = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1379
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1380 environ = newenv;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1381
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1382 #ifdef LOCALTIME_CACHE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1383 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1384 /* In SunOS 4.1.3_U1 and 4.1.4, if TZ has a value like
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1385 "US/Pacific" that loads a tz file, then changes to a value like
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1386 "XXX0" that does not load a tz file, and then changes back to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1387 its original value, the last change is (incorrectly) ignored.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1388 Also, if TZ changes twice in succession to values that do
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1389 not load a tz file, tzset can dump core (see Sun bug#1225179).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1390 The following code works around these bugs. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1391
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1392 if (tzstring)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1393 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1394 /* Temporarily set TZ to a value that loads a tz file
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1395 and that differs from tzstring. */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1396 Extbyte *tz = *newenv;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1397 *newenv = (strcmp (tzstring, set_time_zone_rule_tz1 + 3) == 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1398 ? set_time_zone_rule_tz2 : set_time_zone_rule_tz1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1399 tzset ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1400 *newenv = tz;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1401 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1402 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1403 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1404 /* The implied tzstring is unknown, so temporarily set TZ to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1405 two different values that each load a tz file. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1406 *to = set_time_zone_rule_tz1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1407 to[1] = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1408 tzset ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1409 *to = set_time_zone_rule_tz2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1410 tzset ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1411 *to = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1412 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1413
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1414 /* Now TZ has the desired value, and tzset can be invoked safely. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1415 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1416
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1417 tzset ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1418 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1419 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1420
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1421 DEFUN ("set-time-zone-rule", Fset_time_zone_rule, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1422 Set the local time zone using TZ, a string specifying a time zone rule.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1423 If TZ is nil, use implementation-defined default time zone information.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1424 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1425 (tz))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1426 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1427 Extbyte *tzstring;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1429 if (NILP (tz))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1430 tzstring = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1431 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1432 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1433 CHECK_STRING (tz);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1434 LISP_STRING_TO_EXTERNAL (tz, tzstring, Qnative);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1435 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1436
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1437 set_time_zone_rule (tzstring);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1438 if (environbuf)
1726
a8d8f419b459 [xemacs-hg @ 2003-09-30 15:26:34 by james]
james
parents: 1330
diff changeset
1439 xfree (environbuf, Extbyte **);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1440 environbuf = environ;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1441
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1442 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1443 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1444
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1445
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1446 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1447 buffer_insert1 (struct buffer *buf, Lisp_Object arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1448 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1449 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1450 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1451 GCPRO1 (arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1452 retry:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1453 if (CHAR_OR_CHAR_INTP (arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1454 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1455 buffer_insert_emacs_char (buf, XCHAR_OR_CHAR_INT (arg));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1456 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1457 else if (STRINGP (arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1458 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1459 buffer_insert_lisp_string (buf, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1460 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1461 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1462 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1463 arg = wrong_type_argument (Qchar_or_string_p, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1464 goto retry;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1465 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1466 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1467 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1468
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1469
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1470 /* Callers passing one argument to Finsert need not gcpro the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1471 argument "array", since the only element of the array will
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1472 not be used after calling insert_emacs_char or insert_lisp_string,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1473 so we don't care if it gets trashed. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1474
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1475 DEFUN ("insert", Finsert, 0, MANY, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1476 Insert the arguments, either strings or characters, at point.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1477 Point moves forward so that it ends up after the inserted text.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1478 Any other markers at the point of insertion remain before the text.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1479 If a string has non-null string-extent-data, new extents will be created.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1480 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1481 (int nargs, Lisp_Object *args))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1482 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1483 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1484 REGISTER int argnum;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1485
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1486 for (argnum = 0; argnum < nargs; argnum++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1487 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1488 buffer_insert1 (current_buffer, args[argnum]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1489 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1490
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1491 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1492 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1493
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1494 DEFUN ("insert-before-markers", Finsert_before_markers, 0, MANY, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1495 Insert strings or characters at point, relocating markers after the text.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1496 Point moves forward so that it ends up after the inserted text.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1497 Any other markers at the point of insertion also end up after the text.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1498 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1499 (int nargs, Lisp_Object *args))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1500 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1501 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1502 REGISTER int argnum;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1503 REGISTER Lisp_Object tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1504
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1505 for (argnum = 0; argnum < nargs; argnum++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1506 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1507 tem = args[argnum];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1508 retry:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1509 if (CHAR_OR_CHAR_INTP (tem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1510 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1511 buffer_insert_emacs_char_1 (current_buffer, -1,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1512 XCHAR_OR_CHAR_INT (tem),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1513 INSDEL_BEFORE_MARKERS);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1514 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1515 else if (STRINGP (tem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1516 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1517 buffer_insert_lisp_string_1 (current_buffer, -1, tem,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1518 INSDEL_BEFORE_MARKERS);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1519 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1520 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1521 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1522 tem = wrong_type_argument (Qchar_or_string_p, tem);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1523 goto retry;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1524 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1525 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1526 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1527 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1528
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1529 DEFUN ("insert-string", Finsert_string, 1, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1530 Insert STRING into BUFFER at BUFFER's point.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1531 Point moves forward so that it ends up after the inserted text.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1532 Any other markers at the point of insertion remain before the text.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1533 If a string has non-null string-extent-data, new extents will be created.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1534 BUFFER defaults to the current buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1535 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1536 (string, buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1537 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1538 struct buffer *b = decode_buffer (buffer, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1539 CHECK_STRING (string);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1540 buffer_insert_lisp_string (b, string);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1541 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1542 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1543
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1544 /* Third argument in FSF is INHERIT:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1545
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1546 "The optional third arg INHERIT, if non-nil, says to inherit text properties
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1547 from adjoining text, if those properties are sticky."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1548
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1549 Jamie thinks this is bogus. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1550
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1551
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1552 DEFUN ("insert-char", Finsert_char, 1, 4, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1553 Insert COUNT copies of CHARACTER into BUFFER.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1554 Point and all markers are affected as in the function `insert'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1555 COUNT defaults to 1 if omitted.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1556 The optional third arg IGNORED is INHERIT under FSF Emacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1557 This is highly bogus, however, and XEmacs always behaves as if
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1558 `t' were passed to INHERIT.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1559 The optional fourth arg BUFFER specifies the buffer to insert the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1560 text into. If BUFFER is nil, the current buffer is assumed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1561 */
2286
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 1726
diff changeset
1562 (character, count, UNUSED (ignored), buffer))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1563 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1564 /* This function can GC */
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1565 REGISTER Ibyte *string;
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 800
diff changeset
1566 REGISTER Bytecount slen;
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 800
diff changeset
1567 REGISTER Bytecount i, j;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1568 REGISTER Bytecount n;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1569 REGISTER Bytecount charlen;
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1570 Ibyte str[MAX_ICHAR_LEN];
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1571 struct buffer *b = decode_buffer (buffer, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1572 int cou;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1573
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1574 CHECK_CHAR_COERCE_INT (character);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1575 if (NILP (count))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1576 cou = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1577 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1578 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1579 CHECK_INT (count);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1580 cou = XINT (count);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1581 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1582
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1583 charlen = set_itext_ichar (str, XCHAR (character));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1584 n = cou * charlen;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1585 if (n <= 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1586 return Qnil;
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 800
diff changeset
1587 slen = min (n, (Bytecount) 768);
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1588 string = alloca_ibytes (slen);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1589 /* Write as many copies of the character into the temp string as will fit. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1590 for (i = 0; i + charlen <= slen; i += charlen)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1591 for (j = 0; j < charlen; j++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1592 string[i + j] = str[j];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1593 slen = i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1594 while (n >= slen)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1595 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1596 buffer_insert_raw_string (b, string, slen);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1597 n -= slen;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1598 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1599 if (n > 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1600 #if 0 /* FSFmacs bogosity */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1601 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1602 if (!NILP (inherit))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1603 insert_and_inherit (string, n);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1604 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1605 insert (string, n);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1606 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1607 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1608 buffer_insert_raw_string (b, string, n);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1609 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1610
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1611 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1612 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1613
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1614
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1615 /* Making strings from buffer contents. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1616
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1617 DEFUN ("buffer-substring", Fbuffer_substring, 0, 3, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1618 Return the contents of part of BUFFER as a string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1619 The two arguments START and END are character positions;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1620 they can be in either order. If omitted, they default to the beginning
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1621 and end of BUFFER, respectively.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1622 If there are duplicable extents in the region, the string remembers
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1623 them in its extent data.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1624 If BUFFER is nil, the current buffer is assumed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1625 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1626 (start, end, buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1627 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1628 /* This function can GC */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
1629 Charbpos begv, zv;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1630 struct buffer *b = decode_buffer (buffer, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1631
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1632 get_buffer_range_char (b, start, end, &begv, &zv, GB_ALLOW_NIL);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1633 return make_string_from_buffer (b, begv, zv - begv);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1634 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1635
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1636 /* It might make more sense to name this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1637 `buffer-substring-no-extents', but this name is FSFmacs-compatible,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1638 and what the function does is probably good enough for what the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1639 user-code will typically want to use it for. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1640 DEFUN ("buffer-substring-no-properties", Fbuffer_substring_no_properties, 0, 3, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1641 Return the text from START to END as a string, without copying the extents.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1642 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1643 (start, end, buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1644 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1645 /* This function can GC */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
1646 Charbpos begv, zv;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1647 struct buffer *b = decode_buffer (buffer, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1648
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1649 get_buffer_range_char (b, start, end, &begv, &zv, GB_ALLOW_NIL);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1650 return make_string_from_buffer_no_extents (b, begv, zv - begv);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1651 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1652
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1653 DEFUN ("insert-buffer-substring", Finsert_buffer_substring, 1, 3, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1654 Insert before point a substring of the contents of buffer BUFFER.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1655 BUFFER may be a buffer or a buffer name.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1656 Arguments START and END are character numbers specifying the substring.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1657 They default to the beginning and the end of BUFFER.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1658 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1659 (buffer, start, end))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1660 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1661 /* This function can GC */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
1662 Charbpos b, e;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1663 struct buffer *bp;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1664
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1665 bp = XBUFFER (get_buffer (buffer, 1));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1666 get_buffer_range_char (bp, start, end, &b, &e, GB_ALLOW_NIL);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1667
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1668 if (b < e)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1669 buffer_insert_from_buffer (current_buffer, bp, b, e - b);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1670
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1671 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1672 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1673
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1674 DEFUN ("compare-buffer-substrings", Fcompare_buffer_substrings, 6, 6, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1675 Compare two substrings of two buffers; return result as number.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1676 the value is -N if first string is less after N-1 chars,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1677 +N if first string is greater after N-1 chars, or 0 if strings match.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1678 Each substring is represented as three arguments: BUFFER, START and END.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1679 That makes six args in all, three for each substring.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1680
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1681 The value of `case-fold-search' in the current buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1682 determines whether case is significant or ignored.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1683 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1684 (buffer1, start1, end1, buffer2, start2, end2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1685 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
1686 Charbpos begp1, endp1, begp2, endp2;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1687 REGISTER Charcount len1, len2, length, i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1688 struct buffer *bp1, *bp2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1689 Lisp_Object trt = ((!NILP (current_buffer->case_fold_search)) ?
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1690 XCASE_TABLE_CANON (current_buffer->case_table) : Qnil);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1691
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1692 /* Find the first buffer and its substring. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1693
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1694 bp1 = decode_buffer (buffer1, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1695 get_buffer_range_char (bp1, start1, end1, &begp1, &endp1, GB_ALLOW_NIL);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1696
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1697 /* Likewise for second substring. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1698
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1699 bp2 = decode_buffer (buffer2, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1700 get_buffer_range_char (bp2, start2, end2, &begp2, &endp2, GB_ALLOW_NIL);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1701
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1702 len1 = endp1 - begp1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1703 len2 = endp2 - begp2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1704 length = len1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1705 if (len2 < length)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1706 length = len2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1707
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1708 for (i = 0; i < length; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1709 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1710 Ichar c1 = BUF_FETCH_CHAR (bp1, begp1 + i);
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1711 Ichar c2 = BUF_FETCH_CHAR (bp2, begp2 + i);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1712 if (!NILP (trt))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1713 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1714 c1 = TRT_TABLE_OF (trt, c1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1715 c2 = TRT_TABLE_OF (trt, c2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1716 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1717 if (c1 < c2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1718 return make_int (- 1 - i);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1719 if (c1 > c2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1720 return make_int (i + 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1721 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1722
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1723 /* The strings match as far as they go.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1724 If one is shorter, that one is less. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1725 if (length < len1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1726 return make_int (length + 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1727 else if (length < len2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1728 return make_int (- length - 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1729
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1730 /* Same length too => they are equal. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1731 return Qzero;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1732 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1733
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1734
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1735 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1736 subst_char_in_region_unwind (Lisp_Object arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1737 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1738 XBUFFER (XCAR (arg))->undo_list = XCDR (arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1739 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1740 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1741
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1742 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1743 subst_char_in_region_unwind_1 (Lisp_Object arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1744 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1745 XBUFFER (XCAR (arg))->filename = XCDR (arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1746 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1747 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1748
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1749 DEFUN ("subst-char-in-region", Fsubst_char_in_region, 4, 5, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1750 From START to END, replace FROMCHAR with TOCHAR each time it occurs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1751 If optional arg NOUNDO is non-nil, don't record this change for undo
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1752 and don't mark the buffer as really changed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1753 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1754 (start, end, fromchar, tochar, noundo))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1755 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1756 /* This function can GC */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
1757 Charbpos pos, stop;
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1758 Ichar fromc, toc;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1759 int mc_count;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1760 struct buffer *buf = current_buffer;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1761 int count = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1762
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1763 get_buffer_range_char (buf, start, end, &pos, &stop, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1764 CHECK_CHAR_COERCE_INT (fromchar);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1765 CHECK_CHAR_COERCE_INT (tochar);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1766
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1767 fromc = XCHAR (fromchar);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1768 toc = XCHAR (tochar);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1769
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1770 /* If we don't want undo, turn off putting stuff on the list.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1771 That's faster than getting rid of things,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1772 and it prevents even the entry for a first change.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1773 Also inhibit locking the file. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1774 if (!NILP (noundo))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1775 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1776 record_unwind_protect (subst_char_in_region_unwind,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1777 Fcons (Fcurrent_buffer (), buf->undo_list));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1778 buf->undo_list = Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1779 /* Don't do file-locking. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1780 record_unwind_protect (subst_char_in_region_unwind_1,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1781 Fcons (Fcurrent_buffer (), buf->filename));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1782 buf->filename = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1783 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1784
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1785 mc_count = begin_multiple_change (buf, pos, stop);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1786 while (pos < stop)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1787 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1788 if (BUF_FETCH_CHAR (buf, pos) == fromc)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1789 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1790 /* There used to be some code here that set the buffer to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1791 unmodified if NOUNDO was specified and there was only
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1792 one change to the buffer since it was last saved.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1793 This is a crock of shit, so I'm not duplicating this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1794 behavior. I think this was left over from when
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1795 prepare_to_modify_buffer() actually bumped MODIFF,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1796 so that code was supposed to undo this change. --ben */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1797 buffer_replace_char (buf, pos, toc, !NILP (noundo), 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1798
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1799 /* If noundo is not nil then we don't mark the buffer as
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1800 modified. In reality that needs to happen externally
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1801 only. Internally redisplay needs to know that the actual
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1802 contents it should be displaying have changed. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1803 if (!NILP (noundo))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1804 Fset_buffer_modified_p (Fbuffer_modified_p (Qnil), Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1805 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1806 pos++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1807 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1808 end_multiple_change (buf, mc_count);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1809
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1810 unbind_to (count);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1811 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1812 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1813
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1814 /* #### Shouldn't this also accept a BUFFER argument, in the good old
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1815 XEmacs tradition? */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1816 DEFUN ("translate-region", Ftranslate_region, 3, 3, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1817 Translate characters from START to END according to TABLE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1818
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1819 If TABLE is a string, the Nth character in it is the mapping for the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1820 character with code N.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1821
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1822 If TABLE is a vector, its Nth element is the mapping for character
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1823 with code N. The values of elements may be characters, strings, or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1824 nil (nil meaning don't replace.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1825
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1826 If TABLE is a char-table, its elements describe the mapping between
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1827 characters and their replacements. The char-table should be of type
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1828 `char' or `generic'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1829
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1830 Returns the number of substitutions performed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1831 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1832 (start, end, table))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1833 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1834 /* This function can GC */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
1835 Charbpos pos, stop; /* Limits of the region. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1836 int cnt = 0; /* Number of changes made. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1837 int mc_count;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1838 struct buffer *buf = current_buffer;
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1839 Ichar oc;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1840
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1841 get_buffer_range_char (buf, start, end, &pos, &stop, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1842 mc_count = begin_multiple_change (buf, pos, stop);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1843 if (STRINGP (table))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1844 {
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
1845 Charcount size = string_char_length (table);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1846 #ifdef MULE
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1847 /* Under Mule, string_ichar(n) is O(n), so for large tables or
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1848 large regions it makes sense to create an array of Ichars. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1849 if (size * (stop - pos) > 65536)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1850 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1851 Ichar *etable = alloca_array (Ichar, size);
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1852 convert_ibyte_string_into_ichar_string
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
1853 (XSTRING_DATA (table), XSTRING_LENGTH (table), etable);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1854 for (; pos < stop && (oc = BUF_FETCH_CHAR (buf, pos), 1); pos++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1855 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1856 if (oc < size)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1857 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1858 Ichar nc = etable[oc];
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1859 if (nc != oc)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1860 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1861 buffer_replace_char (buf, pos, nc, 0, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1862 ++cnt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1863 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1864 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1865 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1866 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1867 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1868 #endif /* MULE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1869 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1870 for (; pos < stop && (oc = BUF_FETCH_CHAR (buf, pos), 1); pos++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1871 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1872 if (oc < size)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1873 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1874 Ichar nc = string_ichar (table, oc);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1875 if (nc != oc)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1876 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1877 buffer_replace_char (buf, pos, nc, 0, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1878 ++cnt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1879 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1880 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1881 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1882 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1883 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1884 else if (VECTORP (table))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1885 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1886 Charcount size = XVECTOR_LENGTH (table);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1887 Lisp_Object *vtable = XVECTOR_DATA (table);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1888
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1889 for (; pos < stop && (oc = BUF_FETCH_CHAR (buf, pos), 1); pos++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1890 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1891 if (oc < size)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1892 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1893 Lisp_Object replacement = vtable[oc];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1894 retry:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1895 if (CHAR_OR_CHAR_INTP (replacement))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1896 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1897 Ichar nc = XCHAR_OR_CHAR_INT (replacement);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1898 if (nc != oc)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1899 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1900 buffer_replace_char (buf, pos, nc, 0, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1901 ++cnt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1902 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1903 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1904 else if (STRINGP (replacement))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1905 {
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
1906 Charcount incr = string_char_length (replacement) - 1;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1907 buffer_delete_range (buf, pos, pos + 1, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1908 buffer_insert_lisp_string_1 (buf, pos, replacement, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1909 pos += incr, stop += incr;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1910 ++cnt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1911 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1912 else if (!NILP (replacement))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1913 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1914 replacement = wrong_type_argument (Qchar_or_string_p, replacement);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1915 goto retry;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1916 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1917 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1918 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1919 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1920 else if (CHAR_TABLEP (table)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1921 && (XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_GENERIC
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1922 || XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_CHAR))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1923 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1924
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1925 for (; pos < stop && (oc = BUF_FETCH_CHAR (buf, pos), 1); pos++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1926 {
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
1927 Lisp_Object replacement = get_char_table (oc, table);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1928 retry2:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1929 if (CHAR_OR_CHAR_INTP (replacement))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1930 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1931 Ichar nc = XCHAR_OR_CHAR_INT (replacement);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1932 if (nc != oc)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1933 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1934 buffer_replace_char (buf, pos, nc, 0, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1935 ++cnt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1936 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1937 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1938 else if (STRINGP (replacement))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1939 {
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
1940 Charcount incr = string_char_length (replacement) - 1;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1941 buffer_delete_range (buf, pos, pos + 1, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1942 buffer_insert_lisp_string_1 (buf, pos, replacement, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1943 pos += incr, stop += incr;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1944 ++cnt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1945 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1946 else if (!NILP (replacement))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1947 {
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
1948 replacement = wrong_type_argument (Qchar_or_string_p,
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
1949 replacement);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1950 goto retry2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1951 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1952 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1953 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1954 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1955 dead_wrong_type_argument (Qstringp, table);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1956 end_multiple_change (buf, mc_count);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1957
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1958 return make_int (cnt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1959 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1960
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1961 DEFUN ("delete-region", Fdelete_region, 2, 3, "r", /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1962 Delete the text between point and mark.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1963 When called from a program, expects two arguments START and END
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1964 \(integers or markers) specifying the stretch to be deleted.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1965 If optional third arg BUFFER is nil, the current buffer is assumed.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1966 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1967 (start, end, buffer))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1968 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1969 /* This function can GC */
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
1970 Charbpos char_start, char_end;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1971 struct buffer *buf = decode_buffer (buffer, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1972
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
1973 get_buffer_range_char (buf, start, end, &char_start, &char_end, 0);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
1974 buffer_delete_range (buf, char_start, char_end, 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1975 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1976 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1977
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1978 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1979 widen_buffer (struct buffer *b, int no_clip)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1980 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1981 if (BUF_BEGV (b) != BUF_BEG (b))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1982 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1983 clip_changed = 1;
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
1984 SET_BOTH_BUF_BEGV (b, BUF_BEG (b), BYTE_BUF_BEG (b));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1985 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1986 if (BUF_ZV (b) != BUF_Z (b))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1987 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1988 clip_changed = 1;
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
1989 SET_BOTH_BUF_ZV (b, BUF_Z (b), BYTE_BUF_Z (b));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1990 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1991 if (clip_changed)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1992 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1993 if (!no_clip)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1994 MARK_CLIP_CHANGED;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1995 /* Changing the buffer bounds invalidates any recorded current
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1996 column. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1997 invalidate_current_column ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1998 narrow_line_number_cache (b);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1999 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2000 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2001
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2002 DEFUN ("widen", Fwiden, 0, 1, "", /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2003 Remove restrictions (narrowing) from BUFFER.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2004 This allows the buffer's full text to be seen and edited.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2005 If BUFFER is nil, the current buffer is assumed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2006 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2007 (buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2008 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2009 struct buffer *b = decode_buffer (buffer, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2010 widen_buffer (b, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2011 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2012 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2013
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2014 DEFUN ("narrow-to-region", Fnarrow_to_region, 2, 3, "r", /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2015 Restrict editing in BUFFER to the current region.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2016 The rest of the text becomes temporarily invisible and untouchable
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2017 but is not deleted; if you save the buffer in a file, the invisible
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2018 text is included in the file. \\[widen] makes all visible again.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2019 If BUFFER is nil, the current buffer is assumed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2020 See also `save-restriction'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2021
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2022 When calling from a program, pass two arguments; positions (integers
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2023 or markers) bounding the text that should remain visible.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2024 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2025 (start, end, buffer))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2026 {
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
2027 Charbpos char_start, char_end;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2028 struct buffer *buf = decode_buffer (buffer, 1);
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
2029 Bytebpos byte_start, byte_end;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2030
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
2031 get_buffer_range_char (buf, start, end, &char_start, &char_end,
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2032 GB_ALLOW_PAST_ACCESSIBLE);
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
2033 byte_start = charbpos_to_bytebpos (buf, char_start);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
2034 byte_end = charbpos_to_bytebpos (buf, char_end);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2035
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
2036 SET_BOTH_BUF_BEGV (buf, char_start, byte_start);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
2037 SET_BOTH_BUF_ZV (buf, char_end, byte_end);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
2038 if (BUF_PT (buf) < char_start)
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
2039 BUF_SET_PT (buf, char_start);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
2040 if (BUF_PT (buf) > char_end)
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
2041 BUF_SET_PT (buf, char_end);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2042 MARK_CLIP_CHANGED;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2043 /* Changing the buffer bounds invalidates any recorded current column. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2044 invalidate_current_column ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2045 narrow_line_number_cache (buf);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2046 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2047 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2048
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2049 Lisp_Object
844
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
2050 save_restriction_save (struct buffer *buf)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2051 {
844
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
2052 Lisp_Object bottom = noseeum_make_marker ();
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
2053 Lisp_Object top = noseeum_make_marker ();
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
2054
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
2055 /* Formerly, this function remembered the amount of text on either side
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
2056 of the restricted area, in a halfway attempt to account for insertion --
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
2057 it handles insertion inside the old restricted area, but not outside.
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
2058 The comment read:
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
2059
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
2060 [[ Note: I tried using markers here, but it does not win
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2061 because insertion at the end of the saved region
844
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
2062 does not advance mh and is considered "outside" the saved region. ]]
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
2063
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
2064 But that was clearly before the advent of marker-insertion-type. --ben */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2065
844
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
2066 Fset_marker (bottom, make_int (BUF_BEGV (buf)), wrap_buffer (buf));
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
2067 Fset_marker (top, make_int (BUF_ZV (buf)), wrap_buffer (buf));
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
2068 Fset_marker_insertion_type (top, Qt);
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
2069
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
2070 return noseeum_cons (wrap_buffer (buf), noseeum_cons (bottom, top));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2071 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2072
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2073 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2074 save_restriction_restore (Lisp_Object data)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2075 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2076 struct buffer *buf;
844
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
2077 Lisp_Object markers = XCDR (data);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2078 int local_clip_changed = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2079
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2080 buf = XBUFFER (XCAR (data));
844
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
2081 /* someone could have killed the buffer in the meantime ... */
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
2082 if (BUFFER_LIVE_P (buf))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2083 {
844
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
2084 Charbpos start = marker_position (XCAR (markers));
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
2085 Charbpos end = marker_position (XCDR (markers));
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
2086 Bytebpos byte_start = charbpos_to_bytebpos (buf, start);
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
2087 Bytebpos byte_end = charbpos_to_bytebpos (buf, end);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2088
844
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
2089 if (BUF_BEGV (buf) != start)
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
2090 {
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
2091 local_clip_changed = 1;
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
2092 SET_BOTH_BUF_BEGV (buf, start, byte_start);
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
2093 narrow_line_number_cache (buf);
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
2094 }
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
2095 if (BUF_ZV (buf) != end)
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
2096 {
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
2097 local_clip_changed = 1;
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
2098 SET_BOTH_BUF_ZV (buf, end, byte_end);
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
2099 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2100
844
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
2101 if (local_clip_changed)
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
2102 MARK_CLIP_CHANGED;
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
2103
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
2104 /* If point is outside the new visible range, move it inside. */
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
2105 BUF_SET_PT (buf, charbpos_clip_to_bounds (BUF_BEGV (buf), BUF_PT (buf),
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
2106 BUF_ZV (buf)));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2107 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2108
844
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
2109 /* Free all the junk we allocated, so that a `save-restriction' comes
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
2110 for free in terms of GC junk. */
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 877
diff changeset
2111 free_marker (XCAR (markers));
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 877
diff changeset
2112 free_marker (XCDR (markers));
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
2113 free_cons (markers);
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
2114 free_cons (data);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2115
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2116 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2117 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2118
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2119 DEFUN ("save-restriction", Fsave_restriction, 0, UNEVALLED, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2120 Execute BODY, saving and restoring current buffer's restrictions.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2121 The buffer's restrictions make parts of the beginning and end invisible.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2122 \(They are set up with `narrow-to-region' and eliminated with `widen'.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2123 This special form, `save-restriction', saves the current buffer's restrictions
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2124 when it is entered, and restores them when it is exited.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2125 So any `narrow-to-region' within BODY lasts only until the end of the form.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2126 The old restrictions settings are restored
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2127 even in case of abnormal exit (throw or error).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2128
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2129 The value returned is the value of the last form in BODY.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2130
844
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
2131 As of XEmacs 22.0, `save-restriction' correctly handles all modifications
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
2132 made within BODY. (Formerly, it got confused if, within the BODY, you
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
2133 widened and then made changes outside the old restricted area.)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2134
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2135 Note: if you are using both `save-excursion' and `save-restriction',
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2136 use `save-excursion' outermost:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2137 (save-excursion (save-restriction ...))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2138 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2139 (body))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2140 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2141 /* This function can GC */
844
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
2142 int speccount =
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
2143 record_unwind_protect (save_restriction_restore,
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
2144 save_restriction_save (current_buffer));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2145
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2146 return unbind_to_1 (speccount, Fprogn (body));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2147 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2148
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2149
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2150 DEFUN ("format", Fformat, 1, MANY, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2151 Format a string out of a control-string and arguments.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2152 The first argument is a control string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2153 The other arguments are substituted into it to make the result, a string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2154 It may contain %-sequences meaning to substitute the next argument.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2155 %s means print all objects as-is, using `princ'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2156 %S means print all objects as s-expressions, using `prin1'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2157 %d or %i means print as an integer in decimal (%o octal, %x lowercase hex,
4329
d9eb5ea14f65 Provide %b in #'format; use it for converting between ints and bit vectors.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4266
diff changeset
2158 %X uppercase hex, %b binary).
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2159 %c means print as a single character.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2160 %f means print as a floating-point number in fixed notation (e.g. 785.200).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2161 %e or %E means print as a floating-point number in scientific notation
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2162 (e.g. 7.85200e+03).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2163 %g or %G means print as a floating-point number in "pretty format";
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2164 depending on the number, either %f or %e/%E format will be used, and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2165 trailing zeroes are removed from the fractional part.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2166 The argument used for all but %s and %S must be a number. It will be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2167 converted to an integer or a floating-point number as necessary.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2168
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2169 %$ means reposition to read a specific numbered argument; for example,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2170 %3$s would apply the `%s' to the third argument after the control string,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2171 and the next format directive would use the fourth argument, the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2172 following one the fifth argument, etc. (There must be a positive integer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2173 between the % and the $).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2174 Zero or more of the flag characters `-', `+', ` ', `0', and `#' may be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2175 specified between the optional repositioning spec and the conversion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2176 character; see below.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2177 An optional minimum field width may be specified after any flag characters
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2178 and before the conversion character; it specifies the minimum number of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2179 characters that the converted argument will take up. Padding will be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2180 added on the left (or on the right, if the `-' flag is specified), as
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2181 necessary. Padding is done with spaces, or with zeroes if the `0' flag
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2182 is specified.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2183 If the field width is specified as `*', the field width is assumed to have
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2184 been specified as an argument. Any repositioning specification that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2185 would normally specify the argument to be converted will now specify
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2186 where to find this field width argument, not where to find the argument
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2187 to be converted. If there is no repositioning specification, the normal
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2188 next argument is used. The argument to be converted will be the next
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2189 argument after the field width argument unless the precision is also
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2190 specified as `*' (see below).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2191
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2192 An optional period character and precision may be specified after any
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2193 minimum field width. It specifies the minimum number of digits to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2194 appear in %d, %i, %o, %x, and %X conversions (the number is padded
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2195 on the left with zeroes as necessary); the number of digits printed
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2196 after the decimal point for %f, %e, and %E conversions; the number
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2197 of significant digits printed in %g and %G conversions; and the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2198 maximum number of non-padding characters printed in %s and %S
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2199 conversions. The default precision for floating-point conversions
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2200 is six.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2201 If the precision is specified as `*', the precision is assumed to have been
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2202 specified as an argument. The argument used will be the next argument
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2203 after the field width argument, if any. If the field width was not
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2204 specified as an argument, any repositioning specification that would
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2205 normally specify the argument to be converted will now specify where to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2206 find the precision argument. If there is no repositioning specification,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2207 the normal next argument is used.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2208
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2209 The ` ' and `+' flags mean prefix non-negative numbers with a space or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2210 plus sign, respectively.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2211 The `#' flag means print numbers in an alternate, more verbose format:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2212 octal numbers begin with zero; hex numbers begin with a 0x or 0X;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2213 a decimal point is printed in %f, %e, and %E conversions even if no
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2214 numbers are printed after it; and trailing zeroes are not omitted in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2215 %g and %G conversions.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2216
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2217 Use %% to put a single % into the output.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2218 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2219 (int nargs, Lisp_Object *args))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2220 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2221 /* It should not be necessary to GCPRO ARGS, because
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2222 the caller in the interpreter should take care of that. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2223
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2224 CHECK_STRING (args[0]);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2225 return emacs_vsprintf_string_lisp (0, args[0], nargs - 1, args + 1);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2226 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2227
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2228
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2229 DEFUN ("char-equal", Fchar_equal, 2, 3, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2230 Return t if two characters match, optionally ignoring case.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2231 Both arguments must be characters (i.e. NOT integers).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2232 Case is ignored if `case-fold-search' is non-nil in BUFFER.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2233 If BUFFER is nil, the current buffer is assumed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2234 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2235 (character1, character2, buffer))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2236 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
2237 Ichar x1, x2;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2238 struct buffer *b = decode_buffer (buffer, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2239
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2240 CHECK_CHAR_COERCE_INT (character1);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2241 CHECK_CHAR_COERCE_INT (character2);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2242 x1 = XCHAR (character1);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2243 x2 = XCHAR (character2);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2244
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2245 return (!NILP (b->case_fold_search)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2246 ? DOWNCASE (b, x1) == DOWNCASE (b, x2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2247 : x1 == x2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2248 ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2249 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2250
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2251 DEFUN ("char=", Fchar_Equal, 2, 2, 0, /*
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2252 Return t if two characters match, case is significant.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2253 Both arguments must be characters (i.e. NOT integers).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2254 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2255 (character1, character2))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2256 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2257 CHECK_CHAR_COERCE_INT (character1);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2258 CHECK_CHAR_COERCE_INT (character2);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2259
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2260 return EQ (character1, character2) ? Qt : Qnil;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2261 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2262
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2263 #if 0 /* Undebugged FSFmacs code */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2264 /* Transpose the markers in two regions of the current buffer, and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2265 adjust the ones between them if necessary (i.e.: if the regions
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2266 differ in size).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2267
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2268 Traverses the entire marker list of the buffer to do so, adding an
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2269 appropriate amount to some, subtracting from some, and leaving the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2270 rest untouched. Most of this is copied from adjust_markers in insdel.c.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2271
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2272 It's the caller's job to see that (start1 <= end1 <= start2 <= end2). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2273
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2274 void
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
2275 transpose_markers (Charbpos start1, Charbpos end1, Charbpos start2, Charbpos end2)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2276 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2277 Charcount amt1, amt2, diff;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2278 Lisp_Object marker;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2279 struct buffer *buf = current_buffer;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2280
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2281 /* Update point as if it were a marker. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2282 if (BUF_PT (buf) < start1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2283 ;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2284 else if (BUF_PT (buf) < end1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2285 BUF_SET_PT (buf, BUF_PT (buf) + (end2 - end1));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2286 else if (BUF_PT (buf) < start2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2287 BUF_SET_PT (buf, BUF_PT (buf) + (end2 - start2) - (end1 - start1));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2288 else if (BUF_PT (buf) < end2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2289 BUF_SET_PT (buf, BUF_PT (buf) - (start2 - start1));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2290
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2291 /* We used to adjust the endpoints here to account for the gap, but that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2292 isn't good enough. Even if we assume the caller has tried to move the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2293 gap out of our way, it might still be at start1 exactly, for example;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2294 and that places it `inside' the interval, for our purposes. The amount
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2295 of adjustment is nontrivial if there's a `denormalized' marker whose
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2296 position is between GPT and GPT + GAP_SIZE, so it's simpler to leave
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2297 the dirty work to Fmarker_position, below. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2298
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2299 /* The difference between the region's lengths */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2300 diff = (end2 - start2) - (end1 - start1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2301
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2302 /* For shifting each marker in a region by the length of the other
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2303 * region plus the distance between the regions.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2304 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2305 amt1 = (end2 - start2) + (start2 - end1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2306 amt2 = (end1 - start1) + (start2 - end1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2307
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2308 for (marker = BUF_MARKERS (buf); !NILP (marker);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2309 marker = XMARKER (marker)->chain)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2310 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
2311 Charbpos mpos = marker_position (marker);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2312 if (mpos >= start1 && mpos < end2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2313 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2314 if (mpos < end1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2315 mpos += amt1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2316 else if (mpos < start2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2317 mpos += diff;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2318 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2319 mpos -= amt2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2320 set_marker_position (marker, mpos);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2321 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2322 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2323 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2324
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2325 #endif /* 0 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2326
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2327 DEFUN ("transpose-regions", Ftranspose_regions, 4, 5, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2328 Transpose region START1 to END1 with START2 to END2.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2329 The regions may not be overlapping, because the size of the buffer is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2330 never changed in a transposition.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2331
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2332 Optional fifth arg LEAVE-MARKERS, if non-nil, means don't transpose
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2333 any markers that happen to be located in the regions. (#### BUG: currently
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2334 this function always acts as if LEAVE-MARKERS is non-nil.)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2335
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2336 Transposing beyond buffer boundaries is an error.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2337 */
2286
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 1726
diff changeset
2338 (start1, end1, start2, end2, UNUSED (leave_markers)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2339 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
2340 Charbpos startr1, endr1, startr2, endr2;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2341 Charcount len1, len2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2342 Lisp_Object string1, string2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2343 struct buffer *buf = current_buffer;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2344
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2345 get_buffer_range_char (buf, start1, end1, &startr1, &endr1, 0);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2346 get_buffer_range_char (buf, start2, end2, &startr2, &endr2, 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2347
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2348 len1 = endr1 - startr1;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2349 len2 = endr2 - startr2;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2350
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2351 if (startr2 < endr1)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 487
diff changeset
2352 invalid_argument ("transposed regions not properly ordered", Qunbound);
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2353 else if (startr1 == endr1 || startr2 == endr2)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 487
diff changeset
2354 invalid_argument ("transposed region may not be of length 0", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2355
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2356 string1 = make_string_from_buffer (buf, startr1, len1);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2357 string2 = make_string_from_buffer (buf, startr2, len2);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2358 buffer_delete_range (buf, startr2, endr2, 0);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2359 buffer_insert_lisp_string_1 (buf, startr2, string1, 0);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2360 buffer_delete_range (buf, startr1, endr1, 0);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2361 buffer_insert_lisp_string_1 (buf, startr1, string2, 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2362
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2363 /* In FSFmacs there is a whole bunch of really ugly code here
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2364 to attempt to transpose the regions without using up any
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2365 extra memory. Although the intent may be good, the result
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2366 was highly bogus. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2367
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2368 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2369 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2370
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2371
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2372 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2373 /* initialization */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2374 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2375
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2376 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2377 syms_of_editfns (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2378 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 487
diff changeset
2379 DEFSYMBOL (Qpoint);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 487
diff changeset
2380 DEFSYMBOL (Qmark);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 487
diff changeset
2381 DEFSYMBOL (Qregion_beginning);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 487
diff changeset
2382 DEFSYMBOL (Qregion_end);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 487
diff changeset
2383 DEFSYMBOL (Qformat);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 487
diff changeset
2384 DEFSYMBOL (Quser_files_and_directories);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2385
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2386 DEFSUBR (Fchar_equal);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2387 DEFSUBR (Fchar_Equal);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2388 DEFSUBR (Fgoto_char);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2389 DEFSUBR (Fstring_to_char);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2390 DEFSUBR (Fchar_to_string);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2391 DEFSUBR (Fbuffer_substring);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2392 DEFSUBR (Fbuffer_substring_no_properties);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2393
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2394 DEFSUBR (Fpoint_marker);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2395 DEFSUBR (Fmark_marker);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2396 DEFSUBR (Fpoint);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2397 DEFSUBR (Fregion_beginning);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2398 DEFSUBR (Fregion_end);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2399 DEFSUBR (Fsave_excursion);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2400 DEFSUBR (Fsave_current_buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2401
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2402 DEFSUBR (Fbuffer_size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2403 DEFSUBR (Fpoint_max);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2404 DEFSUBR (Fpoint_min);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2405 DEFSUBR (Fpoint_min_marker);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2406 DEFSUBR (Fpoint_max_marker);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2407
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2408 DEFSUBR (Fbobp);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2409 DEFSUBR (Feobp);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2410 DEFSUBR (Fbolp);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2411 DEFSUBR (Feolp);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2412 DEFSUBR (Ffollowing_char);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2413 DEFSUBR (Fpreceding_char);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2414 DEFSUBR (Fchar_after);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2415 DEFSUBR (Fchar_before);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2416 DEFSUBR (Finsert);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2417 DEFSUBR (Finsert_string);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2418 DEFSUBR (Finsert_before_markers);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2419 DEFSUBR (Finsert_char);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2420
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2421 DEFSUBR (Ftemp_directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2422 DEFSUBR (Fuser_login_name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2423 DEFSUBR (Fuser_real_login_name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2424 DEFSUBR (Fuser_uid);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2425 DEFSUBR (Fuser_real_uid);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2426 DEFSUBR (Fuser_full_name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2427 DEFSUBR (Fuser_home_directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2428 DEFSUBR (Femacs_pid);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2429 DEFSUBR (Fcurrent_time);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2430 DEFSUBR (Fcurrent_process_time);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2431 DEFSUBR (Fformat_time_string);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2432 DEFSUBR (Fdecode_time);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2433 DEFSUBR (Fencode_time);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2434 DEFSUBR (Fcurrent_time_string);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2435 DEFSUBR (Fcurrent_time_zone);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2436 DEFSUBR (Fset_time_zone_rule);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2437 DEFSUBR (Fsystem_name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2438 DEFSUBR (Fformat);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2439
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2440 DEFSUBR (Finsert_buffer_substring);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2441 DEFSUBR (Fcompare_buffer_substrings);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2442 DEFSUBR (Fsubst_char_in_region);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2443 DEFSUBR (Ftranslate_region);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2444 DEFSUBR (Fdelete_region);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2445 DEFSUBR (Fwiden);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2446 DEFSUBR (Fnarrow_to_region);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2447 DEFSUBR (Fsave_restriction);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2448 DEFSUBR (Ftranspose_regions);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2449
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 487
diff changeset
2450 DEFSYMBOL (Qzmacs_update_region);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 487
diff changeset
2451 DEFSYMBOL (Qzmacs_deactivate_region);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 487
diff changeset
2452 DEFSYMBOL (Qzmacs_region_buffer);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2453 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2454
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2455 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2456 vars_of_editfns (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2457 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2458 staticpro (&Vsystem_name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2459 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2460 staticpro (&Vuser_name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2461 staticpro (&Vuser_real_name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2462 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2463 DEFVAR_BOOL ("zmacs-regions", &zmacs_regions /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2464 *Whether LISPM-style active regions should be used.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2465 This means that commands which operate on the region (the area between the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2466 point and the mark) will only work while the region is in the ``active''
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2467 state, which is indicated by highlighting. Executing most commands causes
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2468 the region to not be in the active state, so (for example) \\[kill-region] will only
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2469 work immediately after activating the region.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2470
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2471 More specifically:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2472
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2473 - Commands which operate on the region only work if the region is active.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2474 - Only a very small set of commands cause the region to become active:
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2475 Those commands whose semantics are to mark an area, like `mark-defun'.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2476 - The region is deactivated after each command that is executed, except that:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2477 - "Motion" commands do not change whether the region is active or not.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2478
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2479 set-mark-command (C-SPC) pushes a mark and activates the region. Moving the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2480 cursor with normal motion commands (C-n, C-p, etc) will cause the region
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2481 between point and the recently-pushed mark to be highlighted. It will
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2482 remain highlighted until some non-motion command is executed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2483
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2484 exchange-point-and-mark (\\[exchange-point-and-mark]) activates the region. So if you mark a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2485 region and execute a command that operates on it, you can reactivate the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2486 same region with \\[exchange-point-and-mark] (or perhaps \\[exchange-point-and-mark] \\[exchange-point-and-mark]) to operate on it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2487 again.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2488
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2489 Generally, commands which push marks as a means of navigation (like
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2490 beginning-of-buffer and end-of-buffer (M-< and M->)) do not activate the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2491 region. But commands which push marks as a means of marking an area of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2492 text (like mark-defun (\\[mark-defun]), mark-word (\\[mark-word]) or mark-whole-buffer (\\[mark-whole-buffer]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2493 do activate the region.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2494
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2495 The way the command loop actually works with regard to deactivating the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2496 region is as follows:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2497
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2498 - If the variable `zmacs-region-stays' has been set to t during the command
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2499 just executed, the region is left alone (this is how the motion commands
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2500 make the region stay around; see the `_' flag in the `interactive'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2501 specification). `zmacs-region-stays' is reset to nil before each command
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2502 is executed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2503 - If the function `zmacs-activate-region' has been called during the command
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2504 just executed, the region is left alone. Very few functions should
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2505 actually call this function.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2506 - Otherwise, if the region is active, the region is deactivated and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2507 the `zmacs-deactivate-region-hook' is called.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2508 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2509 /* Zmacs style active regions are now ON by default */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2510 zmacs_regions = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2511
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2512 DEFVAR_BOOL ("zmacs-region-active-p", &zmacs_region_active_p /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2513 Do not alter this. It is for internal use only.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2514 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2515 zmacs_region_active_p = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2516
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2517 DEFVAR_BOOL ("zmacs-region-stays", &zmacs_region_stays /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2518 Whether the current command will deactivate the region.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2519 Commands which do not wish to affect whether the region is currently
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2520 highlighted should set this to t. Normally, the region is turned off after
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2521 executing each command that did not explicitly turn it on with the function
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2522 zmacs-activate-region. Setting this to true lets a command be non-intrusive.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2523 See the variable `zmacs-regions'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2524
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2525 The same effect can be achieved using the `_' interactive specification.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2526
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2527 `zmacs-region-stays' is reset to nil before each command is executed.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2528 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2529 zmacs_region_stays = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2530
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2531 DEFVAR_BOOL ("atomic-extent-goto-char-p", &atomic_extent_goto_char_p /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2532 Do not use this -- it will be going away soon.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2533 Indicates if `goto-char' has just been run. This information is allegedly
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2534 needed to get the desired behavior for atomic extents and unfortunately
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2535 is not available by any other means.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2536 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2537 atomic_extent_goto_char_p = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2538 #ifdef AMPERSAND_FULL_NAME
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2539 Fprovide (intern ("ampersand-full-name"));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2540 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2541
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2542 DEFVAR_LISP ("user-full-name", &Vuser_full_name /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2543 *The name of the user.
4266
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 4203
diff changeset
2544 The function `user-full-name' will return the value of this variable, when
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 4203
diff changeset
2545 called without arguments.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2546 This is initialized to the value of the NAME environment variable.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2547 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2548 /* Initialized at run-time. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2549 Vuser_full_name = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2550 }