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