annotate src/editfns.c @ 814:a634e3b7acc8

[xemacs-hg @ 2002-04-14 12:41:59 by ben] latest changes TODO.ben-mule-21-5: Update. make-docfile.c: Add basic support for handling ISO 2022 doc strings -- we parse the basic charset designation sequences so we know whether we're in ASCII and have to pay attention to end quotes and such. Reformat code according to coding standards. abbrev.el: Add `global-abbrev-mode', which turns on or off abbrev-mode in all buffers. Added `defining-abbrev-turns-on-abbrev-mode' -- if non-nil, defining an abbrev through an interactive function will automatically turn on abbrev-mode, either globally or locally depending on the command. This is the "what you'd expect" behavior. indent.el: general function for indenting a balanced expression in a mode-correct way. Works similar to indent-region in that a mode can specify a specific command to do the whole operation; if not, figure out the region using forward-sexp and indent each line using indent-according-to-mode. keydefs.el: Removed. Modify M-C-backslash to do indent-region-or-balanced-expression. Make S-Tab just insert a TAB char, like it's meant to do. make-docfile.el: Now that we're using the call-process-in-lisp, we need to load an extra file win32-native.el because we're running a bare temacs. menubar-items.el: Totally redo the Cmds menu so that most used commands appear directly on the menu and less used commands appear in submenus. The old way may have been very pretty, but rather impractical. process.el: Under Windows, don't ever use old-call-process-internal, even in batch mode. We can do processes in batch mode. subr.el: Someone recoded truncate-string-to-width, saying "the FSF version is too complicated and does lots of hard-to-understand stuff" but the resulting recoded version was *totally* wrong! it misunderstood the basic point of this function, which is work in *columns* not chars. i dumped ours and copied the version from FSF 21.1. Also added truncate-string-with-continuation-dots, since this idiom is used often. config.inc.samp, xemacs.mak: Separate out debug and optimize flags. Remove all vestiges of USE_MINIMAL_TAGBITS, USE_INDEXED_LRECORD_IMPLEMENTATION, and GUNG_HO, since those ifdefs have long been removed. Make error-checking support actually work. Some rearrangement of config.inc.samp to make it more logical. Remove callproc.c and ntproc.c from xemacs.mak, no longer used. Make pdump the default. lisp.h: Add support for strong type-checking of Bytecount, Bytebpos, Charcount, Charbpos, and others, by making them classes, overloading the operators to provide integer-like operation and carefully controlling what operations are allowed. Not currently enabled in C++ builds because there are still a number of compile errors, and it won't really work till we merge in my "8-bit-Mule" workspace, in which I make use of the new types Charxpos, Bytexpos, Memxpos, representing a "position" either in a buffer or a string. (This is especially important in the extent code.) abbrev.c, alloc.c, eval.c, buffer.c, buffer.h, editfns.c, fns.c, text.h: Warning fixes, some of them related to new C++ strict type checking of Bytecount, Charbpos, etc. dired.c: Caught an actual error due to strong type checking -- char len being passed when should be byte len. alloc.c, backtrace.h, bytecode.c, bytecode.h, eval.c, sysdep.c: Further optimize Ffuncall: -- process arg list at compiled-function creation time, converting into an array for extra-quick access at funcall time. -- rewrite funcall_compiled_function to use it, and inline this function. -- change the order of check for magic stuff in SPECBIND_FAST_UNSAFE to be faster. -- move the check for need to garbage collect into the allocation code, so only a single flag needs to be checked in funcall. buffer.c, symbols.c: add debug funs to check on mule optimization info in buffers and strings. eval.c, emacs.c, text.c, regex.c, scrollbar-msw.c, search.c: Fix evil crashes due to eistrings not properly reinitialized under pdump. Redo a bit some of the init routines; convert some complex_vars_of() into simple vars_of(), because they didn't need complex processing. callproc.c, emacs.c, event-stream.c, nt.c, process.c, process.h, sysdep.c, sysdep.h, syssignal.h, syswindows.h, ntproc.c: Delete. Hallelujah, praise the Lord, there is no god but Allah!!! fix so that processes can be invoked in bare temacs -- thereby eliminating any need for callproc.c. (currently only eliminated under NT.) remove all crufty and unnecessary old process code in ntproc.c and elsewhere. move non-callproc-specific stuff (mostly environment) into process.c, so callproc.c can be left out under NT. console-tty.c, doc.c, file-coding.c, file-coding.h, lstream.c, lstream.h: fix doc string handling so it works with Japanese, etc docs. change handling of "character mode" so callers don't have to manually set it (quite error-prone). event-msw.c: spacing fixes. lread.c: eliminate unused crufty vintage-19 "FSF defun hack" code. lrecord.h: improve pdump description docs. buffer.c, ntheap.c, unexnt.c, win32.c, emacs.c: Mule-ize some unexec and startup code. It was pseudo-Mule-ized before by simply always calling the ...A versions of functions, but that won't cut it -- eventually we want to be able to run properly even if XEmacs has been installed in a Japanese directory. (The current problem is the timing of the loading of the Unicode tables; this will eventually be fixed.) Go through and fix various other places where the code was not Mule-clean. Provide a function mswindows_get_module_file_name() to get our own name without resort to PATH_MAX and such. Add a big comment in main() about the problem with Unicode table load timing that I just alluded to. emacs.c: When error-checking is enabled (interpreted as "user is developing XEmacs"), don't ask user to "pause to read messages" when a fatal error has occurred, because it will wedge if we are in an inner modal loop (typically when a menu is popped up) and make us unable to get a useful stack trace in the debugger. text.c: Correct update_entirely_ascii_p_flag to actually work. lisp.h, symsinit.h: declarations for above changes.
author ben
date Sun, 14 Apr 2002 12:43:31 +0000
parents a5954632b187
children 6728e641994e
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)
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
137 return make_char (XSTRING_CHAR (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 /* The following two functions end up being identical but it's
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
182 cleaner to declare them separately. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
183
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
184 Charbpos
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
185 charbpos_clip_to_bounds (Charbpos lower, Charbpos num, Charbpos upper)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
187 return (num < lower ? lower :
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
188 num > upper ? upper :
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189 num);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
190 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
191
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
192 Bytebpos
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
193 bytebpos_clip_to_bounds (Bytebpos lower, Bytebpos num, Bytebpos upper)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
195 return (num < lower ? lower :
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
196 num > upper ? upper :
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
197 num);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
198 }
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 /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
201 * Chuck says:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
202 * 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
203 * 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
204 * 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
205 * added for now.
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 * 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
208 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
209 int atomic_extent_goto_char_p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
210
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
211 DEFUN ("goto-char", Fgoto_char, 1, 2, "NGoto char: ", /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
212 Set point to POSITION, a number or marker.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
213 Beginning of buffer is position (point-min), end is (point-max).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
214 If BUFFER is nil, the current buffer is assumed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
215 Return value of POSITION, as an integer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
216 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
217 (position, buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
218 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
219 struct buffer *b = decode_buffer (buffer, 1);
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
220 Charbpos n = get_buffer_pos_char (b, position, GB_COERCE_RANGE);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
221 BUF_SET_PT (b, n);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
222 atomic_extent_goto_char_p = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
223 return make_int (n);
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
226 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
227 region_limit (int beginningp, struct buffer *b)
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 Lisp_Object m;
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 #if 0 /* FSFmacs */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
232 if (!NILP (Vtransient_mark_mode) && NILP (Vmark_even_if_inactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
233 && NILP (b->mark_active))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234 Fsignal (Qmark_inactive, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
236 m = Fmarker_position (b->mark);
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 487
diff changeset
237 if (NILP (m)) invalid_operation ("There is no region now", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
238 if (!!(BUF_PT (b) < XINT (m)) == !!beginningp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
239 return make_int (BUF_PT (b));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241 return m;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244 DEFUN ("region-beginning", Fregion_beginning, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
245 Return position of beginning of region in BUFFER, as an integer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
246 If BUFFER is nil, the current buffer is assumed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
247 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248 (buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
250 return region_limit (1, decode_buffer (buffer, 1));
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253 DEFUN ("region-end", Fregion_end, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254 Return position of end of region in BUFFER, as an integer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
255 If BUFFER is nil, the current buffer is assumed.
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 (buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
258 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
259 return region_limit (0, decode_buffer (buffer, 1));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
260 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
261
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
262 /* Whether to use lispm-style active-regions */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
263 int zmacs_regions;
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 /* Whether the zmacs region is active. This is not per-buffer because
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
266 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
267 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
268 necessarily have to be true. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
269 int zmacs_region_active_p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
270
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
271 int zmacs_region_stays;
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 Qzmacs_update_region, Qzmacs_deactivate_region;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274 Lisp_Object Qzmacs_region_buffer;
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 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
277 zmacs_update_region (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
278 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
279 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
280 if (zmacs_region_active_p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
281 call0 (Qzmacs_update_region);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
282 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
283
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
284 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
285 zmacs_deactivate_region (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
286 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
287 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
288 if (zmacs_region_active_p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
289 call0 (Qzmacs_deactivate_region);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
290 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
291
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
292 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
293 zmacs_region_buffer (void)
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 if (zmacs_region_active_p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
296 return call0 (Qzmacs_region_buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
297 else
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 DEFUN ("mark-marker", Fmark_marker, 0, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
302 Return this buffer's mark, as a marker object.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
303 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
304 currently in the active (highlighted) state. If optional argument FORCE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
305 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
306 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
307 if the user has expressed a preference for the zmacs-region model.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
308 Watch out! Moving this marker changes the mark position.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309 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
310 If BUFFER is nil, the current buffer is assumed.
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 (force, buffer))
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 struct buffer *b = decode_buffer (buffer, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
315 if (! zmacs_regions || zmacs_region_active_p || !NILP (force))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
316 return b->mark;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
317 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
318 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
319
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
321 /* The saved object is a cons:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
322
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
323 (COPY-OF-POINT-MARKER . COPY-OF-MARK)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
324
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
325 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
326 if `(eq (current-buffer) (window-buffer (selected-window)))' but it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
327 was unused for a long time, so I removed it. --hniksic */
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_save (void)
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 struct buffer *b;
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 /* #### Huh? --hniksic */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
334 /*if (preparing_for_armageddon) return Qnil;*/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
335
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
336 #ifdef ERROR_CHECK_TEXT
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
337 assert (XINT (Fpoint (Qnil)) ==
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
338 XINT (Fmarker_position (Fpoint_marker (Qt, Qnil))));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
339 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
340
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
341 b = current_buffer;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
342
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
343 return noseeum_cons (noseeum_copy_marker (b->point_marker, Qnil),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
344 noseeum_copy_marker (b->mark, Qnil));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
345 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
346
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
347 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
348 save_excursion_restore (Lisp_Object info)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
350 Lisp_Object buffer = Fmarker_buffer (XCAR (info));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
351
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
352 /* If buffer being returned to is now deleted, avoid error --
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
353 otherwise could get error here while unwinding to top level and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
354 crash. In that case, Fmarker_buffer returns nil now. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
355 if (!NILP (buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
356 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
357 struct buffer *buf = XBUFFER (buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
358 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
359 GCPRO1 (info);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
360 set_buffer_internal (buf);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
361 Fgoto_char (XCAR (info), buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
362 Fset_marker (buf->mark, XCDR (info), buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
363
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364 #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
365 if that was true previously. That avoids some anomalies.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
366 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
367 and cleaner never to alter the window/buffer connections. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
368 /* I'm certain some code somewhere depends on this behavior. --jwz */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
369 /* Even if it did, it certainly doesn't matter anymore, because
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
370 this has been the behavior for countless XEmacs releases
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
371 now. --hniksic */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
372 if (visible
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
373 && (current_buffer != XBUFFER (XWINDOW (selected_window)->buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
374 switch_to_buffer (Fcurrent_buffer (), Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
375 #endif
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 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
378 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
379
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
380 /* Free all the junk we allocated, so that a `save-excursion' comes
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
381 for free in terms of GC junk. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
382 free_marker (XMARKER (XCAR (info)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
383 free_marker (XMARKER (XCDR (info)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
384 free_cons (XCONS (info));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
385 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
386 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
387
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
388 DEFUN ("save-excursion", Fsave_excursion, 0, UNEVALLED, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
389 Save point, mark, and current buffer; execute BODY; restore those things.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
390 Executes BODY just like `progn'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
391 The values of point, mark and the current buffer are restored
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
392 even in case of abnormal exit (throw or error).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
393 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
394 (args))
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 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
397 int speccount = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
398
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
399 record_unwind_protect (save_excursion_restore, save_excursion_save ());
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
400
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
401 return unbind_to_1 (speccount, Fprogn (args));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
402 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
403
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
404 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
405 save_current_buffer_restore (Lisp_Object buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
406 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
407 struct buffer *buf = XBUFFER (buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
408 /* Avoid signaling an error if the buffer is no longer alive. This
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
409 is for consistency with save-excursion. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410 if (BUFFER_LIVE_P (buf))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
411 set_buffer_internal (buf);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
412 return Qnil;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
415 DEFUN ("save-current-buffer", Fsave_current_buffer, 0, UNEVALLED, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
416 Save the current buffer; execute BODY; restore the current buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
417 Executes BODY just like `progn'.
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 (args))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
420 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
421 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
422 int speccount = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
423
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
424 record_unwind_protect (save_current_buffer_restore, Fcurrent_buffer ());
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
425
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
426 return unbind_to_1 (speccount, Fprogn (args));
428
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
429 DEFUN ("buffer-size", Fbuffer_size, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
430 Return the number of characters in BUFFER.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
431 If BUFFER is nil, the current buffer is assumed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
432 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
433 (buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
434 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
435 struct buffer *b = decode_buffer (buffer, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
436 return make_int (BUF_SIZE (b));
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
439 DEFUN ("point-min", Fpoint_min, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
440 Return the minimum permissible value of point in BUFFER.
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
441 This is 1, unless narrowing (a buffer restriction)
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
442 is in effect, in which case it may be greater.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
443 If BUFFER is nil, the current buffer is assumed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
444 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
445 (buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
446 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
447 struct buffer *b = decode_buffer (buffer, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
448 return make_int (BUF_BEGV (b));
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
451 DEFUN ("point-min-marker", Fpoint_min_marker, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
452 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
453 This is the beginning, unless narrowing (a buffer restriction)
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
454 is in effect, in which case it may be greater.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
455 If BUFFER is nil, the current buffer is assumed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
456 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
457 (buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
458 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
459 struct buffer *b = decode_buffer (buffer, 1);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
460 return buildmark (BUF_BEGV (b), wrap_buffer (b));
428
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
463 DEFUN ("point-max", Fpoint_max, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
464 Return the maximum permissible value of point in BUFFER.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
465 This is (1+ (buffer-size)), unless narrowing (a buffer restriction)
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
466 is in effect, in which case it may be less.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
467 If BUFFER is nil, the current buffer is assumed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
468 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
469 (buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
470 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
471 struct buffer *b = decode_buffer (buffer, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
472 return make_int (BUF_ZV (b));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
473 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
474
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
475 DEFUN ("point-max-marker", Fpoint_max_marker, 0, 1, 0, /*
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
476 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
477 This is (1+ (buffer-size)), unless narrowing (a buffer restriction)
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
478 is in effect, in which case it may be less.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
479 If BUFFER is nil, the current buffer is assumed.
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 (buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
482 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
483 struct buffer *b = decode_buffer (buffer, 1);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
484 return buildmark (BUF_ZV (b), wrap_buffer (b));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
485 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
486
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
487 DEFUN ("following-char", Ffollowing_char, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
488 Return the character following point.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
489 At the end of the buffer or accessible region, return 0.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
490 If BUFFER is nil, the current buffer is assumed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
491 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
492 (buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
493 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
494 struct buffer *b = decode_buffer (buffer, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
495 if (BUF_PT (b) >= BUF_ZV (b))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
496 return Qzero; /* #### Gag me! */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
497 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
498 return make_char (BUF_FETCH_CHAR (b, BUF_PT (b)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
499 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
500
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
501 DEFUN ("preceding-char", Fpreceding_char, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
502 Return the character preceding point.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
503 At the beginning of the buffer or accessible region, return 0.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
504 If BUFFER is nil, the current buffer is assumed.
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 (buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
507 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
508 struct buffer *b = decode_buffer (buffer, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
509 if (BUF_PT (b) <= BUF_BEGV (b))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
510 return Qzero; /* #### Gag me! */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
511 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
512 return make_char (BUF_FETCH_CHAR (b, BUF_PT (b) - 1));
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
515 DEFUN ("bobp", Fbobp, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
516 Return t if point is at the beginning of the buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
517 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
518 If BUFFER is nil, the current buffer is assumed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
519 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
520 (buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
521 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
522 struct buffer *b = decode_buffer (buffer, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
523 return BUF_PT (b) == BUF_BEGV (b) ? Qt : Qnil;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
526 DEFUN ("eobp", Feobp, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
527 Return t if point is at the end of the buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
528 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
529 If BUFFER is nil, the current buffer is assumed.
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 (buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
532 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
533 struct buffer *b = decode_buffer (buffer, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
534 return BUF_PT (b) == BUF_ZV (b) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
535 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
536
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
537 int
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
538 beginning_of_line_p (struct buffer *b, Charbpos pt)
428
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 return pt <= BUF_BEGV (b) || BUF_FETCH_CHAR (b, pt - 1) == '\n';
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
543
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
544 DEFUN ("bolp", Fbolp, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
545 Return t if point is at the beginning of a line.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
546 If BUFFER is nil, the current buffer is assumed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
547 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
548 (buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
549 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
550 struct buffer *b = decode_buffer (buffer, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
551 return beginning_of_line_p (b, BUF_PT (b)) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
552 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
553
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
554 DEFUN ("eolp", Feolp, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
555 Return t if point is at the end of a line.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
556 `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
557 If BUFFER is nil, the current buffer is assumed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
558 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
559 (buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
560 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
561 struct buffer *b = decode_buffer (buffer, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
562 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
563 ? Qt : Qnil;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
566 DEFUN ("char-after", Fchar_after, 0, 2, 0, /*
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
567 Return the character at position POS in BUFFER.
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
568 POS is an integer or a marker.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
569 If POS is out of range, the value is nil.
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
570 if POS is nil, the value of point is assumed.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
571 If BUFFER is nil, the current buffer is assumed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
572 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
573 (pos, buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
574 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
575 struct buffer *b = decode_buffer (buffer, 1);
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
576 Charbpos n = (NILP (pos) ? BUF_PT (b) :
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
577 get_buffer_pos_char (b, pos, GB_NO_ERROR_IF_BAD));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
578
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
579 if (n < 0 || n == BUF_ZV (b))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
580 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
581 return make_char (BUF_FETCH_CHAR (b, n));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
582 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
583
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
584 DEFUN ("char-before", Fchar_before, 0, 2, 0, /*
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
585 Return the character preceding position POS in BUFFER.
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
586 POS is an integer or a marker.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
587 If POS is out of range, the value is nil.
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
588 if POS is nil, the value of point is assumed.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
589 If BUFFER is nil, the current buffer is assumed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
590 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
591 (pos, buffer))
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 struct buffer *b = decode_buffer (buffer, 1);
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
594 Charbpos n = (NILP (pos) ? BUF_PT (b) :
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
595 get_buffer_pos_char (b, pos, GB_NO_ERROR_IF_BAD));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
596
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
597 n--;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
598
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
599 if (n < BUF_BEGV (b))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
600 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
601 return make_char (BUF_FETCH_CHAR (b, n));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
602 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
603
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
604
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
605 DEFUN ("temp-directory", Ftemp_directory, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
606 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
607 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
608 defaulting to c:\\ if they are both undefined.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
609 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
610 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
611 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
612 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
613 Intbyte *tmpdir;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
614 #if defined(WIN32_NATIVE)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
615 tmpdir = egetenv ("TEMP");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
616 if (!tmpdir)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
617 tmpdir = egetenv ("TMP");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
618 if (!tmpdir)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
619 tmpdir = (Intbyte *) "c:\\";
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
620 #else /* WIN32_NATIVE */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
621 tmpdir = egetenv ("TMPDIR");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
622 if (!tmpdir)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
623 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
624 struct stat st;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
625 int myuid = getuid ();
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
626 Intbyte *login_name = user_login_name (NULL);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
627 DECLARE_EISTRING (eipath);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
628 Intbyte *path;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
629
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
630 eicpy_c (eipath, "/tmp/");
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
631 eicat_rawz (eipath, login_name);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
632 path = eidata (eipath);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
633 if (qxe_lstat (path, &st) < 0 && errno == ENOENT)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
634 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
635 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
636 && S_ISDIR (st.st_mode))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
637 tmpdir = path;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
638 else
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
639 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
640 eicpy_rawz (eipath, egetenv ("HOME"));
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
641 eicat_c (eipath, "/tmp/");
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
642 path = eidata (eipath);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
643 if (qxe_stat (path, &st) < 0 && errno == ENOENT)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
644 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
645 int fd;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
646 DECLARE_EISTRING (eiwarnpath);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
647
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
648 qxe_mkdir (path, 0700); /* ignore retvals */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
649 eicpy_ei (eiwarnpath, eipath);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
650 eicat_c (eiwarnpath, ".created_by_xemacs");
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
651 if ((fd = qxe_open (eidata (eiwarnpath),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
652 O_WRONLY | O_CREAT, 0644)) > 0)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
653 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
654 retry_write (fd, "XEmacs created this directory because "
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
655 "/tmp/<yourname> was unavailable -- \n"
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
656 "Please check !\n", 89);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
657 retry_close (fd);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
658 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
659 }
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
660 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
661 tmpdir = path;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
662 else
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
663 tmpdir = (Intbyte *) "/tmp";
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
664 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
665 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
666 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
667
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
668 return build_intstring (tmpdir);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
669 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
670
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
671 DEFUN ("user-login-name", Fuser_login_name, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
672 Return the name under which the user logged in, as a string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
673 This is based on the effective uid, not the real uid.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
674 Also, if the environment variable LOGNAME or USER is set,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
675 that determines the value of this function.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
676 If the optional argument UID is present, then environment variables are
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
677 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
678 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
679 (uid))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
680 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
681 Intbyte *returned_name;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
682 uid_t local_uid;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
683
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
684 if (!NILP (uid))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
685 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
686 CHECK_INT (uid);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
687 local_uid = XINT (uid);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
688 returned_name = user_login_name (&local_uid);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
689 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
690 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
691 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
692 returned_name = user_login_name (NULL);
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 /* #### - I believe this should return nil instead of "unknown" when pw==0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
695 pw=0 is indicated by a null return from user_login_name
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 return returned_name ? build_intstring (returned_name) : Qnil;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
698 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
699
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
700 /* This function may be called from other C routines when a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
701 character string representation of the user_login_name is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
702 needed but a Lisp Object is not. The UID is passed by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
703 reference. If UID == NULL, then the USER name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
704 for the user running XEmacs will be returned. This
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
705 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
706
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
707 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
708 therefore will become garbage after the next GC.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
709 */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
710 Intbyte *
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
711 user_login_name (uid_t *uid)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
712 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
713 /* uid == NULL to return name of this user */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
714 if (uid != NULL)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
715 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
716 struct passwd *pw = qxe_getpwuid (*uid);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
717 return pw ? (Intbyte *) pw->pw_name : NULL;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
718 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
719 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
720 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
721 /* #### - when euid != uid, then LOGNAME and USER are leftovers from the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
722 old environment (I site observed behavior on sunos and linux), so the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
723 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
724 Intbyte *user_name = egetenv ("LOGNAME");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
725 if (!user_name)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
726 user_name = egetenv (
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
727 #ifdef WIN32_NATIVE
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
728 "USERNAME" /* it's USERNAME on NT */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
729 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
730 "USER"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
731 #endif
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 if (user_name)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
734 return user_name;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
735 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
736 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
737 struct passwd *pw = qxe_getpwuid (geteuid ());
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
738 #ifdef CYGWIN
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
739 /* Since the Cygwin environment may not have an /etc/passwd,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
740 return "unknown" instead of the null if the username
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
741 cannot be determined.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
742 */
593
5fd7ba8b56e7 [xemacs-hg @ 2001-05-31 12:45:27 by ben]
ben
parents: 563
diff changeset
743 /* !!#### fix up in my mule ws */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
744 return (Intbyte *) (pw ? pw->pw_name : "unknown");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
745 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
746 /* For all but Cygwin return NULL (nil) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
747 return pw ? pw->pw_name : NULL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
748 #endif
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
753 DEFUN ("user-real-login-name", Fuser_real_login_name, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
754 Return the name of the user's real uid, as a string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
755 This ignores the environment variables LOGNAME and USER, so it differs from
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
756 `user-login-name' when running under `su'.
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 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
760 struct passwd *pw = qxe_getpwuid (getuid ());
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
761 /* #### - I believe this should return nil instead of "unknown" when pw==0 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
762
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
763 return build_string (pw ? pw->pw_name : "unknown");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
764 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
765
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
766 DEFUN ("user-uid", Fuser_uid, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
767 Return the effective uid of Emacs, as an integer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
768 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
769 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
770 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
771 return make_int (geteuid ());
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
774 DEFUN ("user-real-uid", Fuser_real_uid, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
775 Return the real uid of Emacs, as an integer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
776 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
777 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
778 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
779 return make_int (getuid ());
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
782 DEFUN ("user-full-name", Fuser_full_name, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
783 Return the full name of the user logged in, as a string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
784 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
785 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
786
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
787 If USER is nil, and `user-full-name' contains a string, the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
788 value of `user-full-name' is returned.
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 (user))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
791 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
792 Lisp_Object user_name;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
793 struct passwd *pw = NULL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
794 Lisp_Object tem;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
795 const Intbyte *p, *q;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
796
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
797 if (NILP (user) && STRINGP (Vuser_full_name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
798 return Vuser_full_name;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
799
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
800 user_name = (STRINGP (user) ? user : Fuser_login_name (user));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
801 if (!NILP (user_name)) /* nil when nonexistent UID passed as arg */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
802 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
803 /* Fuck me. getpwnam() can call select() and (under IRIX at least)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
804 things get wedged if a SIGIO arrives during this time. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
805 slow_down_interrupts ();
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
806 pw = qxe_getpwnam (XSTRING_DATA (user_name));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
807 speed_up_interrupts ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
808 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
809
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
810 /* #### - Stig sez: this should return nil instead of "unknown" when pw==0 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
811 /* Ben sez: bad idea because it's likely to break something */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
812 #ifndef AMPERSAND_FULL_NAME
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
813 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
814 q = qxestrchr (p, ',');
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
815 #else
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
816 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
817 q = qxestrchr (p, ',');
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
818 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
819 tem = ((!NILP (user) && !pw)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
820 ? Qnil
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 800
diff changeset
821 : make_string (p, (q ? (Bytecount) (q - p) : qxestrlen (p))));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
822
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
823 #ifdef AMPERSAND_FULL_NAME
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
824 if (!NILP (tem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
825 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
826 p = XSTRING_DATA (tem);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
827 q = qxestrchr (p, '&');
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
828 /* Substitute the login name for the &, upcasing the first character. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
829 if (q)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
830 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
831 DECLARE_EISTRING (r);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
832 eicpy_raw (r, p, q - p);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
833 eicat_lstr (r, user_name);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
834 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
835 eicat_rawz (r, q + 1);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
836 tem = eimake_string (r);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
837 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
838 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
839 #endif /* AMPERSAND_FULL_NAME */
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 return tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
842 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
843
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
844 static Intbyte *cached_home_directory;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
845
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
846 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
847 uncache_home_directory (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
848 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
849 if (cached_home_directory)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
850 xfree (cached_home_directory);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
851 cached_home_directory = NULL;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
852 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
853
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
854 /* Returns the home directory */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
855 Intbyte *
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
856 get_home_directory (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
857 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
858 int output_home_warning = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
859
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
860 if (cached_home_directory == NULL)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
861 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
862 cached_home_directory = egetenv ("HOME");
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
863 if (cached_home_directory)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
864 cached_home_directory = qxestrdup (cached_home_directory);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
865 else
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
866 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
867 #if defined (WIN32_NATIVE)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
868 Intbyte *homedrive, *homepath;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
869
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
870 if ((homedrive = egetenv ("HOMEDRIVE")) != NULL &&
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
871 (homepath = egetenv ("HOMEPATH")) != NULL)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
872 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
873 cached_home_directory =
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
874 (Intbyte *) xmalloc (qxestrlen (homedrive) +
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
875 qxestrlen (homepath) + 1);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
876 qxesprintf (cached_home_directory, "%s%s",
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
877 homedrive,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
878 homepath);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
879 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
880 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
881 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
882 cached_home_directory = qxestrdup ((Intbyte *) "C:\\");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
883 output_home_warning = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
884 }
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
885 #else /* !WIN32_NATIVE */
428
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 * Unix, typically.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
888 * Using "/" isn't quite right, but what should we do?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
889 * We probably should try to extract pw_dir from /etc/passwd,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
890 * before falling back to this.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
891 */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
892 cached_home_directory = qxestrdup ((Intbyte *) "/");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
893 output_home_warning = 1;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
894 #endif /* !WIN32_NATIVE */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
895 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
896 if (initialized && output_home_warning)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
897 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
898 warn_when_safe (Quser_files_and_directories, Qwarning, "\n"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
899 " 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
900 " directory, and will be using the value:\n"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
901 " %s\n"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
902 " This is probably incorrect.",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
903 cached_home_directory
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
904 );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
905 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
906 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
907 return cached_home_directory;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
908 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
909
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
910 DEFUN ("user-home-directory", Fuser_home_directory, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
911 Return the user's home directory, as a string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
912 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
913 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
914 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
915 Intbyte *path = get_home_directory ();
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
916
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
917 return !path ? Qnil :
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
918 Fexpand_file_name (Fsubstitute_in_file_name (build_intstring (path)),
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
919 Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
920 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
921
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
922 DEFUN ("system-name", Fsystem_name, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
923 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
924 */
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 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
927 return Fcopy_sequence (Vsystem_name);
428
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 DEFUN ("emacs-pid", Femacs_pid, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
931 Return the process ID of Emacs, as an integer.
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 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
934 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
935 return make_int (qxe_getpid ());
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
936 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
937
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
938 DEFUN ("current-time", Fcurrent_time, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
939 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
940 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
941 most significant 16 bits of the seconds, while the second has the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
942 least significant 16 bits. The third integer gives the microsecond
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
943 count.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
944
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
945 The microsecond count is zero on systems that do not provide
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
946 resolution finer than a second.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
947 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
948 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
949 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
950 EMACS_TIME t;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
951
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
952 EMACS_GET_TIME (t);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
953 return list3 (make_int ((EMACS_SECS (t) >> 16) & 0xffff),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
954 make_int ((EMACS_SECS (t) >> 0) & 0xffff),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
955 make_int (EMACS_USECS (t)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
956 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
957
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
958 DEFUN ("current-process-time", Fcurrent_process_time, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
959 Return the amount of time used by this XEmacs process so far.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
960 The return value is a list of three floating-point numbers, expressing
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
961 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
962 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
963 process. The system time measures time spent by the CPU executing kernel
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
964 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
965
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
966 Note that the user and system times measure processor time, as opposed
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
967 to real time, and only accrue when the processor is actually doing
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
968 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
969 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
970 count. Thus, the user and system times will often be considerably
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
971 less than the real time.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
972
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
973 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
974 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
975 the process, and the system time will be 0.
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 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
978 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
979 time will be 0.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
980 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
981 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
982 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
983 double user, sys, real;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
984
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
985 get_process_times (&user, &sys, &real);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
986 return list3 (make_float (user), make_float (sys), make_float (real));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
987 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
988
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
989
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
990 int lisp_to_time (Lisp_Object specified_time, time_t *result);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
991 int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
992 lisp_to_time (Lisp_Object specified_time, time_t *result)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
993 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
994 Lisp_Object high, low;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
995
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
996 if (NILP (specified_time))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
997 return time (result) != -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
998
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
999 CHECK_CONS (specified_time);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1000 high = XCAR (specified_time);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1001 low = XCDR (specified_time);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1002 if (CONSP (low))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1003 low = XCAR (low);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1004 CHECK_INT (high);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1005 CHECK_INT (low);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1006 *result = (XINT (high) << 16) + (XINT (low) & 0xffff);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1007 return *result >> 16 == XINT (high);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1008 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1009
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1010 Lisp_Object time_to_lisp (time_t the_time);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1011 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1012 time_to_lisp (time_t the_time)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1013 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1014 unsigned int item = (unsigned int) the_time;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1015 return Fcons (make_int (item >> 16), make_int (item & 0xffff));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1016 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1017
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1018 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
1019 const struct tm *tm);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1020 static long difftm (const struct tm *a, const struct tm *b);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1021
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1022
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1023 DEFUN ("format-time-string", Fformat_time_string, 1, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1024 Use FORMAT-STRING to format the time TIME.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1025 TIME is specified as (HIGH LOW . IGNORED) or (HIGH . LOW), as from
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1026 `current-time' and `file-attributes'. If TIME is not specified it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1027 defaults to the current time.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1028 FORMAT-STRING may contain %-sequences to substitute parts of the time.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1029 %a is replaced by the abbreviated name of the day of week.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1030 %A is replaced by the full name of the day of week.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1031 %b is replaced by the abbreviated name of the month.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1032 %B is replaced by the full name of the month.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1033 %c is a synonym for "%x %X".
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1034 %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
1035 %d is replaced by the day of month, zero-padded.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1036 %D is a synonym for "%m/%d/%y".
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1037 %e is replaced by the day of month, blank-padded.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1038 %h is a synonym for "%b".
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1039 %H is replaced by the hour (00-23).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1040 %I is replaced by the hour (00-12).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1041 %j is replaced by the day of the year (001-366).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1042 %k is replaced by the hour (0-23), blank padded.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1043 %l is replaced by the hour (1-12), blank padded.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1044 %m is replaced by the month (01-12).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1045 %M is replaced by the minute (00-59).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1046 %n is a synonym for "\\n".
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1047 %p is replaced by AM or PM, as appropriate.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1048 %r is a synonym for "%I:%M:%S %p".
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1049 %R is a synonym for "%H:%M".
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1050 %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
1051 nonstandard extension)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1052 %S is replaced by the second (00-60).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1053 %t is a synonym for "\\t".
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1054 %T is a synonym for "%H:%M:%S".
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1055 %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
1056 %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
1057 %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
1058 %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
1059 %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
1060 %y is replaced by the year without century (00-99).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1061 %Y is replaced by the year with century.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1062 %Z is replaced by the time zone abbreviation.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1063
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1064 The number of options reflects the `strftime' function.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1065
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1066 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
1067 characters appearing in the day and month names may be incorrect.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1068 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1069 (format_string, time_))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1070 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1071 time_t value;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
1072 Bytecount size;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1073
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1074 CHECK_STRING (format_string);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1075
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1076 if (! lisp_to_time (time_, &value))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 487
diff changeset
1077 invalid_argument ("Invalid time specification", Qunbound);
428
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 /* This is probably enough. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1080 size = XSTRING_LENGTH (format_string) * 6 + 50;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1081
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1082 while (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1083 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1084 Extbyte *buf = (Extbyte *) alloca (size);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1085 Extbyte *formext;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1086 *buf = 1;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1087
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1088 /* !!#### 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
1089 potentially data lossy. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1090 LISP_STRING_TO_EXTERNAL (format_string, formext, Qnative);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1091 if (emacs_strftime (buf, size, formext,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1092 localtime (&value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1093 || !*buf)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1094 return build_ext_string (buf, Qnative);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1095 /* If buffer was too small, make it bigger. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1096 size *= 2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1097 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1098 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1099
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1100 DEFUN ("decode-time", Fdecode_time, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1101 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
1102 The optional SPECIFIED-TIME should be a list of (HIGH LOW . IGNORED)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1103 or (HIGH . LOW), as from `current-time' and `file-attributes', or `nil'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1104 to use the current time. The list has the following nine members:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1105 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
1106 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
1107 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
1108 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
1109 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
1110 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
1111 ZONE is an integer indicating the number of seconds east of Greenwich.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1112 \(Note that Common Lisp has different meanings for DOW and ZONE.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1113 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1114 (specified_time))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1115 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1116 time_t time_spec;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1117 struct tm save_tm;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1118 struct tm *decoded_time;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1119 Lisp_Object list_args[9];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1120
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1121 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
1122 invalid_argument ("Invalid time specification", Qunbound);
428
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 decoded_time = localtime (&time_spec);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1125 list_args[0] = make_int (decoded_time->tm_sec);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1126 list_args[1] = make_int (decoded_time->tm_min);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1127 list_args[2] = make_int (decoded_time->tm_hour);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1128 list_args[3] = make_int (decoded_time->tm_mday);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1129 list_args[4] = make_int (decoded_time->tm_mon + 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1130 list_args[5] = make_int (decoded_time->tm_year + 1900);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1131 list_args[6] = make_int (decoded_time->tm_wday);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1132 list_args[7] = (decoded_time->tm_isdst)? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1133
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1134 /* Make a copy, in case gmtime modifies the struct. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1135 save_tm = *decoded_time;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1136 decoded_time = gmtime (&time_spec);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1137 if (decoded_time == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1138 list_args[8] = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1139 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1140 list_args[8] = make_int (difftm (&save_tm, decoded_time));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1141 return Flist (9, list_args);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1142 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1143
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1144 static void set_time_zone_rule (Extbyte *tzstring);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1145
707
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 665
diff changeset
1146 /* 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
1147 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
1148 Lisp_Object
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1149 make_time (time_t tiempo)
707
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 665
diff changeset
1150 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1151 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
1152 make_int (tiempo & 0xFFFF));
707
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 665
diff changeset
1153 }
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 665
diff changeset
1154
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1155 DEFUN ("encode-time", Fencode_time, 6, MANY, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1156 Convert SECOND, MINUTE, HOUR, DAY, MONTH, YEAR and ZONE to internal time.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1157 This is the reverse operation of `decode-time', which see.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1158 ZONE defaults to the current time zone rule. This can
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1159 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
1160 \(as from `current-time-zone') or an integer (as from `decode-time')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1161 applied without consideration for daylight savings time.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1162
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1163 You can pass more than 7 arguments; then the first six arguments
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1164 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
1165 The intervening arguments are ignored.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1166 This feature lets (apply 'encode-time (decode-time ...)) work.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1167
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1168 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
1169 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
1170 Year numbers less than 100 are treated just like other year numbers.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1171 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
1172 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1173 (int nargs, Lisp_Object *args))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1174 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1175 time_t the_time;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1176 struct tm tm;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1177 Lisp_Object zone = (nargs > 6) ? args[nargs - 1] : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1178
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1179 CHECK_INT (*args); tm.tm_sec = XINT (*args++); /* second */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1180 CHECK_INT (*args); tm.tm_min = XINT (*args++); /* minute */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1181 CHECK_INT (*args); tm.tm_hour = XINT (*args++); /* hour */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1182 CHECK_INT (*args); tm.tm_mday = XINT (*args++); /* day */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1183 CHECK_INT (*args); tm.tm_mon = XINT (*args++) - 1; /* month */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1184 CHECK_INT (*args); tm.tm_year = XINT (*args++) - 1900;/* year */
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 tm.tm_isdst = -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1187
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1188 if (CONSP (zone))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1189 zone = XCAR (zone);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1190 if (NILP (zone))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1191 the_time = mktime (&tm);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1192 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1193 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1194 /* #### This business of modifying environ is horrendous!
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1195 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
1196 funs that don't require this futzing? */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1197 Extbyte tzbuf[100];
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1198 Extbyte *tzstring;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1199 Extbyte **oldenv = environ, **newenv;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1200
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1201 if (STRINGP (zone))
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1202 LISP_STRING_TO_EXTERNAL (zone, tzstring, Qnative);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1203 else if (INTP (zone))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1204 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1205 int abszone = abs (XINT (zone));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1206 sprintf (tzbuf, "XXX%s%d:%02d:%02d", "-" + (XINT (zone) < 0),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1207 abszone / (60*60), (abszone/60) % 60, abszone % 60);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1208 tzstring = tzbuf;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1209 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1210 else
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1211 invalid_argument ("Invalid time zone specification", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1212
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1213 /* Set TZ before calling mktime; merely adjusting mktime's returned
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1214 value doesn't suffice, since that would mishandle leap seconds. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1215 set_time_zone_rule (tzstring);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1216
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1217 the_time = mktime (&tm);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1218
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1219 /* Restore TZ to previous value. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1220 newenv = environ;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1221 environ = oldenv;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1222 free (newenv);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1223 #ifdef LOCALTIME_CACHE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1224 tzset ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1225 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1226 }
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 if (the_time == (time_t) -1)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 487
diff changeset
1229 invalid_argument ("Specified time is not representable", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1230
707
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 665
diff changeset
1231 return make_time (the_time);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1232 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1233
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1234 DEFUN ("current-time-string", Fcurrent_time_string, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1235 Return the current time, as a human-readable string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1236 Programs can use this function to decode a time,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1237 since the number of columns in each field is fixed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1238 The format is `Sun Sep 16 01:03:52 1973'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1239 If an argument is given, it specifies a time to format
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1240 instead of the current time. The argument should have the form:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1241 (HIGH . LOW)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1242 or the form:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1243 (HIGH LOW . IGNORED).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1244 Thus, you can use times obtained from `current-time'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1245 and from `file-attributes'.
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 (specified_time))
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 time_t value;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1250 Intbyte *the_ctime;
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 593
diff changeset
1251 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
1252 should it be an Bytecount? */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1253
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1254 if (! lisp_to_time (specified_time, &value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1255 value = -1;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1256 the_ctime = qxe_ctime (&value);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1257
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1258 /* ctime is documented as always returning a "\n\0"-terminated
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1259 26-byte American time string, but let's be careful anyways. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1260 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
1261 ;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1262
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1263 return make_string (the_ctime, len);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1264 }
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 #define TM_YEAR_ORIGIN 1900
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1267
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1268 /* Yield A - B, measured in seconds. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1269 static long
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1270 difftm (const struct tm *a, const struct tm *b)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1271 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1272 int ay = a->tm_year + (TM_YEAR_ORIGIN - 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1273 int by = b->tm_year + (TM_YEAR_ORIGIN - 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1274 /* Some compilers can't handle this as a single return statement. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1275 long days = (
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1276 /* difference in day of year */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1277 a->tm_yday - b->tm_yday
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1278 /* + intervening leap days */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1279 + ((ay >> 2) - (by >> 2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1280 - (ay/100 - by/100)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1281 + ((ay/100 >> 2) - (by/100 >> 2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1282 /* + difference in years * 365 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1283 + (long)(ay-by) * 365
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 return (60*(60*(24*days + (a->tm_hour - b->tm_hour))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1286 + (a->tm_min - b->tm_min))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1287 + (a->tm_sec - b->tm_sec));
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1290 DEFUN ("current-time-zone", Fcurrent_time_zone, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1291 Return the offset and name for the local time zone.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1292 This returns a list of the form (OFFSET NAME).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1293 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
1294 A negative value means west of Greenwich.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1295 NAME is a string giving the name of the time zone.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1296 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
1297 instead of using the current time. The argument should have the form:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1298 (HIGH . LOW)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1299 or the form:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1300 (HIGH LOW . IGNORED).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1301 Thus, you can use times obtained from `current-time'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1302 and from `file-attributes'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1303
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1304 Some operating systems cannot provide all this information to Emacs;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1305 in this case, `current-time-zone' returns a list containing nil for
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1306 the data it can't find.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1307 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1308 (specified_time))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1309 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1310 time_t value;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1311 struct tm *t = NULL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1312
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1313 if (lisp_to_time (specified_time, &value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1314 && (t = gmtime (&value)) != 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1315 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1316 struct tm gmt = *t; /* Make a copy, in case localtime modifies *t. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1317 long offset;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1318 Extbyte *s;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1319 Lisp_Object tem;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1320
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1321 t = localtime (&value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1322 offset = difftm (t, &gmt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1323 s = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1324 #ifdef HAVE_TM_ZONE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1325 if (t->tm_zone)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1326 s = (Extbyte *) t->tm_zone;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1327 #else /* not HAVE_TM_ZONE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1328 #ifdef HAVE_TZNAME
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1329 if (t->tm_isdst == 0 || t->tm_isdst == 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1330 s = tzname[t->tm_isdst];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1331 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1332 #endif /* not HAVE_TM_ZONE */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1333 if (s)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1334 tem = build_ext_string (s, Qnative);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1335 else
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1336 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1337 Intbyte buf[6];
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1338
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1339 /* No local time zone name is available; use "+-NNNN" instead. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1340 int am = (offset < 0 ? -offset : offset) / 60;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1341 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
1342 am%60);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1343 tem = build_intstring (buf);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1344 }
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1345 return list2 (make_int (offset), tem);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1346 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1347 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1348 return list2 (Qnil, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1349 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1350
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1351 #ifdef LOCALTIME_CACHE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1352
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1353 /* These two values are known to load tz files in buggy implementations,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1354 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
1355 Their values shouldn't matter in non-buggy implementations.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1356 We don't use string literals for these strings,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1357 since if a string in the environment is in readonly
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1358 storage, it runs afoul of bugs in SVR4 and Solaris 2.3.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1359 See Sun bugs 1113095 and 1114114, ``Timezone routines
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1360 improperly modify environment''. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1361
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1362 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
1363 static Char_ASCII set_time_zone_rule_tz2[] = "TZ=GMT+1";
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1364
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1365 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1366
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1367 /* Set the local time zone rule to TZSTRING.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1368 This allocates memory into `environ', which it is the caller's
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1369 responsibility to free. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1370 static void
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1371 set_time_zone_rule (Extbyte *tzstring)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1372 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1373 int envptrs;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1374 Extbyte **from, **to, **newenv;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1375
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1376 for (from = environ; *from; from++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1377 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1378 envptrs = from - environ + 2;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1379 newenv = to = (Extbyte **) xmalloc (envptrs * sizeof (Extbyte *)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1380 + (tzstring ? strlen (tzstring) + 4 : 0));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1381 if (tzstring)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1382 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1383 Extbyte *t = (Extbyte *) (to + envptrs);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1384 strcpy (t, "TZ=");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1385 strcat (t, tzstring);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1386 *to++ = t;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1387 }
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 for (from = environ; *from; from++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1390 if (strncmp (*from, "TZ=", 3) != 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1391 *to++ = *from;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1392 *to = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1393
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1394 environ = newenv;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1395
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1396 #ifdef LOCALTIME_CACHE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1397 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1398 /* 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
1399 "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
1400 "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
1401 its original value, the last change is (incorrectly) ignored.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1402 Also, if TZ changes twice in succession to values that do
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1403 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
1404 The following code works around these bugs. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1405
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1406 if (tzstring)
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 /* Temporarily set TZ to a value that loads a tz file
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1409 and that differs from tzstring. */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1410 Extbyte *tz = *newenv;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1411 *newenv = (strcmp (tzstring, set_time_zone_rule_tz1 + 3) == 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1412 ? set_time_zone_rule_tz2 : set_time_zone_rule_tz1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1413 tzset ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1414 *newenv = tz;
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 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1417 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1418 /* The implied tzstring is unknown, so temporarily set TZ to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1419 two different values that each load a tz file. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1420 *to = set_time_zone_rule_tz1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1421 to[1] = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1422 tzset ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1423 *to = set_time_zone_rule_tz2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1424 tzset ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1425 *to = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1426 }
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 /* Now TZ has the desired value, and tzset can be invoked safely. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1429 }
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 tzset ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1432 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1433 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1434
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1435 DEFUN ("set-time-zone-rule", Fset_time_zone_rule, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1436 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
1437 If TZ is nil, use implementation-defined default time zone information.
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 (tz))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1440 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1441 Extbyte *tzstring;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1442
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1443 if (NILP (tz))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1444 tzstring = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1445 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1446 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1447 CHECK_STRING (tz);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1448 LISP_STRING_TO_EXTERNAL (tz, tzstring, Qnative);
428
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1451 set_time_zone_rule (tzstring);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1452 if (environbuf)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1453 xfree (environbuf);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1454 environbuf = environ;
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 return Qnil;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1459
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1460 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1461 buffer_insert1 (struct buffer *buf, Lisp_Object arg)
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 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1464 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1465 GCPRO1 (arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1466 retry:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1467 if (CHAR_OR_CHAR_INTP (arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1468 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1469 buffer_insert_emacs_char (buf, XCHAR_OR_CHAR_INT (arg));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1470 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1471 else if (STRINGP (arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1472 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1473 buffer_insert_lisp_string (buf, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1474 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1475 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1476 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1477 arg = wrong_type_argument (Qchar_or_string_p, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1478 goto retry;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1479 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1480 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1481 }
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1484 /* Callers passing one argument to Finsert need not gcpro the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1485 argument "array", since the only element of the array will
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1486 not be used after calling insert_emacs_char or insert_lisp_string,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1487 so we don't care if it gets trashed. */
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", Finsert, 0, MANY, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1490 Insert the arguments, either strings or characters, at point.
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 remain before the text.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1493 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
1494 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1495 (int nargs, Lisp_Object *args))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1496 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1497 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1498 REGISTER int argnum;
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 buffer_insert1 (current_buffer, args[argnum]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1503 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1504
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1505 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1506 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1507
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1508 DEFUN ("insert-before-markers", Finsert_before_markers, 0, MANY, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1509 Insert strings or characters at point, relocating markers after the text.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1510 Point moves forward so that it ends up after the inserted text.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1511 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
1512 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1513 (int nargs, Lisp_Object *args))
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 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1516 REGISTER int argnum;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1517 REGISTER Lisp_Object tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1518
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1519 for (argnum = 0; argnum < nargs; argnum++)
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 tem = args[argnum];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1522 retry:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1523 if (CHAR_OR_CHAR_INTP (tem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1524 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1525 buffer_insert_emacs_char_1 (current_buffer, -1,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1526 XCHAR_OR_CHAR_INT (tem),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1527 INSDEL_BEFORE_MARKERS);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1528 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1529 else if (STRINGP (tem))
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 buffer_insert_lisp_string_1 (current_buffer, -1, tem,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1532 INSDEL_BEFORE_MARKERS);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1533 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1534 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1535 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1536 tem = wrong_type_argument (Qchar_or_string_p, tem);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1537 goto retry;
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 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1540 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1541 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1542
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1543 DEFUN ("insert-string", Finsert_string, 1, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1544 Insert STRING into BUFFER at BUFFER's point.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1545 Point moves forward so that it ends up after the inserted text.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1546 Any other markers at the point of insertion remain before the text.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1547 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
1548 BUFFER defaults to the current buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1549 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1550 (string, buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1551 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1552 struct buffer *b = decode_buffer (buffer, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1553 CHECK_STRING (string);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1554 buffer_insert_lisp_string (b, string);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1555 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1556 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1557
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1558 /* Third argument in FSF is INHERIT:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1559
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1560 "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
1561 from adjoining text, if those properties are sticky."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1562
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1563 Jamie thinks this is bogus. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1564
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1565
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1566 DEFUN ("insert-char", Finsert_char, 1, 4, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1567 Insert COUNT copies of CHARACTER into BUFFER.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1568 Point and all markers are affected as in the function `insert'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1569 COUNT defaults to 1 if omitted.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1570 The optional third arg IGNORED is INHERIT under FSF Emacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1571 This is highly bogus, however, and XEmacs always behaves as if
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1572 `t' were passed to INHERIT.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1573 The optional fourth arg BUFFER specifies the buffer to insert the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1574 text into. If BUFFER is nil, the current buffer is assumed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1575 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1576 (character, count, ignored, buffer))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1577 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1578 /* This function can GC */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
1579 REGISTER Intbyte *string;
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 800
diff changeset
1580 REGISTER Bytecount slen;
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 800
diff changeset
1581 REGISTER Bytecount i, j;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1582 REGISTER Bytecount n;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1583 REGISTER Bytecount charlen;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
1584 Intbyte str[MAX_EMCHAR_LEN];
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1585 struct buffer *b = decode_buffer (buffer, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1586 int cou;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1587
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1588 CHECK_CHAR_COERCE_INT (character);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1589 if (NILP (count))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1590 cou = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1591 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1592 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1593 CHECK_INT (count);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1594 cou = XINT (count);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1595 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1596
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1597 charlen = set_charptr_emchar (str, XCHAR (character));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1598 n = cou * charlen;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1599 if (n <= 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1600 return Qnil;
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 800
diff changeset
1601 slen = min (n, (Bytecount) 768);
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
1602 string = alloca_array (Intbyte, slen);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1603 /* 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
1604 for (i = 0; i + charlen <= slen; i += charlen)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1605 for (j = 0; j < charlen; j++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1606 string[i + j] = str[j];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1607 slen = i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1608 while (n >= slen)
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 buffer_insert_raw_string (b, string, slen);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1611 n -= slen;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1612 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1613 if (n > 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1614 #if 0 /* FSFmacs bogosity */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1615 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1616 if (!NILP (inherit))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1617 insert_and_inherit (string, n);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1618 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1619 insert (string, n);
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 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1622 buffer_insert_raw_string (b, string, n);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1623 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1624
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1625 return Qnil;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1628
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1629 /* Making strings from buffer contents. */
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 DEFUN ("buffer-substring", Fbuffer_substring, 0, 3, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1632 Return the contents of part of BUFFER as a string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1633 The two arguments START and END are character positions;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1634 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
1635 and end of BUFFER, respectively.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1636 If there are duplicable extents in the region, the string remembers
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1637 them in its extent data.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1638 If BUFFER is nil, the current buffer is assumed.
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 (start, end, buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1641 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1642 /* This function can GC */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
1643 Charbpos begv, zv;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1644 struct buffer *b = decode_buffer (buffer, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1645
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1646 get_buffer_range_char (b, start, end, &begv, &zv, GB_ALLOW_NIL);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1647 return make_string_from_buffer (b, begv, zv - begv);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1648 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1649
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1650 /* It might make more sense to name this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1651 `buffer-substring-no-extents', but this name is FSFmacs-compatible,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1652 and what the function does is probably good enough for what the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1653 user-code will typically want to use it for. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1654 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
1655 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
1656 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1657 (start, end, buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1658 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1659 /* This function can GC */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
1660 Charbpos begv, zv;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1661 struct buffer *b = decode_buffer (buffer, 1);
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 get_buffer_range_char (b, start, end, &begv, &zv, GB_ALLOW_NIL);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1664 return make_string_from_buffer_no_extents (b, begv, zv - begv);
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1667 DEFUN ("insert-buffer-substring", Finsert_buffer_substring, 1, 3, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1668 Insert before point a substring of the contents of buffer BUFFER.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1669 BUFFER may be a buffer or a buffer name.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1670 Arguments START and END are character numbers specifying the substring.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1671 They default to the beginning and the end of BUFFER.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1672 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1673 (buffer, start, end))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1674 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1675 /* This function can GC */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
1676 Charbpos b, e;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1677 struct buffer *bp;
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 bp = XBUFFER (get_buffer (buffer, 1));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1680 get_buffer_range_char (bp, start, end, &b, &e, GB_ALLOW_NIL);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1681
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1682 if (b < e)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1683 buffer_insert_from_buffer (current_buffer, bp, b, e - b);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1684
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1685 return Qnil;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1688 DEFUN ("compare-buffer-substrings", Fcompare_buffer_substrings, 6, 6, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1689 Compare two substrings of two buffers; return result as number.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1690 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
1691 +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
1692 Each substring is represented as three arguments: BUFFER, START and END.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1693 That makes six args in all, three for each substring.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1694
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1695 The value of `case-fold-search' in the current buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1696 determines whether case is significant or ignored.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1697 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1698 (buffer1, start1, end1, buffer2, start2, end2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1699 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
1700 Charbpos begp1, endp1, begp2, endp2;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1701 REGISTER Charcount len1, len2, length, i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1702 struct buffer *bp1, *bp2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1703 Lisp_Object trt = ((!NILP (current_buffer->case_fold_search)) ?
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1704 XCASE_TABLE_CANON (current_buffer->case_table) : Qnil);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1705
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1706 /* Find the first buffer and its substring. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1707
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1708 bp1 = decode_buffer (buffer1, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1709 get_buffer_range_char (bp1, start1, end1, &begp1, &endp1, GB_ALLOW_NIL);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1710
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1711 /* Likewise for second substring. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1712
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1713 bp2 = decode_buffer (buffer2, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1714 get_buffer_range_char (bp2, start2, end2, &begp2, &endp2, GB_ALLOW_NIL);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1715
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1716 len1 = endp1 - begp1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1717 len2 = endp2 - begp2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1718 length = len1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1719 if (len2 < length)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1720 length = len2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1721
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1722 for (i = 0; i < length; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1723 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1724 Emchar c1 = BUF_FETCH_CHAR (bp1, begp1 + i);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1725 Emchar c2 = BUF_FETCH_CHAR (bp2, begp2 + i);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1726 if (!NILP (trt))
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 c1 = TRT_TABLE_OF (trt, c1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1729 c2 = TRT_TABLE_OF (trt, c2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1730 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1731 if (c1 < c2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1732 return make_int (- 1 - i);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1733 if (c1 > c2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1734 return make_int (i + 1);
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 /* The strings match as far as they go.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1738 If one is shorter, that one is less. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1739 if (length < len1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1740 return make_int (length + 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1741 else if (length < len2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1742 return make_int (- length - 1);
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 /* Same length too => they are equal. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1745 return Qzero;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1746 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1747
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1748
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1749 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1750 subst_char_in_region_unwind (Lisp_Object arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1751 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1752 XBUFFER (XCAR (arg))->undo_list = XCDR (arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1753 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1754 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1755
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1756 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1757 subst_char_in_region_unwind_1 (Lisp_Object arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1758 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1759 XBUFFER (XCAR (arg))->filename = XCDR (arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1760 return Qnil;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1763 DEFUN ("subst-char-in-region", Fsubst_char_in_region, 4, 5, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1764 From START to END, replace FROMCHAR with TOCHAR each time it occurs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1765 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
1766 and don't mark the buffer as really changed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1767 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1768 (start, end, fromchar, tochar, noundo))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1769 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1770 /* This function can GC */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
1771 Charbpos pos, stop;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1772 Emchar fromc, toc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1773 int mc_count;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1774 struct buffer *buf = current_buffer;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1775 int count = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1776
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1777 get_buffer_range_char (buf, start, end, &pos, &stop, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1778 CHECK_CHAR_COERCE_INT (fromchar);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1779 CHECK_CHAR_COERCE_INT (tochar);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1780
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1781 fromc = XCHAR (fromchar);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1782 toc = XCHAR (tochar);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1783
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1784 /* 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
1785 That's faster than getting rid of things,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1786 and it prevents even the entry for a first change.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1787 Also inhibit locking the file. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1788 if (!NILP (noundo))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1789 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1790 record_unwind_protect (subst_char_in_region_unwind,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1791 Fcons (Fcurrent_buffer (), buf->undo_list));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1792 buf->undo_list = Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1793 /* Don't do file-locking. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1794 record_unwind_protect (subst_char_in_region_unwind_1,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1795 Fcons (Fcurrent_buffer (), buf->filename));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1796 buf->filename = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1797 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1798
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1799 mc_count = begin_multiple_change (buf, pos, stop);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1800 while (pos < stop)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1801 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1802 if (BUF_FETCH_CHAR (buf, pos) == fromc)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1803 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1804 /* There used to be some code here that set the buffer to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1805 unmodified if NOUNDO was specified and there was only
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1806 one change to the buffer since it was last saved.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1807 This is a crock of shit, so I'm not duplicating this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1808 behavior. I think this was left over from when
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1809 prepare_to_modify_buffer() actually bumped MODIFF,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1810 so that code was supposed to undo this change. --ben */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1811 buffer_replace_char (buf, pos, toc, !NILP (noundo), 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1812
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1813 /* 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
1814 modified. In reality that needs to happen externally
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1815 only. Internally redisplay needs to know that the actual
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1816 contents it should be displaying have changed. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1817 if (!NILP (noundo))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1818 Fset_buffer_modified_p (Fbuffer_modified_p (Qnil), Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1819 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1820 pos++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1821 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1822 end_multiple_change (buf, mc_count);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1823
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
1824 unbind_to (count);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1825 return Qnil;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1828 /* #### Shouldn't this also accept a BUFFER argument, in the good old
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1829 XEmacs tradition? */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1830 DEFUN ("translate-region", Ftranslate_region, 3, 3, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1831 Translate characters from START to END according to TABLE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1832
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1833 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
1834 character with code N.
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 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
1837 with code N. The values of elements may be characters, strings, or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1838 nil (nil meaning don't replace.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1839
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1840 If TABLE is a char-table, its elements describe the mapping between
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1841 characters and their replacements. The char-table should be of type
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1842 `char' or `generic'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1843
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1844 Returns the number of substitutions performed.
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 (start, end, table))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1847 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1848 /* This function can GC */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
1849 Charbpos pos, stop; /* Limits of the region. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1850 int cnt = 0; /* Number of changes made. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1851 int mc_count;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1852 struct buffer *buf = current_buffer;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1853 Emchar oc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1854
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1855 get_buffer_range_char (buf, start, end, &pos, &stop, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1856 mc_count = begin_multiple_change (buf, pos, stop);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1857 if (STRINGP (table))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1858 {
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
1859 Charcount size = XSTRING_CHAR_LENGTH (table);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1860 #ifdef MULE
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
1861 /* Under Mule, XSTRING_CHAR(n) is O(n), so for large tables or
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1862 large regions it makes sense to create an array of Emchars. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1863 if (size * (stop - pos) > 65536)
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 Emchar *etable = alloca_array (Emchar, size);
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
1866 convert_intbyte_string_into_emchar_string
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
1867 (XSTRING_DATA (table), XSTRING_LENGTH (table), etable);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1868 for (; pos < stop && (oc = BUF_FETCH_CHAR (buf, pos), 1); pos++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1869 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1870 if (oc < size)
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 Emchar nc = etable[oc];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1873 if (nc != oc)
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 buffer_replace_char (buf, pos, nc, 0, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1876 ++cnt;
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 }
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 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1882 #endif /* MULE */
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 {
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
1888 Emchar nc = XSTRING_CHAR (table, oc);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1889 if (nc != oc)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1890 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1891 buffer_replace_char (buf, pos, nc, 0, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1892 ++cnt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1893 }
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 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1896 }
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 else if (VECTORP (table))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1899 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1900 Charcount size = XVECTOR_LENGTH (table);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1901 Lisp_Object *vtable = XVECTOR_DATA (table);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1902
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1903 for (; pos < stop && (oc = BUF_FETCH_CHAR (buf, pos), 1); pos++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1904 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1905 if (oc < size)
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 Lisp_Object replacement = vtable[oc];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1908 retry:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1909 if (CHAR_OR_CHAR_INTP (replacement))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1910 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1911 Emchar nc = XCHAR_OR_CHAR_INT (replacement);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1912 if (nc != oc)
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 buffer_replace_char (buf, pos, nc, 0, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1915 ++cnt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1916 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1917 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1918 else if (STRINGP (replacement))
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 Charcount incr = XSTRING_CHAR_LENGTH (replacement) - 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1921 buffer_delete_range (buf, pos, pos + 1, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1922 buffer_insert_lisp_string_1 (buf, pos, replacement, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1923 pos += incr, stop += incr;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1924 ++cnt;
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 else if (!NILP (replacement))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1927 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1928 replacement = wrong_type_argument (Qchar_or_string_p, replacement);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1929 goto retry;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1930 }
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 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1934 else if (CHAR_TABLEP (table)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1935 && (XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_GENERIC
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1936 || XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_CHAR))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1937 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 434
diff changeset
1938 Lisp_Char_Table *ctable = XCHAR_TABLE (table);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1939
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1940 for (; pos < stop && (oc = BUF_FETCH_CHAR (buf, pos), 1); pos++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1941 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1942 Lisp_Object replacement = get_char_table (oc, ctable);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1943 retry2:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1944 if (CHAR_OR_CHAR_INTP (replacement))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1945 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1946 Emchar nc = XCHAR_OR_CHAR_INT (replacement);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1947 if (nc != oc)
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 buffer_replace_char (buf, pos, nc, 0, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1950 ++cnt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1951 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1952 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1953 else if (STRINGP (replacement))
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 Charcount incr = XSTRING_CHAR_LENGTH (replacement) - 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1956 buffer_delete_range (buf, pos, pos + 1, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1957 buffer_insert_lisp_string_1 (buf, pos, replacement, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1958 pos += incr, stop += incr;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1959 ++cnt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1960 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1961 else if (!NILP (replacement))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1962 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1963 replacement = wrong_type_argument (Qchar_or_string_p, replacement);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1964 goto retry2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1965 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1966 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1967 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1968 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1969 dead_wrong_type_argument (Qstringp, table);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1970 end_multiple_change (buf, mc_count);
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 return make_int (cnt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1973 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1974
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1975 DEFUN ("delete-region", Fdelete_region, 2, 3, "r", /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1976 Delete the text between point and mark.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1977 When called from a program, expects two arguments START and END
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1978 \(integers or markers) specifying the stretch to be deleted.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1979 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
1980 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1981 (start, end, buffer))
428
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 /* This function can GC */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
1984 Charbpos bp_start, bp_end;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1985 struct buffer *buf = decode_buffer (buffer, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1986
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1987 get_buffer_range_char (buf, start, end, &bp_start, &bp_end, 0);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1988 buffer_delete_range (buf, bp_start, bp_end, 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1989 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1990 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1991
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1992 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1993 widen_buffer (struct buffer *b, int no_clip)
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 if (BUF_BEGV (b) != BUF_BEG (b))
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 clip_changed = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1998 SET_BOTH_BUF_BEGV (b, BUF_BEG (b), BI_BUF_BEG (b));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1999 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2000 if (BUF_ZV (b) != BUF_Z (b))
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 clip_changed = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2003 SET_BOTH_BUF_ZV (b, BUF_Z (b), BI_BUF_Z (b));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2004 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2005 if (clip_changed)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2006 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2007 if (!no_clip)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2008 MARK_CLIP_CHANGED;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2009 /* Changing the buffer bounds invalidates any recorded current
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2010 column. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2011 invalidate_current_column ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2012 narrow_line_number_cache (b);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2013 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2014 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2015
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2016 DEFUN ("widen", Fwiden, 0, 1, "", /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2017 Remove restrictions (narrowing) from BUFFER.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2018 This allows the buffer's full text to be seen and edited.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2019 If BUFFER is nil, the current buffer is assumed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2020 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2021 (buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2022 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2023 struct buffer *b = decode_buffer (buffer, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2024 widen_buffer (b, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2025 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2026 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2027
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2028 DEFUN ("narrow-to-region", Fnarrow_to_region, 2, 3, "r", /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2029 Restrict editing in BUFFER to the current region.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2030 The rest of the text becomes temporarily invisible and untouchable
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2031 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
2032 text is included in the file. \\[widen] makes all visible again.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2033 If BUFFER is nil, the current buffer is assumed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2034 See also `save-restriction'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2035
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2036 When calling from a program, pass two arguments; positions (integers
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2037 or markers) bounding the text that should remain visible.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2038 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2039 (start, end, buffer))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2040 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
2041 Charbpos bp_start, bp_end;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2042 struct buffer *buf = decode_buffer (buffer, 1);
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
2043 Bytebpos bi_start, bi_end;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2044
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2045 get_buffer_range_char (buf, start, end, &bp_start, &bp_end,
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2046 GB_ALLOW_PAST_ACCESSIBLE);
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
2047 bi_start = charbpos_to_bytebpos (buf, bp_start);
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
2048 bi_end = charbpos_to_bytebpos (buf, bp_end);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2049
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2050 SET_BOTH_BUF_BEGV (buf, bp_start, bi_start);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2051 SET_BOTH_BUF_ZV (buf, bp_end, bi_end);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2052 if (BUF_PT (buf) < bp_start)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2053 BUF_SET_PT (buf, bp_start);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2054 if (BUF_PT (buf) > bp_end)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2055 BUF_SET_PT (buf, bp_end);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2056 MARK_CLIP_CHANGED;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2057 /* Changing the buffer bounds invalidates any recorded current column. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2058 invalidate_current_column ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2059 narrow_line_number_cache (buf);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2060 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2061 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2062
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2063 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2064 save_restriction_save (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2065 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2066 Lisp_Object bottom, top;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2067 /* Note: I tried using markers here, but it does not win
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2068 because insertion at the end of the saved region
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2069 does not advance mh and is considered "outside" the saved region. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2070 bottom = make_int (BUF_BEGV (current_buffer) - BUF_BEG (current_buffer));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2071 top = make_int (BUF_Z (current_buffer) - BUF_ZV (current_buffer));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2072
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2073 return noseeum_cons (Fcurrent_buffer (), noseeum_cons (bottom, top));
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2076 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2077 save_restriction_restore (Lisp_Object data)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2078 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2079 struct buffer *buf;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2080 Charcount newhead, newtail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2081 Lisp_Object tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2082 int local_clip_changed = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2083
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2084 buf = XBUFFER (XCAR (data));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2085 if (!BUFFER_LIVE_P (buf))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2086 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2087 /* someone could have killed the buffer in the meantime ... */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2088 free_cons (XCONS (XCDR (data)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2089 free_cons (XCONS (data));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2090 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2091 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2092 tem = XCDR (data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2093 newhead = XINT (XCAR (tem));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2094 newtail = XINT (XCDR (tem));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2095
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2096 free_cons (XCONS (XCDR (data)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2097 free_cons (XCONS (data));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2098
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2099 if (newhead + newtail > BUF_Z (buf) - BUF_BEG (buf))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2100 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2101 newhead = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2102 newtail = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2103 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2104
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2105 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
2106 Charbpos start, end;
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
2107 Bytebpos bi_start, bi_end;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2108
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2109 start = BUF_BEG (buf) + newhead;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2110 end = BUF_Z (buf) - newtail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2111
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
2112 bi_start = charbpos_to_bytebpos (buf, start);
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
2113 bi_end = charbpos_to_bytebpos (buf, end);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2114
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2115 if (BUF_BEGV (buf) != start)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2116 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2117 local_clip_changed = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2118 SET_BOTH_BUF_BEGV (buf, start, bi_start);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2119 narrow_line_number_cache (buf);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2120 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2121 if (BUF_ZV (buf) != end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2122 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2123 local_clip_changed = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2124 SET_BOTH_BUF_ZV (buf, end, bi_end);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2125 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2126 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2127 if (local_clip_changed)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2128 MARK_CLIP_CHANGED;
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 /* If point is outside the new visible range, move it inside. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2131 BUF_SET_PT (buf,
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
2132 charbpos_clip_to_bounds (BUF_BEGV (buf),
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2133 BUF_PT (buf),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2134 BUF_ZV (buf)));
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 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2137 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2138
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2139 DEFUN ("save-restriction", Fsave_restriction, 0, UNEVALLED, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2140 Execute BODY, saving and restoring current buffer's restrictions.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2141 The buffer's restrictions make parts of the beginning and end invisible.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2142 \(They are set up with `narrow-to-region' and eliminated with `widen'.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2143 This special form, `save-restriction', saves the current buffer's restrictions
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2144 when it is entered, and restores them when it is exited.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2145 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
2146 The old restrictions settings are restored
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2147 even in case of abnormal exit (throw or error).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2148
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2149 The value returned is the value of the last form in BODY.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2150
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2151 `save-restriction' can get confused if, within the BODY, you widen
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2152 and then make changes outside the area within the saved restrictions.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2153
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2154 Note: if you are using both `save-excursion' and `save-restriction',
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2155 use `save-excursion' outermost:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2156 (save-excursion (save-restriction ...))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2157 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2158 (body))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2159 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2160 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2161 int speccount = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2162
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2163 record_unwind_protect (save_restriction_restore, save_restriction_save ());
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2164
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2165 return unbind_to_1 (speccount, Fprogn (body));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2166 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2167
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2168
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2169 DEFUN ("format", Fformat, 1, MANY, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2170 Format a string out of a control-string and arguments.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2171 The first argument is a control string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2172 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
2173 It may contain %-sequences meaning to substitute the next argument.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2174 %s means print all objects as-is, using `princ'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2175 %S means print all objects as s-expressions, using `prin1'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2176 %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
2177 %X uppercase hex).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2178 %c means print as a single character.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2179 %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
2180 %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
2181 (e.g. 7.85200e+03).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2182 %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
2183 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
2184 trailing zeroes are removed from the fractional part.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2185 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
2186 converted to an integer or a floating-point number as necessary.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2187
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2188 %$ means reposition to read a specific numbered argument; for example,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2189 %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
2190 and the next format directive would use the fourth argument, the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2191 following one the fifth argument, etc. (There must be a positive integer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2192 between the % and the $).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2193 Zero or more of the flag characters `-', `+', ` ', `0', and `#' may be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2194 specified between the optional repositioning spec and the conversion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2195 character; see below.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2196 An optional minimum field width may be specified after any flag characters
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2197 and before the conversion character; it specifies the minimum number of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2198 characters that the converted argument will take up. Padding will be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2199 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
2200 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
2201 is specified.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2202 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
2203 been specified as an argument. Any repositioning specification that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2204 would normally specify the argument to be converted will now specify
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2205 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
2206 to be converted. If there is no repositioning specification, the normal
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2207 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
2208 argument after the field width argument unless the precision is also
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2209 specified as `*' (see below).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2210
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2211 An optional period character and precision may be specified after any
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2212 minimum field width. It specifies the minimum number of digits to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2213 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
2214 on the left with zeroes as necessary); the number of digits printed
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2215 after the decimal point for %f, %e, and %E conversions; the number
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2216 of significant digits printed in %g and %G conversions; and the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2217 maximum number of non-padding characters printed in %s and %S
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2218 conversions. The default precision for floating-point conversions
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2219 is six.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2220 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
2221 specified as an argument. The argument used will be the next argument
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2222 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
2223 specified as an argument, any repositioning specification that would
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2224 normally specify the argument to be converted will now specify where to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2225 find the precision argument. If there is no repositioning specification,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2226 the normal next argument is used.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2227
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2228 The ` ' and `+' flags mean prefix non-negative numbers with a space or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2229 plus sign, respectively.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2230 The `#' flag means print numbers in an alternate, more verbose format:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2231 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
2232 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
2233 numbers are printed after it; and trailing zeroes are not omitted in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2234 %g and %G conversions.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2235
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2236 Use %% to put a single % into the output.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2237 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2238 (int nargs, Lisp_Object *args))
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 /* It should not be necessary to GCPRO ARGS, because
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2241 the caller in the interpreter should take care of that. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2242
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2243 CHECK_STRING (args[0]);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2244 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
2245 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2246
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2247
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2248 DEFUN ("char-equal", Fchar_equal, 2, 3, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2249 Return t if two characters match, optionally ignoring case.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2250 Both arguments must be characters (i.e. NOT integers).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2251 Case is ignored if `case-fold-search' is non-nil in BUFFER.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2252 If BUFFER is nil, the current buffer is assumed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2253 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2254 (character1, character2, buffer))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2255 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2256 Emchar x1, x2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2257 struct buffer *b = decode_buffer (buffer, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2258
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2259 CHECK_CHAR_COERCE_INT (character1);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2260 CHECK_CHAR_COERCE_INT (character2);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2261 x1 = XCHAR (character1);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2262 x2 = XCHAR (character2);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2263
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2264 return (!NILP (b->case_fold_search)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2265 ? DOWNCASE (b, x1) == DOWNCASE (b, x2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2266 : x1 == x2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2267 ? Qt : Qnil;
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
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2270 DEFUN ("char=", Fchar_Equal, 2, 2, 0, /*
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2271 Return t if two characters match, case is significant.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2272 Both arguments must be characters (i.e. NOT integers).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2273 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2274 (character1, character2))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2275 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2276 CHECK_CHAR_COERCE_INT (character1);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2277 CHECK_CHAR_COERCE_INT (character2);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2278
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2279 return EQ (character1, character2) ? Qt : Qnil;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2280 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2281
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2282 #if 0 /* Undebugged FSFmacs code */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2283 /* Transpose the markers in two regions of the current buffer, and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2284 adjust the ones between them if necessary (i.e.: if the regions
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2285 differ in size).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2286
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2287 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
2288 appropriate amount to some, subtracting from some, and leaving the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2289 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
2290
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2291 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
2292
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2293 void
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
2294 transpose_markers (Charbpos start1, Charbpos end1, Charbpos start2, Charbpos end2)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2295 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2296 Charcount amt1, amt2, diff;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2297 Lisp_Object marker;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2298 struct buffer *buf = current_buffer;
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 /* Update point as if it were a marker. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2301 if (BUF_PT (buf) < start1)
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 else if (BUF_PT (buf) < end1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2304 BUF_SET_PT (buf, BUF_PT (buf) + (end2 - end1));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2305 else if (BUF_PT (buf) < start2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2306 BUF_SET_PT (buf, BUF_PT (buf) + (end2 - start2) - (end1 - start1));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2307 else if (BUF_PT (buf) < end2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2308 BUF_SET_PT (buf, BUF_PT (buf) - (start2 - start1));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2309
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2310 /* 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
2311 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
2312 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
2313 and that places it `inside' the interval, for our purposes. The amount
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2314 of adjustment is nontrivial if there's a `denormalized' marker whose
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2315 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
2316 the dirty work to Fmarker_position, below. */
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 /* The difference between the region's lengths */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2319 diff = (end2 - start2) - (end1 - start1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2320
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2321 /* 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
2322 * region plus the distance between the regions.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2323 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2324 amt1 = (end2 - start2) + (start2 - end1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2325 amt2 = (end1 - start1) + (start2 - end1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2326
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2327 for (marker = BUF_MARKERS (buf); !NILP (marker);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2328 marker = XMARKER (marker)->chain)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2329 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
2330 Charbpos mpos = marker_position (marker);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2331 if (mpos >= start1 && mpos < end2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2332 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2333 if (mpos < end1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2334 mpos += amt1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2335 else if (mpos < start2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2336 mpos += diff;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2337 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2338 mpos -= amt2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2339 set_marker_position (marker, mpos);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2340 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2341 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2342 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2343
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2344 #endif /* 0 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2345
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2346 DEFUN ("transpose-regions", Ftranspose_regions, 4, 5, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2347 Transpose region START1 to END1 with START2 to END2.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2348 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
2349 never changed in a transposition.
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 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
2352 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
2353 this function always acts as if LEAVE-MARKERS is non-nil.)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2354
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2355 Transposing beyond buffer boundaries is an error.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2356 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2357 (start1, end1, start2, end2, leave_markers))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2358 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
2359 Charbpos startr1, endr1, startr2, endr2;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2360 Charcount len1, len2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2361 Lisp_Object string1, string2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2362 struct buffer *buf = current_buffer;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2363
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2364 get_buffer_range_char (buf, start1, end1, &startr1, &endr1, 0);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2365 get_buffer_range_char (buf, start2, end2, &startr2, &endr2, 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2366
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2367 len1 = endr1 - startr1;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2368 len2 = endr2 - startr2;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2369
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2370 if (startr2 < endr1)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 487
diff changeset
2371 invalid_argument ("transposed regions not properly ordered", Qunbound);
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2372 else if (startr1 == endr1 || startr2 == endr2)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 487
diff changeset
2373 invalid_argument ("transposed region may not be of length 0", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2374
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2375 string1 = make_string_from_buffer (buf, startr1, len1);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2376 string2 = make_string_from_buffer (buf, startr2, len2);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2377 buffer_delete_range (buf, startr2, endr2, 0);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2378 buffer_insert_lisp_string_1 (buf, startr2, string1, 0);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2379 buffer_delete_range (buf, startr1, endr1, 0);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2380 buffer_insert_lisp_string_1 (buf, startr1, string2, 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2381
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2382 /* In FSFmacs there is a whole bunch of really ugly code here
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2383 to attempt to transpose the regions without using up any
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2384 extra memory. Although the intent may be good, the result
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2385 was highly bogus. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2386
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2387 return Qnil;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2390
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2391 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2392 /* initialization */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2393 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2394
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2395 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2396 syms_of_editfns (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2397 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 487
diff changeset
2398 DEFSYMBOL (Qpoint);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 487
diff changeset
2399 DEFSYMBOL (Qmark);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 487
diff changeset
2400 DEFSYMBOL (Qregion_beginning);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 487
diff changeset
2401 DEFSYMBOL (Qregion_end);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 487
diff changeset
2402 DEFSYMBOL (Qformat);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 487
diff changeset
2403 DEFSYMBOL (Quser_files_and_directories);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2404
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2405 DEFSUBR (Fchar_equal);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2406 DEFSUBR (Fchar_Equal);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2407 DEFSUBR (Fgoto_char);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2408 DEFSUBR (Fstring_to_char);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2409 DEFSUBR (Fchar_to_string);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2410 DEFSUBR (Fbuffer_substring);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2411 DEFSUBR (Fbuffer_substring_no_properties);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2412
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2413 DEFSUBR (Fpoint_marker);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2414 DEFSUBR (Fmark_marker);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2415 DEFSUBR (Fpoint);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2416 DEFSUBR (Fregion_beginning);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2417 DEFSUBR (Fregion_end);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2418 DEFSUBR (Fsave_excursion);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2419 DEFSUBR (Fsave_current_buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2420
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2421 DEFSUBR (Fbuffer_size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2422 DEFSUBR (Fpoint_max);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2423 DEFSUBR (Fpoint_min);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2424 DEFSUBR (Fpoint_min_marker);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2425 DEFSUBR (Fpoint_max_marker);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2426
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2427 DEFSUBR (Fbobp);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2428 DEFSUBR (Feobp);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2429 DEFSUBR (Fbolp);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2430 DEFSUBR (Feolp);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2431 DEFSUBR (Ffollowing_char);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2432 DEFSUBR (Fpreceding_char);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2433 DEFSUBR (Fchar_after);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2434 DEFSUBR (Fchar_before);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2435 DEFSUBR (Finsert);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2436 DEFSUBR (Finsert_string);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2437 DEFSUBR (Finsert_before_markers);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2438 DEFSUBR (Finsert_char);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2439
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2440 DEFSUBR (Ftemp_directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2441 DEFSUBR (Fuser_login_name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2442 DEFSUBR (Fuser_real_login_name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2443 DEFSUBR (Fuser_uid);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2444 DEFSUBR (Fuser_real_uid);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2445 DEFSUBR (Fuser_full_name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2446 DEFSUBR (Fuser_home_directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2447 DEFSUBR (Femacs_pid);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2448 DEFSUBR (Fcurrent_time);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2449 DEFSUBR (Fcurrent_process_time);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2450 DEFSUBR (Fformat_time_string);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2451 DEFSUBR (Fdecode_time);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2452 DEFSUBR (Fencode_time);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2453 DEFSUBR (Fcurrent_time_string);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2454 DEFSUBR (Fcurrent_time_zone);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2455 DEFSUBR (Fset_time_zone_rule);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2456 DEFSUBR (Fsystem_name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2457 DEFSUBR (Fformat);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2458
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2459 DEFSUBR (Finsert_buffer_substring);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2460 DEFSUBR (Fcompare_buffer_substrings);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2461 DEFSUBR (Fsubst_char_in_region);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2462 DEFSUBR (Ftranslate_region);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2463 DEFSUBR (Fdelete_region);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2464 DEFSUBR (Fwiden);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2465 DEFSUBR (Fnarrow_to_region);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2466 DEFSUBR (Fsave_restriction);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2467 DEFSUBR (Ftranspose_regions);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2468
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 487
diff changeset
2469 DEFSYMBOL (Qzmacs_update_region);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 487
diff changeset
2470 DEFSYMBOL (Qzmacs_deactivate_region);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 487
diff changeset
2471 DEFSYMBOL (Qzmacs_region_buffer);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2472 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2473
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2474 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2475 vars_of_editfns (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2476 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2477 staticpro (&Vsystem_name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2478 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2479 staticpro (&Vuser_name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2480 staticpro (&Vuser_real_name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2481 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2482 DEFVAR_BOOL ("zmacs-regions", &zmacs_regions /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2483 *Whether LISPM-style active regions should be used.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2484 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
2485 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
2486 state, which is indicated by highlighting. Executing most commands causes
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2487 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
2488 work immediately after activating 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 More specifically:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2491
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2492 - 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
2493 - 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
2494 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
2495 - The region is deactivated after each command that is executed, except that:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2496 - "Motion" commands do not change whether the region is active or not.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2497
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2498 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
2499 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
2500 between point and the recently-pushed mark to be highlighted. It will
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2501 remain highlighted until some non-motion command is executed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2502
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2503 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
2504 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
2505 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
2506 again.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2507
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2508 Generally, commands which push marks as a means of navigation (like
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2509 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
2510 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
2511 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
2512 do activate the region.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2513
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2514 The way the command loop actually works with regard to deactivating the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2515 region is as follows:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2516
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2517 - 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
2518 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
2519 make the region stay around; see the `_' flag in the `interactive'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2520 specification). `zmacs-region-stays' is reset to nil before each command
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2521 is executed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2522 - If the function `zmacs-activate-region' has been called during the command
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2523 just executed, the region is left alone. Very few functions should
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2524 actually call this function.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2525 - Otherwise, if the region is active, the region is deactivated and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2526 the `zmacs-deactivate-region-hook' is called.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2527 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2528 /* Zmacs style active regions are now ON by default */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2529 zmacs_regions = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2530
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2531 DEFVAR_BOOL ("zmacs-region-active-p", &zmacs_region_active_p /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2532 Do not alter this. It is for internal use only.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2533 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2534 zmacs_region_active_p = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2535
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2536 DEFVAR_BOOL ("zmacs-region-stays", &zmacs_region_stays /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2537 Whether the current command will deactivate the region.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2538 Commands which do not wish to affect whether the region is currently
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2539 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
2540 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
2541 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
2542 See the variable `zmacs-regions'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2543
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2544 The same effect can be achieved using the `_' interactive specification.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2545
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2546 `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
2547 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2548 zmacs_region_stays = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2549
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2550 DEFVAR_BOOL ("atomic-extent-goto-char-p", &atomic_extent_goto_char_p /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2551 Do not use this -- it will be going away soon.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2552 Indicates if `goto-char' has just been run. This information is allegedly
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2553 needed to get the desired behavior for atomic extents and unfortunately
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2554 is not available by any other means.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2555 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2556 atomic_extent_goto_char_p = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2557 #ifdef AMPERSAND_FULL_NAME
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 707
diff changeset
2558 Fprovide (intern ("ampersand-full-name"));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2559 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2560
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2561 DEFVAR_LISP ("user-full-name", &Vuser_full_name /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2562 *The name of the user.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2563 The function `user-full-name', which will return the value of this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2564 variable, when called without arguments.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2565 This is initialized to the value of the NAME environment variable.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2566 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2567 /* Initialized at run-time. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2568 Vuser_full_name = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2569 }