annotate src/editfns.c @ 844:047d37eb70d7

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