Mercurial > hg > xemacs-beta
annotate src/editfns.c @ 5940:c608d4b0b75e cygwin64 tip
rescue lost branch from 64bit.backup
| author | Henry Thompson <ht@markup.co.uk> |
|---|---|
| date | Thu, 16 Dec 2021 18:48:58 +0000 |
| parents | 36dddf9d90d1 |
| children |
| 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 */ |
|
5762
427a72c6ee17
Eliminate several compiler (clang) warnings.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
5685
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)); |
|
5813
36dddf9d90d1
Fix calculation of time zone string in Fencode_time.
Marcus Crestani <marcus@crestani.de>
parents:
5762
diff
changeset
|
1193 /* We specify the time zone in offset notation (see `man |
|
36dddf9d90d1
Fix calculation of time zone string in Fencode_time.
Marcus Crestani <marcus@crestani.de>
parents:
5762
diff
changeset
|
1194 tzset' for details). The offset indicates the value one |
|
36dddf9d90d1
Fix calculation of time zone string in Fencode_time.
Marcus Crestani <marcus@crestani.de>
parents:
5762
diff
changeset
|
1195 must add to local time to arrive at UTC. Thus, we sign |
|
36dddf9d90d1
Fix calculation of time zone string in Fencode_time.
Marcus Crestani <marcus@crestani.de>
parents:
5762
diff
changeset
|
1196 the offset with a `-' if the time zone is east of GMT; we |
|
36dddf9d90d1
Fix calculation of time zone string in Fencode_time.
Marcus Crestani <marcus@crestani.de>
parents:
5762
diff
changeset
|
1197 sign the offset with a `+' if the time zone is GMT (then |
|
36dddf9d90d1
Fix calculation of time zone string in Fencode_time.
Marcus Crestani <marcus@crestani.de>
parents:
5762
diff
changeset
|
1198 the offset is 0) or if the time zone is west of GMT. */ |
|
36dddf9d90d1
Fix calculation of time zone string in Fencode_time.
Marcus Crestani <marcus@crestani.de>
parents:
5762
diff
changeset
|
1199 sprintf (tzbuf, "XXX%s%d:%02d:%02d", (XFIXNUM (zone) < 0) ? "+" : "-", |
| 428 | 1200 abszone / (60*60), (abszone/60) % 60, abszone % 60); |
| 1201 tzstring = tzbuf; | |
| 1202 } | |
| 1203 else | |
| 771 | 1204 invalid_argument ("Invalid time zone specification", Qunbound); |
| 428 | 1205 |
| 1206 /* Set TZ before calling mktime; merely adjusting mktime's returned | |
| 1207 value doesn't suffice, since that would mishandle leap seconds. */ | |
| 1208 set_time_zone_rule (tzstring); | |
| 1209 | |
| 1210 the_time = mktime (&tm); | |
| 1211 | |
| 1212 /* Restore TZ to previous value. */ | |
| 1213 newenv = environ; | |
| 1214 environ = oldenv; | |
| 1215 free (newenv); | |
| 1216 #ifdef LOCALTIME_CACHE | |
| 1217 tzset (); | |
| 1218 #endif | |
| 1219 } | |
| 1220 | |
| 1221 if (the_time == (time_t) -1) | |
| 563 | 1222 invalid_argument ("Specified time is not representable", Qunbound); |
| 428 | 1223 |
| 707 | 1224 return make_time (the_time); |
| 428 | 1225 } |
| 1226 | |
| 1227 DEFUN ("current-time-string", Fcurrent_time_string, 0, 1, 0, /* | |
| 1228 Return the current time, as a human-readable string. | |
| 1229 Programs can use this function to decode a time, | |
| 1230 since the number of columns in each field is fixed. | |
| 1231 The format is `Sun Sep 16 01:03:52 1973'. | |
| 1232 If an argument is given, it specifies a time to format | |
| 1233 instead of the current time. The argument should have the form: | |
| 1234 (HIGH . LOW) | |
| 1235 or the form: | |
| 1236 (HIGH LOW . IGNORED). | |
| 1237 Thus, you can use times obtained from `current-time' | |
| 1238 and from `file-attributes'. | |
| 1239 */ | |
| 1240 (specified_time)) | |
| 1241 { | |
| 1242 time_t value; | |
| 867 | 1243 Ibyte *the_ctime; |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1244 EMACS_INT len; /* this is what make_extstring() accepts; #### |
| 665 | 1245 should it be an Bytecount? */ |
| 428 | 1246 |
| 1247 if (! lisp_to_time (specified_time, &value)) | |
| 1248 value = -1; | |
| 771 | 1249 the_ctime = qxe_ctime (&value); |
| 428 | 1250 |
| 442 | 1251 /* ctime is documented as always returning a "\n\0"-terminated |
| 1252 26-byte American time string, but let's be careful anyways. */ | |
| 1253 for (len = 0; the_ctime[len] != '\n' && the_ctime[len] != '\0'; len++) | |
| 1254 ; | |
| 428 | 1255 |
| 771 | 1256 return make_string (the_ctime, len); |
| 428 | 1257 } |
| 1258 | |
| 1259 #define TM_YEAR_ORIGIN 1900 | |
| 1260 | |
| 1261 /* Yield A - B, measured in seconds. */ | |
| 1262 static long | |
| 442 | 1263 difftm (const struct tm *a, const struct tm *b) |
| 428 | 1264 { |
| 1265 int ay = a->tm_year + (TM_YEAR_ORIGIN - 1); | |
| 1266 int by = b->tm_year + (TM_YEAR_ORIGIN - 1); | |
| 1267 /* Some compilers can't handle this as a single return statement. */ | |
| 1268 long days = ( | |
| 1269 /* difference in day of year */ | |
| 1270 a->tm_yday - b->tm_yday | |
| 1271 /* + intervening leap days */ | |
| 1272 + ((ay >> 2) - (by >> 2)) | |
| 1273 - (ay/100 - by/100) | |
| 1274 + ((ay/100 >> 2) - (by/100 >> 2)) | |
| 1275 /* + difference in years * 365 */ | |
| 1276 + (long)(ay-by) * 365 | |
| 1277 ); | |
| 1278 return (60*(60*(24*days + (a->tm_hour - b->tm_hour)) | |
| 1279 + (a->tm_min - b->tm_min)) | |
| 1280 + (a->tm_sec - b->tm_sec)); | |
| 1281 } | |
| 1282 | |
| 1283 DEFUN ("current-time-zone", Fcurrent_time_zone, 0, 1, 0, /* | |
| 1284 Return the offset and name for the local time zone. | |
| 1285 This returns a list of the form (OFFSET NAME). | |
| 1286 OFFSET is an integer number of seconds ahead of UTC (east of Greenwich). | |
| 1287 A negative value means west of Greenwich. | |
| 1288 NAME is a string giving the name of the time zone. | |
| 1289 If an argument is given, it specifies when the time zone offset is determined | |
| 1290 instead of using the current time. The argument should have the form: | |
| 1291 (HIGH . LOW) | |
| 1292 or the form: | |
| 1293 (HIGH LOW . IGNORED). | |
| 1294 Thus, you can use times obtained from `current-time' | |
| 1295 and from `file-attributes'. | |
| 1296 | |
| 1297 Some operating systems cannot provide all this information to Emacs; | |
| 1298 in this case, `current-time-zone' returns a list containing nil for | |
| 1299 the data it can't find. | |
| 1300 */ | |
| 1301 (specified_time)) | |
| 1302 { | |
| 1303 time_t value; | |
| 1304 struct tm *t = NULL; | |
| 1305 | |
| 1306 if (lisp_to_time (specified_time, &value) | |
| 1307 && (t = gmtime (&value)) != 0) | |
| 1308 { | |
| 1309 struct tm gmt = *t; /* Make a copy, in case localtime modifies *t. */ | |
| 1310 long offset; | |
| 771 | 1311 Extbyte *s; |
| 1312 Lisp_Object tem; | |
| 428 | 1313 |
| 1314 t = localtime (&value); | |
| 1315 offset = difftm (t, &gmt); | |
| 1316 s = 0; | |
| 1317 #ifdef HAVE_TM_ZONE | |
| 1318 if (t->tm_zone) | |
| 771 | 1319 s = (Extbyte *) t->tm_zone; |
| 428 | 1320 #else /* not HAVE_TM_ZONE */ |
| 1321 #ifdef HAVE_TZNAME | |
| 1322 if (t->tm_isdst == 0 || t->tm_isdst == 1) | |
| 1323 s = tzname[t->tm_isdst]; | |
| 1324 #endif | |
| 1325 #endif /* not HAVE_TM_ZONE */ | |
| 771 | 1326 if (s) |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1327 tem = build_extstring (s, Qtime_zone_encoding); |
| 771 | 1328 else |
| 428 | 1329 { |
| 867 | 1330 Ibyte buf[6]; |
| 771 | 1331 |
| 428 | 1332 /* No local time zone name is available; use "+-NNNN" instead. */ |
| 1333 int am = (offset < 0 ? -offset : offset) / 60; | |
| 771 | 1334 qxesprintf (buf, "%c%02d%02d", (offset < 0 ? '-' : '+'), am/60, |
| 1335 am%60); | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1336 tem = build_istring (buf); |
| 428 | 1337 } |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5476
diff
changeset
|
1338 return list2 (make_fixnum (offset), tem); |
| 428 | 1339 } |
| 1340 else | |
| 1341 return list2 (Qnil, Qnil); | |
| 1342 } | |
| 1343 | |
| 1344 #ifdef LOCALTIME_CACHE | |
| 1345 | |
| 1346 /* These two values are known to load tz files in buggy implementations, | |
| 1347 i.e. Solaris 1 executables running under either Solaris 1 or Solaris 2. | |
| 1348 Their values shouldn't matter in non-buggy implementations. | |
| 1349 We don't use string literals for these strings, | |
| 1350 since if a string in the environment is in readonly | |
| 1351 storage, it runs afoul of bugs in SVR4 and Solaris 2.3. | |
| 1352 See Sun bugs 1113095 and 1114114, ``Timezone routines | |
| 1353 improperly modify environment''. */ | |
| 1354 | |
| 2367 | 1355 static Ascbyte set_time_zone_rule_tz1[] = "TZ=GMT+0"; |
| 1356 static Ascbyte set_time_zone_rule_tz2[] = "TZ=GMT+1"; | |
| 428 | 1357 |
| 1358 #endif | |
| 1359 | |
| 1360 /* Set the local time zone rule to TZSTRING. | |
| 1361 This allocates memory into `environ', which it is the caller's | |
| 1362 responsibility to free. */ | |
| 1363 static void | |
| 771 | 1364 set_time_zone_rule (Extbyte *tzstring) |
| 428 | 1365 { |
| 1366 int envptrs; | |
| 771 | 1367 Extbyte **from, **to, **newenv; |
| 428 | 1368 |
| 1369 for (from = environ; *from; from++) | |
| 1370 continue; | |
| 1371 envptrs = from - environ + 2; | |
| 771 | 1372 newenv = to = (Extbyte **) xmalloc (envptrs * sizeof (Extbyte *) |
| 428 | 1373 + (tzstring ? strlen (tzstring) + 4 : 0)); |
| 1374 if (tzstring) | |
| 1375 { | |
| 771 | 1376 Extbyte *t = (Extbyte *) (to + envptrs); |
| 428 | 1377 strcpy (t, "TZ="); |
| 1378 strcat (t, tzstring); | |
| 1379 *to++ = t; | |
| 1380 } | |
| 1381 | |
| 1382 for (from = environ; *from; from++) | |
| 1383 if (strncmp (*from, "TZ=", 3) != 0) | |
| 1384 *to++ = *from; | |
| 1385 *to = 0; | |
| 1386 | |
| 1387 environ = newenv; | |
| 1388 | |
| 1389 #ifdef LOCALTIME_CACHE | |
| 1390 { | |
| 1391 /* In SunOS 4.1.3_U1 and 4.1.4, if TZ has a value like | |
| 1392 "US/Pacific" that loads a tz file, then changes to a value like | |
| 1393 "XXX0" that does not load a tz file, and then changes back to | |
| 1394 its original value, the last change is (incorrectly) ignored. | |
| 1395 Also, if TZ changes twice in succession to values that do | |
| 1396 not load a tz file, tzset can dump core (see Sun bug#1225179). | |
| 1397 The following code works around these bugs. */ | |
| 1398 | |
| 1399 if (tzstring) | |
| 1400 { | |
| 1401 /* Temporarily set TZ to a value that loads a tz file | |
| 1402 and that differs from tzstring. */ | |
| 771 | 1403 Extbyte *tz = *newenv; |
| 428 | 1404 *newenv = (strcmp (tzstring, set_time_zone_rule_tz1 + 3) == 0 |
| 1405 ? set_time_zone_rule_tz2 : set_time_zone_rule_tz1); | |
| 1406 tzset (); | |
| 1407 *newenv = tz; | |
| 1408 } | |
| 1409 else | |
| 1410 { | |
| 1411 /* The implied tzstring is unknown, so temporarily set TZ to | |
| 1412 two different values that each load a tz file. */ | |
| 1413 *to = set_time_zone_rule_tz1; | |
| 1414 to[1] = 0; | |
| 1415 tzset (); | |
| 1416 *to = set_time_zone_rule_tz2; | |
| 1417 tzset (); | |
| 1418 *to = 0; | |
| 1419 } | |
| 1420 | |
| 1421 /* Now TZ has the desired value, and tzset can be invoked safely. */ | |
| 1422 } | |
| 1423 | |
| 1424 tzset (); | |
| 1425 #endif | |
| 1426 } | |
| 1427 | |
| 1428 DEFUN ("set-time-zone-rule", Fset_time_zone_rule, 1, 1, 0, /* | |
| 1429 Set the local time zone using TZ, a string specifying a time zone rule. | |
| 1430 If TZ is nil, use implementation-defined default time zone information. | |
| 1431 */ | |
| 1432 (tz)) | |
| 1433 { | |
| 771 | 1434 Extbyte *tzstring; |
| 428 | 1435 |
| 1436 if (NILP (tz)) | |
| 1437 tzstring = 0; | |
| 1438 else | |
| 1439 { | |
| 1440 CHECK_STRING (tz); | |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
1441 tzstring = LISP_STRING_TO_EXTERNAL (tz, Qtime_zone_encoding); |
| 428 | 1442 } |
| 1443 | |
| 1444 set_time_zone_rule (tzstring); | |
| 1445 if (environbuf) | |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
1446 xfree (environbuf); |
| 428 | 1447 environbuf = environ; |
| 1448 | |
| 1449 return Qnil; | |
| 1450 } | |
| 1451 | |
| 1452 | |
| 1453 void | |
| 1454 buffer_insert1 (struct buffer *buf, Lisp_Object arg) | |
| 1455 { | |
| 1456 /* This function can GC */ | |
| 1457 struct gcpro gcpro1; | |
| 1458 GCPRO1 (arg); | |
| 1459 retry: | |
| 1460 if (CHAR_OR_CHAR_INTP (arg)) | |
| 1461 { | |
| 1462 buffer_insert_emacs_char (buf, XCHAR_OR_CHAR_INT (arg)); | |
| 1463 } | |
| 1464 else if (STRINGP (arg)) | |
| 1465 { | |
| 1466 buffer_insert_lisp_string (buf, arg); | |
| 1467 } | |
| 1468 else | |
| 1469 { | |
| 1470 arg = wrong_type_argument (Qchar_or_string_p, arg); | |
| 1471 goto retry; | |
| 1472 } | |
| 1473 UNGCPRO; | |
| 1474 } | |
| 1475 | |
| 1476 | |
| 1477 /* Callers passing one argument to Finsert need not gcpro the | |
| 1478 argument "array", since the only element of the array will | |
| 1479 not be used after calling insert_emacs_char or insert_lisp_string, | |
| 1480 so we don't care if it gets trashed. */ | |
| 1481 | |
| 1482 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
|
1483 Insert ARGS, either strings or characters, at point. |
| 428 | 1484 Point moves forward so that it ends up after the inserted text. |
| 1485 Any other markers at the point of insertion remain before the text. | |
| 1486 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
|
1487 |
|
80cd90837ac5
Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4470
diff
changeset
|
1488 arguments: (&rest ARGS) |
| 428 | 1489 */ |
| 1490 (int nargs, Lisp_Object *args)) | |
| 1491 { | |
| 1492 /* This function can GC */ | |
| 1493 REGISTER int argnum; | |
| 1494 | |
| 1495 for (argnum = 0; argnum < nargs; argnum++) | |
| 1496 { | |
| 1497 buffer_insert1 (current_buffer, args[argnum]); | |
| 1498 } | |
| 1499 | |
| 1500 return Qnil; | |
| 1501 } | |
| 1502 | |
| 1503 DEFUN ("insert-before-markers", Finsert_before_markers, 0, MANY, 0, /* | |
| 1504 Insert strings or characters at point, relocating markers after the text. | |
| 1505 Point moves forward so that it ends up after the inserted text. | |
| 1506 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
|
1507 |
|
80cd90837ac5
Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4470
diff
changeset
|
1508 arguments: (&rest ARGS) |
| 428 | 1509 */ |
| 1510 (int nargs, Lisp_Object *args)) | |
| 1511 { | |
| 1512 /* This function can GC */ | |
| 1513 REGISTER int argnum; | |
| 1514 REGISTER Lisp_Object tem; | |
| 1515 | |
| 1516 for (argnum = 0; argnum < nargs; argnum++) | |
| 1517 { | |
| 1518 tem = args[argnum]; | |
| 1519 retry: | |
| 1520 if (CHAR_OR_CHAR_INTP (tem)) | |
| 1521 { | |
| 1522 buffer_insert_emacs_char_1 (current_buffer, -1, | |
| 1523 XCHAR_OR_CHAR_INT (tem), | |
| 1524 INSDEL_BEFORE_MARKERS); | |
| 1525 } | |
| 1526 else if (STRINGP (tem)) | |
| 1527 { | |
| 1528 buffer_insert_lisp_string_1 (current_buffer, -1, tem, | |
| 1529 INSDEL_BEFORE_MARKERS); | |
| 1530 } | |
| 1531 else | |
| 1532 { | |
| 1533 tem = wrong_type_argument (Qchar_or_string_p, tem); | |
| 1534 goto retry; | |
| 1535 } | |
| 1536 } | |
| 1537 return Qnil; | |
| 1538 } | |
| 1539 | |
| 1540 DEFUN ("insert-string", Finsert_string, 1, 2, 0, /* | |
| 1541 Insert STRING into BUFFER at BUFFER's point. | |
| 1542 Point moves forward so that it ends up after the inserted text. | |
| 1543 Any other markers at the point of insertion remain before the text. | |
| 1544 If a string has non-null string-extent-data, new extents will be created. | |
| 1545 BUFFER defaults to the current buffer. | |
| 1546 */ | |
| 1547 (string, buffer)) | |
| 1548 { | |
| 1549 struct buffer *b = decode_buffer (buffer, 1); | |
| 1550 CHECK_STRING (string); | |
| 1551 buffer_insert_lisp_string (b, string); | |
| 1552 return Qnil; | |
| 1553 } | |
| 1554 | |
| 1555 /* Third argument in FSF is INHERIT: | |
| 1556 | |
| 1557 "The optional third arg INHERIT, if non-nil, says to inherit text properties | |
| 1558 from adjoining text, if those properties are sticky." | |
| 1559 | |
| 1560 Jamie thinks this is bogus. */ | |
| 1561 | |
| 1562 | |
| 1563 DEFUN ("insert-char", Finsert_char, 1, 4, 0, /* | |
| 444 | 1564 Insert COUNT copies of CHARACTER into BUFFER. |
| 428 | 1565 Point and all markers are affected as in the function `insert'. |
| 1566 COUNT defaults to 1 if omitted. | |
| 1567 The optional third arg IGNORED is INHERIT under FSF Emacs. | |
| 1568 This is highly bogus, however, and XEmacs always behaves as if | |
| 1569 `t' were passed to INHERIT. | |
| 1570 The optional fourth arg BUFFER specifies the buffer to insert the | |
| 1571 text into. If BUFFER is nil, the current buffer is assumed. | |
| 1572 */ | |
| 2286 | 1573 (character, count, UNUSED (ignored), buffer)) |
| 428 | 1574 { |
| 1575 /* This function can GC */ | |
| 867 | 1576 REGISTER Ibyte *string; |
| 814 | 1577 REGISTER Bytecount slen; |
| 1578 REGISTER Bytecount i, j; | |
| 428 | 1579 REGISTER Bytecount n; |
| 1580 REGISTER Bytecount charlen; | |
| 867 | 1581 Ibyte str[MAX_ICHAR_LEN]; |
| 428 | 1582 struct buffer *b = decode_buffer (buffer, 1); |
| 1583 int cou; | |
| 1584 | |
| 444 | 1585 CHECK_CHAR_COERCE_INT (character); |
| 428 | 1586 if (NILP (count)) |
| 1587 cou = 1; | |
| 1588 else | |
| 1589 { | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5476
diff
changeset
|
1590 CHECK_FIXNUM (count); |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5476
diff
changeset
|
1591 cou = XFIXNUM (count); |
| 428 | 1592 } |
| 1593 | |
| 867 | 1594 charlen = set_itext_ichar (str, XCHAR (character)); |
| 428 | 1595 n = cou * charlen; |
| 1596 if (n <= 0) | |
| 1597 return Qnil; | |
| 814 | 1598 slen = min (n, (Bytecount) 768); |
| 2367 | 1599 string = alloca_ibytes (slen); |
| 428 | 1600 /* Write as many copies of the character into the temp string as will fit. */ |
| 1601 for (i = 0; i + charlen <= slen; i += charlen) | |
| 1602 for (j = 0; j < charlen; j++) | |
| 1603 string[i + j] = str[j]; | |
| 1604 slen = i; | |
| 1605 while (n >= slen) | |
| 1606 { | |
| 1607 buffer_insert_raw_string (b, string, slen); | |
| 1608 n -= slen; | |
| 1609 } | |
| 1610 if (n > 0) | |
| 1611 #if 0 /* FSFmacs bogosity */ | |
| 1612 { | |
| 1613 if (!NILP (inherit)) | |
| 1614 insert_and_inherit (string, n); | |
| 1615 else | |
| 1616 insert (string, n); | |
| 1617 } | |
| 1618 #else | |
| 1619 buffer_insert_raw_string (b, string, n); | |
| 1620 #endif | |
| 1621 | |
| 1622 return Qnil; | |
| 1623 } | |
| 1624 | |
| 1625 | |
| 1626 /* Making strings from buffer contents. */ | |
| 1627 | |
| 1628 DEFUN ("buffer-substring", Fbuffer_substring, 0, 3, 0, /* | |
| 1629 Return the contents of part of BUFFER as a string. | |
| 1630 The two arguments START and END are character positions; | |
| 1631 they can be in either order. If omitted, they default to the beginning | |
| 1632 and end of BUFFER, respectively. | |
| 1633 If there are duplicable extents in the region, the string remembers | |
| 1634 them in its extent data. | |
| 1635 If BUFFER is nil, the current buffer is assumed. | |
| 1636 */ | |
| 1637 (start, end, buffer)) | |
| 1638 { | |
| 1639 /* This function can GC */ | |
| 665 | 1640 Charbpos begv, zv; |
| 428 | 1641 struct buffer *b = decode_buffer (buffer, 1); |
| 1642 | |
| 1643 get_buffer_range_char (b, start, end, &begv, &zv, GB_ALLOW_NIL); | |
| 1644 return make_string_from_buffer (b, begv, zv - begv); | |
| 1645 } | |
| 1646 | |
| 1647 /* It might make more sense to name this | |
| 1648 `buffer-substring-no-extents', but this name is FSFmacs-compatible, | |
| 1649 and what the function does is probably good enough for what the | |
| 1650 user-code will typically want to use it for. */ | |
| 1651 DEFUN ("buffer-substring-no-properties", Fbuffer_substring_no_properties, 0, 3, 0, /* | |
| 444 | 1652 Return the text from START to END as a string, without copying the extents. |
| 428 | 1653 */ |
| 1654 (start, end, buffer)) | |
| 1655 { | |
| 1656 /* This function can GC */ | |
| 665 | 1657 Charbpos begv, zv; |
| 428 | 1658 struct buffer *b = decode_buffer (buffer, 1); |
| 1659 | |
| 1660 get_buffer_range_char (b, start, end, &begv, &zv, GB_ALLOW_NIL); | |
| 1661 return make_string_from_buffer_no_extents (b, begv, zv - begv); | |
| 1662 } | |
| 1663 | |
| 1664 DEFUN ("insert-buffer-substring", Finsert_buffer_substring, 1, 3, 0, /* | |
| 1665 Insert before point a substring of the contents of buffer BUFFER. | |
| 1666 BUFFER may be a buffer or a buffer name. | |
| 1667 Arguments START and END are character numbers specifying the substring. | |
| 1668 They default to the beginning and the end of BUFFER. | |
| 1669 */ | |
| 1670 (buffer, start, end)) | |
| 1671 { | |
| 1672 /* This function can GC */ | |
| 665 | 1673 Charbpos b, e; |
| 428 | 1674 struct buffer *bp; |
| 1675 | |
| 1676 bp = XBUFFER (get_buffer (buffer, 1)); | |
| 1677 get_buffer_range_char (bp, start, end, &b, &e, GB_ALLOW_NIL); | |
| 1678 | |
| 1679 if (b < e) | |
| 1680 buffer_insert_from_buffer (current_buffer, bp, b, e - b); | |
| 1681 | |
| 1682 return Qnil; | |
| 1683 } | |
| 1684 | |
| 1685 DEFUN ("compare-buffer-substrings", Fcompare_buffer_substrings, 6, 6, 0, /* | |
| 1686 Compare two substrings of two buffers; return result as number. | |
| 1687 the value is -N if first string is less after N-1 chars, | |
| 1688 +N if first string is greater after N-1 chars, or 0 if strings match. | |
| 1689 Each substring is represented as three arguments: BUFFER, START and END. | |
| 1690 That makes six args in all, three for each substring. | |
| 1691 | |
| 1692 The value of `case-fold-search' in the current buffer | |
| 1693 determines whether case is significant or ignored. | |
| 1694 */ | |
| 1695 (buffer1, start1, end1, buffer2, start2, end2)) | |
| 1696 { | |
| 665 | 1697 Charbpos begp1, endp1, begp2, endp2; |
| 428 | 1698 REGISTER Charcount len1, len2, length, i; |
| 1699 struct buffer *bp1, *bp2; | |
| 1700 Lisp_Object trt = ((!NILP (current_buffer->case_fold_search)) ? | |
| 446 | 1701 XCASE_TABLE_CANON (current_buffer->case_table) : Qnil); |
| 428 | 1702 |
| 1703 /* Find the first buffer and its substring. */ | |
| 1704 | |
| 1705 bp1 = decode_buffer (buffer1, 1); | |
| 1706 get_buffer_range_char (bp1, start1, end1, &begp1, &endp1, GB_ALLOW_NIL); | |
| 1707 | |
| 1708 /* Likewise for second substring. */ | |
| 1709 | |
| 1710 bp2 = decode_buffer (buffer2, 1); | |
| 1711 get_buffer_range_char (bp2, start2, end2, &begp2, &endp2, GB_ALLOW_NIL); | |
| 1712 | |
| 1713 len1 = endp1 - begp1; | |
| 1714 len2 = endp2 - begp2; | |
| 1715 length = len1; | |
| 1716 if (len2 < length) | |
| 1717 length = len2; | |
| 1718 | |
| 1719 for (i = 0; i < length; i++) | |
| 1720 { | |
| 867 | 1721 Ichar c1 = BUF_FETCH_CHAR (bp1, begp1 + i); |
| 1722 Ichar c2 = BUF_FETCH_CHAR (bp2, begp2 + i); | |
| 428 | 1723 if (!NILP (trt)) |
| 1724 { | |
| 1725 c1 = TRT_TABLE_OF (trt, c1); | |
| 1726 c2 = TRT_TABLE_OF (trt, c2); | |
| 1727 } | |
| 1728 if (c1 < c2) | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5476
diff
changeset
|
1729 return make_fixnum (- 1 - i); |
| 428 | 1730 if (c1 > c2) |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5476
diff
changeset
|
1731 return make_fixnum (i + 1); |
| 428 | 1732 } |
| 1733 | |
| 1734 /* The strings match as far as they go. | |
| 1735 If one is shorter, that one is less. */ | |
| 1736 if (length < len1) | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5476
diff
changeset
|
1737 return make_fixnum (length + 1); |
| 428 | 1738 else if (length < len2) |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5476
diff
changeset
|
1739 return make_fixnum (- length - 1); |
| 428 | 1740 |
| 1741 /* Same length too => they are equal. */ | |
| 1742 return Qzero; | |
| 1743 } | |
| 1744 | |
| 1745 | |
| 1746 static Lisp_Object | |
| 1747 subst_char_in_region_unwind (Lisp_Object arg) | |
| 1748 { | |
| 1749 XBUFFER (XCAR (arg))->undo_list = XCDR (arg); | |
| 1750 return Qnil; | |
| 1751 } | |
| 1752 | |
| 1753 static Lisp_Object | |
| 1754 subst_char_in_region_unwind_1 (Lisp_Object arg) | |
| 1755 { | |
| 1756 XBUFFER (XCAR (arg))->filename = XCDR (arg); | |
| 1757 return Qnil; | |
| 1758 } | |
| 1759 | |
| 1760 DEFUN ("subst-char-in-region", Fsubst_char_in_region, 4, 5, 0, /* | |
| 1761 From START to END, replace FROMCHAR with TOCHAR each time it occurs. | |
| 1762 If optional arg NOUNDO is non-nil, don't record this change for undo | |
| 1763 and don't mark the buffer as really changed. | |
| 1764 */ | |
| 1765 (start, end, fromchar, tochar, noundo)) | |
| 1766 { | |
| 1767 /* This function can GC */ | |
| 665 | 1768 Charbpos pos, stop; |
| 867 | 1769 Ichar fromc, toc; |
| 428 | 1770 int mc_count; |
| 1771 struct buffer *buf = current_buffer; | |
| 1772 int count = specpdl_depth (); | |
| 1773 | |
| 1774 get_buffer_range_char (buf, start, end, &pos, &stop, 0); | |
| 1775 CHECK_CHAR_COERCE_INT (fromchar); | |
| 1776 CHECK_CHAR_COERCE_INT (tochar); | |
| 1777 | |
| 1778 fromc = XCHAR (fromchar); | |
| 1779 toc = XCHAR (tochar); | |
| 1780 | |
| 1781 /* If we don't want undo, turn off putting stuff on the list. | |
| 1782 That's faster than getting rid of things, | |
| 1783 and it prevents even the entry for a first change. | |
| 1784 Also inhibit locking the file. */ | |
| 1785 if (!NILP (noundo)) | |
| 1786 { | |
| 1787 record_unwind_protect (subst_char_in_region_unwind, | |
| 1788 Fcons (Fcurrent_buffer (), buf->undo_list)); | |
| 1789 buf->undo_list = Qt; | |
| 1790 /* Don't do file-locking. */ | |
| 1791 record_unwind_protect (subst_char_in_region_unwind_1, | |
| 1792 Fcons (Fcurrent_buffer (), buf->filename)); | |
| 1793 buf->filename = Qnil; | |
| 1794 } | |
| 1795 | |
| 1796 mc_count = begin_multiple_change (buf, pos, stop); | |
| 1797 while (pos < stop) | |
| 1798 { | |
| 1799 if (BUF_FETCH_CHAR (buf, pos) == fromc) | |
| 1800 { | |
| 1801 /* There used to be some code here that set the buffer to | |
| 1802 unmodified if NOUNDO was specified and there was only | |
| 1803 one change to the buffer since it was last saved. | |
| 1804 This is a crock of shit, so I'm not duplicating this | |
| 1805 behavior. I think this was left over from when | |
| 1806 prepare_to_modify_buffer() actually bumped MODIFF, | |
| 1807 so that code was supposed to undo this change. --ben */ | |
| 1808 buffer_replace_char (buf, pos, toc, !NILP (noundo), 0); | |
| 1809 | |
| 1810 /* If noundo is not nil then we don't mark the buffer as | |
| 1811 modified. In reality that needs to happen externally | |
| 1812 only. Internally redisplay needs to know that the actual | |
| 1813 contents it should be displaying have changed. */ | |
| 1814 if (!NILP (noundo)) | |
| 1815 Fset_buffer_modified_p (Fbuffer_modified_p (Qnil), Qnil); | |
| 1816 } | |
| 1817 pos++; | |
| 1818 } | |
| 1819 end_multiple_change (buf, mc_count); | |
| 1820 | |
| 771 | 1821 unbind_to (count); |
| 428 | 1822 return Qnil; |
| 1823 } | |
| 1824 | |
| 1825 /* #### Shouldn't this also accept a BUFFER argument, in the good old | |
| 1826 XEmacs tradition? */ | |
| 1827 DEFUN ("translate-region", Ftranslate_region, 3, 3, 0, /* | |
| 1828 Translate characters from START to END according to TABLE. | |
| 1829 | |
| 1830 If TABLE is a string, the Nth character in it is the mapping for the | |
| 1831 character with code N. | |
| 1832 | |
| 1833 If TABLE is a vector, its Nth element is the mapping for character | |
| 1834 with code N. The values of elements may be characters, strings, or | |
| 1835 nil (nil meaning don't replace.) | |
| 1836 | |
| 1837 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
|
1838 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
|
1839 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
|
1840 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
|
1841 `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
|
1842 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
|
1843 not all of them, the most generally useful table type here is `generic'. |
| 428 | 1844 |
| 1845 Returns the number of substitutions performed. | |
| 1846 */ | |
| 1847 (start, end, table)) | |
| 1848 { | |
| 1849 /* This function can GC */ | |
| 665 | 1850 Charbpos pos, stop; /* Limits of the region. */ |
| 428 | 1851 int cnt = 0; /* Number of changes made. */ |
| 1852 int mc_count; | |
| 1853 struct buffer *buf = current_buffer; | |
| 867 | 1854 Ichar oc; |
| 428 | 1855 |
| 1856 get_buffer_range_char (buf, start, end, &pos, &stop, 0); | |
| 1857 mc_count = begin_multiple_change (buf, pos, stop); | |
| 1858 if (STRINGP (table)) | |
| 1859 { | |
| 826 | 1860 Charcount size = string_char_length (table); |
| 428 | 1861 #ifdef MULE |
| 867 | 1862 /* Under Mule, string_ichar(n) is O(n), so for large tables or |
| 1863 large regions it makes sense to create an array of Ichars. */ | |
| 428 | 1864 if (size * (stop - pos) > 65536) |
| 1865 { | |
| 867 | 1866 Ichar *etable = alloca_array (Ichar, size); |
| 1867 convert_ibyte_string_into_ichar_string | |
| 793 | 1868 (XSTRING_DATA (table), XSTRING_LENGTH (table), etable); |
| 428 | 1869 for (; pos < stop && (oc = BUF_FETCH_CHAR (buf, pos), 1); pos++) |
| 1870 { | |
| 1871 if (oc < size) | |
| 1872 { | |
| 867 | 1873 Ichar nc = etable[oc]; |
| 428 | 1874 if (nc != oc) |
| 1875 { | |
| 1876 buffer_replace_char (buf, pos, nc, 0, 0); | |
| 1877 ++cnt; | |
| 1878 } | |
| 1879 } | |
| 1880 } | |
| 1881 } | |
| 1882 else | |
| 1883 #endif /* MULE */ | |
| 1884 { | |
| 1885 for (; pos < stop && (oc = BUF_FETCH_CHAR (buf, pos), 1); pos++) | |
| 1886 { | |
| 1887 if (oc < size) | |
| 1888 { | |
| 867 | 1889 Ichar nc = string_ichar (table, oc); |
| 428 | 1890 if (nc != oc) |
| 1891 { | |
| 1892 buffer_replace_char (buf, pos, nc, 0, 0); | |
| 1893 ++cnt; | |
| 1894 } | |
| 1895 } | |
| 1896 } | |
| 1897 } | |
| 1898 } | |
| 1899 else if (VECTORP (table)) | |
| 1900 { | |
| 1901 Charcount size = XVECTOR_LENGTH (table); | |
| 1902 Lisp_Object *vtable = XVECTOR_DATA (table); | |
| 1903 | |
| 1904 for (; pos < stop && (oc = BUF_FETCH_CHAR (buf, pos), 1); pos++) | |
| 1905 { | |
| 1906 if (oc < size) | |
| 1907 { | |
| 1908 Lisp_Object replacement = vtable[oc]; | |
| 1909 retry: | |
| 1910 if (CHAR_OR_CHAR_INTP (replacement)) | |
| 1911 { | |
| 867 | 1912 Ichar nc = XCHAR_OR_CHAR_INT (replacement); |
| 428 | 1913 if (nc != oc) |
| 1914 { | |
| 1915 buffer_replace_char (buf, pos, nc, 0, 0); | |
| 1916 ++cnt; | |
| 1917 } | |
| 1918 } | |
| 1919 else if (STRINGP (replacement)) | |
| 1920 { | |
| 826 | 1921 Charcount incr = string_char_length (replacement) - 1; |
| 428 | 1922 buffer_delete_range (buf, pos, pos + 1, 0); |
| 1923 buffer_insert_lisp_string_1 (buf, pos, replacement, 0); | |
| 1924 pos += incr, stop += incr; | |
| 1925 ++cnt; | |
| 1926 } | |
| 1927 else if (!NILP (replacement)) | |
| 1928 { | |
| 1929 replacement = wrong_type_argument (Qchar_or_string_p, replacement); | |
| 1930 goto retry; | |
| 1931 } | |
| 1932 } | |
| 1933 } | |
| 1934 } | |
| 1935 else if (CHAR_TABLEP (table) | |
| 1936 && (XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_GENERIC | |
| 1937 || XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_CHAR)) | |
| 1938 { | |
| 1939 | |
| 1940 for (; pos < stop && (oc = BUF_FETCH_CHAR (buf, pos), 1); pos++) | |
| 1941 { | |
| 826 | 1942 Lisp_Object replacement = get_char_table (oc, table); |
| 428 | 1943 retry2: |
| 1944 if (CHAR_OR_CHAR_INTP (replacement)) | |
| 1945 { | |
| 867 | 1946 Ichar nc = XCHAR_OR_CHAR_INT (replacement); |
| 428 | 1947 if (nc != oc) |
| 1948 { | |
| 1949 buffer_replace_char (buf, pos, nc, 0, 0); | |
| 1950 ++cnt; | |
| 1951 } | |
| 1952 } | |
| 1953 else if (STRINGP (replacement)) | |
| 1954 { | |
| 826 | 1955 Charcount incr = string_char_length (replacement) - 1; |
| 428 | 1956 buffer_delete_range (buf, pos, pos + 1, 0); |
| 1957 buffer_insert_lisp_string_1 (buf, pos, replacement, 0); | |
| 1958 pos += incr, stop += incr; | |
| 1959 ++cnt; | |
| 1960 } | |
| 1961 else if (!NILP (replacement)) | |
| 1962 { | |
| 826 | 1963 replacement = wrong_type_argument (Qchar_or_string_p, |
| 1964 replacement); | |
| 428 | 1965 goto retry2; |
| 1966 } | |
| 1967 } | |
| 1968 } | |
| 1969 else | |
| 1970 dead_wrong_type_argument (Qstringp, table); | |
| 1971 end_multiple_change (buf, mc_count); | |
| 1972 | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5476
diff
changeset
|
1973 return make_fixnum (cnt); |
| 428 | 1974 } |
| 1975 | |
| 1976 DEFUN ("delete-region", Fdelete_region, 2, 3, "r", /* | |
| 1977 Delete the text between point and mark. | |
| 444 | 1978 When called from a program, expects two arguments START and END |
| 1979 \(integers or markers) specifying the stretch to be deleted. | |
| 1980 If optional third arg BUFFER is nil, the current buffer is assumed. | |
| 428 | 1981 */ |
| 444 | 1982 (start, end, buffer)) |
| 428 | 1983 { |
| 1984 /* This function can GC */ | |
| 826 | 1985 Charbpos char_start, char_end; |
| 428 | 1986 struct buffer *buf = decode_buffer (buffer, 1); |
| 1987 | |
| 826 | 1988 get_buffer_range_char (buf, start, end, &char_start, &char_end, 0); |
| 1989 buffer_delete_range (buf, char_start, char_end, 0); | |
| 428 | 1990 return Qnil; |
| 1991 } | |
| 1992 | |
| 1993 void | |
| 1994 widen_buffer (struct buffer *b, int no_clip) | |
| 1995 { | |
| 1996 if (BUF_BEGV (b) != BUF_BEG (b)) | |
| 1997 { | |
| 1998 clip_changed = 1; | |
| 826 | 1999 SET_BOTH_BUF_BEGV (b, BUF_BEG (b), BYTE_BUF_BEG (b)); |
| 428 | 2000 } |
| 2001 if (BUF_ZV (b) != BUF_Z (b)) | |
| 2002 { | |
| 2003 clip_changed = 1; | |
| 826 | 2004 SET_BOTH_BUF_ZV (b, BUF_Z (b), BYTE_BUF_Z (b)); |
| 428 | 2005 } |
| 2006 if (clip_changed) | |
| 2007 { | |
| 2008 if (!no_clip) | |
| 2009 MARK_CLIP_CHANGED; | |
| 2010 /* Changing the buffer bounds invalidates any recorded current | |
| 2011 column. */ | |
| 2012 invalidate_current_column (); | |
| 2013 narrow_line_number_cache (b); | |
| 2014 } | |
| 2015 } | |
| 2016 | |
| 2017 DEFUN ("widen", Fwiden, 0, 1, "", /* | |
| 2018 Remove restrictions (narrowing) from BUFFER. | |
| 2019 This allows the buffer's full text to be seen and edited. | |
| 2020 If BUFFER is nil, the current buffer is assumed. | |
| 2021 */ | |
| 2022 (buffer)) | |
| 2023 { | |
| 2024 struct buffer *b = decode_buffer (buffer, 1); | |
| 2025 widen_buffer (b, 0); | |
| 2026 return Qnil; | |
| 2027 } | |
| 2028 | |
| 2029 DEFUN ("narrow-to-region", Fnarrow_to_region, 2, 3, "r", /* | |
| 2030 Restrict editing in BUFFER to the current region. | |
| 2031 The rest of the text becomes temporarily invisible and untouchable | |
| 2032 but is not deleted; if you save the buffer in a file, the invisible | |
| 2033 text is included in the file. \\[widen] makes all visible again. | |
| 2034 If BUFFER is nil, the current buffer is assumed. | |
| 2035 See also `save-restriction'. | |
| 2036 | |
| 2037 When calling from a program, pass two arguments; positions (integers | |
| 2038 or markers) bounding the text that should remain visible. | |
| 2039 */ | |
| 444 | 2040 (start, end, buffer)) |
| 428 | 2041 { |
| 826 | 2042 Charbpos char_start, char_end; |
| 428 | 2043 struct buffer *buf = decode_buffer (buffer, 1); |
| 826 | 2044 Bytebpos byte_start, byte_end; |
| 428 | 2045 |
| 826 | 2046 get_buffer_range_char (buf, start, end, &char_start, &char_end, |
| 444 | 2047 GB_ALLOW_PAST_ACCESSIBLE); |
| 826 | 2048 byte_start = charbpos_to_bytebpos (buf, char_start); |
| 2049 byte_end = charbpos_to_bytebpos (buf, char_end); | |
| 428 | 2050 |
| 826 | 2051 SET_BOTH_BUF_BEGV (buf, char_start, byte_start); |
| 2052 SET_BOTH_BUF_ZV (buf, char_end, byte_end); | |
| 2053 if (BUF_PT (buf) < char_start) | |
| 2054 BUF_SET_PT (buf, char_start); | |
| 2055 if (BUF_PT (buf) > char_end) | |
| 2056 BUF_SET_PT (buf, char_end); | |
| 428 | 2057 MARK_CLIP_CHANGED; |
| 2058 /* Changing the buffer bounds invalidates any recorded current column. */ | |
| 2059 invalidate_current_column (); | |
| 2060 narrow_line_number_cache (buf); | |
| 2061 return Qnil; | |
| 2062 } | |
| 2063 | |
| 2064 Lisp_Object | |
| 844 | 2065 save_restriction_save (struct buffer *buf) |
| 428 | 2066 { |
| 844 | 2067 Lisp_Object bottom = noseeum_make_marker (); |
| 2068 Lisp_Object top = noseeum_make_marker (); | |
| 2069 | |
| 2070 /* Formerly, this function remembered the amount of text on either side | |
| 2071 of the restricted area, in a halfway attempt to account for insertion -- | |
| 2072 it handles insertion inside the old restricted area, but not outside. | |
| 2073 The comment read: | |
| 2074 | |
| 2075 [[ Note: I tried using markers here, but it does not win | |
| 428 | 2076 because insertion at the end of the saved region |
| 844 | 2077 does not advance mh and is considered "outside" the saved region. ]] |
| 2078 | |
| 2079 But that was clearly before the advent of marker-insertion-type. --ben */ | |
| 428 | 2080 |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5476
diff
changeset
|
2081 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
|
2082 Fset_marker (top, make_fixnum (BUF_ZV (buf)), wrap_buffer (buf)); |
| 844 | 2083 Fset_marker_insertion_type (top, Qt); |
| 2084 | |
| 2085 return noseeum_cons (wrap_buffer (buf), noseeum_cons (bottom, top)); | |
| 428 | 2086 } |
| 2087 | |
| 2088 Lisp_Object | |
| 2089 save_restriction_restore (Lisp_Object data) | |
| 2090 { | |
| 2091 struct buffer *buf; | |
| 844 | 2092 Lisp_Object markers = XCDR (data); |
| 428 | 2093 int local_clip_changed = 0; |
| 2094 | |
| 2095 buf = XBUFFER (XCAR (data)); | |
| 844 | 2096 /* someone could have killed the buffer in the meantime ... */ |
| 2097 if (BUFFER_LIVE_P (buf)) | |
| 428 | 2098 { |
| 844 | 2099 Charbpos start = marker_position (XCAR (markers)); |
| 2100 Charbpos end = marker_position (XCDR (markers)); | |
| 2101 Bytebpos byte_start = charbpos_to_bytebpos (buf, start); | |
| 2102 Bytebpos byte_end = charbpos_to_bytebpos (buf, end); | |
| 428 | 2103 |
| 844 | 2104 if (BUF_BEGV (buf) != start) |
| 2105 { | |
| 2106 local_clip_changed = 1; | |
| 2107 SET_BOTH_BUF_BEGV (buf, start, byte_start); | |
| 2108 narrow_line_number_cache (buf); | |
| 2109 } | |
| 2110 if (BUF_ZV (buf) != end) | |
| 2111 { | |
| 2112 local_clip_changed = 1; | |
| 2113 SET_BOTH_BUF_ZV (buf, end, byte_end); | |
| 2114 } | |
| 428 | 2115 |
| 844 | 2116 if (local_clip_changed) |
| 2117 MARK_CLIP_CHANGED; | |
| 2118 | |
| 2119 /* If point is outside the new visible range, move it inside. */ | |
| 2120 BUF_SET_PT (buf, charbpos_clip_to_bounds (BUF_BEGV (buf), BUF_PT (buf), | |
| 2121 BUF_ZV (buf))); | |
| 428 | 2122 } |
| 2123 | |
| 844 | 2124 /* Free all the junk we allocated, so that a `save-restriction' comes |
| 2125 for free in terms of GC junk. */ | |
| 1204 | 2126 free_marker (XCAR (markers)); |
| 2127 free_marker (XCDR (markers)); | |
| 853 | 2128 free_cons (markers); |
| 2129 free_cons (data); | |
| 428 | 2130 |
| 2131 return Qnil; | |
| 2132 } | |
| 2133 | |
| 2134 DEFUN ("save-restriction", Fsave_restriction, 0, UNEVALLED, 0, /* | |
| 2135 Execute BODY, saving and restoring current buffer's restrictions. | |
| 2136 The buffer's restrictions make parts of the beginning and end invisible. | |
| 2137 \(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
|
2138 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
|
2139 restrictions when it is entered, and restores them when it is exited. |
| 428 | 2140 So any `narrow-to-region' within BODY lasts only until the end of the form. |
| 2141 The old restrictions settings are restored | |
| 2142 even in case of abnormal exit (throw or error). | |
| 2143 | |
| 2144 The value returned is the value of the last form in BODY. | |
| 2145 | |
| 844 | 2146 As of XEmacs 22.0, `save-restriction' correctly handles all modifications |
| 2147 made within BODY. (Formerly, it got confused if, within the BODY, you | |
| 2148 widened and then made changes outside the old restricted area.) | |
| 428 | 2149 |
| 2150 Note: if you are using both `save-excursion' and `save-restriction', | |
| 2151 use `save-excursion' outermost: | |
| 2152 (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
|
2153 |
|
80cd90837ac5
Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4470
diff
changeset
|
2154 arguments: (&rest BODY) |
| 428 | 2155 */ |
| 2156 (body)) | |
| 2157 { | |
| 2158 /* This function can GC */ | |
| 844 | 2159 int speccount = |
| 2160 record_unwind_protect (save_restriction_restore, | |
| 2161 save_restriction_save (current_buffer)); | |
| 428 | 2162 |
| 771 | 2163 return unbind_to_1 (speccount, Fprogn (body)); |
| 428 | 2164 } |
| 2165 | |
| 2166 | |
| 2167 DEFUN ("format", Fformat, 1, MANY, 0, /* | |
| 2168 Format a string out of a control-string and arguments. | |
| 2169 The first argument is a control string. | |
| 2170 The other arguments are substituted into it to make the result, a string. | |
| 2171 It may contain %-sequences meaning to substitute the next argument. | |
| 2172 %s means print all objects as-is, using `princ'. | |
| 2173 %S means print all objects as s-expressions, using `prin1'. | |
| 2174 %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
|
2175 %X uppercase hex, %b binary). |
| 428 | 2176 %c means print as a single character. |
| 2177 %f means print as a floating-point number in fixed notation (e.g. 785.200). | |
| 2178 %e or %E means print as a floating-point number in scientific notation | |
| 2179 (e.g. 7.85200e+03). | |
| 2180 %g or %G means print as a floating-point number in "pretty format"; | |
| 2181 depending on the number, either %f or %e/%E format will be used, and | |
| 2182 trailing zeroes are removed from the fractional part. | |
| 2183 The argument used for all but %s and %S must be a number. It will be | |
| 2184 converted to an integer or a floating-point number as necessary. | |
| 2185 | |
| 2186 %$ means reposition to read a specific numbered argument; for example, | |
| 2187 %3$s would apply the `%s' to the third argument after the control string, | |
| 2188 and the next format directive would use the fourth argument, the | |
| 2189 following one the fifth argument, etc. (There must be a positive integer | |
| 2190 between the % and the $). | |
| 2191 Zero or more of the flag characters `-', `+', ` ', `0', and `#' may be | |
| 2192 specified between the optional repositioning spec and the conversion | |
| 2193 character; see below. | |
| 2194 An optional minimum field width may be specified after any flag characters | |
| 2195 and before the conversion character; it specifies the minimum number of | |
| 2196 characters that the converted argument will take up. Padding will be | |
| 2197 added on the left (or on the right, if the `-' flag is specified), as | |
| 2198 necessary. Padding is done with spaces, or with zeroes if the `0' flag | |
| 2199 is specified. | |
| 2200 If the field width is specified as `*', the field width is assumed to have | |
| 2201 been specified as an argument. Any repositioning specification that | |
| 2202 would normally specify the argument to be converted will now specify | |
| 2203 where to find this field width argument, not where to find the argument | |
| 2204 to be converted. If there is no repositioning specification, the normal | |
| 2205 next argument is used. The argument to be converted will be the next | |
| 2206 argument after the field width argument unless the precision is also | |
| 2207 specified as `*' (see below). | |
| 2208 | |
| 2209 An optional period character and precision may be specified after any | |
| 2210 minimum field width. It specifies the minimum number of digits to | |
| 2211 appear in %d, %i, %o, %x, and %X conversions (the number is padded | |
| 2212 on the left with zeroes as necessary); the number of digits printed | |
| 2213 after the decimal point for %f, %e, and %E conversions; the number | |
| 2214 of significant digits printed in %g and %G conversions; and the | |
| 2215 maximum number of non-padding characters printed in %s and %S | |
| 2216 conversions. The default precision for floating-point conversions | |
| 2217 is six. | |
| 2218 If the precision is specified as `*', the precision is assumed to have been | |
| 2219 specified as an argument. The argument used will be the next argument | |
| 2220 after the field width argument, if any. If the field width was not | |
| 2221 specified as an argument, any repositioning specification that would | |
| 2222 normally specify the argument to be converted will now specify where to | |
| 2223 find the precision argument. If there is no repositioning specification, | |
| 2224 the normal next argument is used. | |
| 2225 | |
| 2226 The ` ' and `+' flags mean prefix non-negative numbers with a space or | |
| 2227 plus sign, respectively. | |
| 2228 The `#' flag means print numbers in an alternate, more verbose format: | |
| 2229 octal numbers begin with zero; hex numbers begin with a 0x or 0X; | |
| 2230 a decimal point is printed in %f, %e, and %E conversions even if no | |
| 2231 numbers are printed after it; and trailing zeroes are not omitted in | |
| 2232 %g and %G conversions. | |
| 2233 | |
| 2234 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
|
2235 |
|
80cd90837ac5
Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4470
diff
changeset
|
2236 arguments: (CONTROL-STRING &rest ARGS) |
| 428 | 2237 */ |
| 2238 (int nargs, Lisp_Object *args)) | |
| 2239 { | |
| 2240 /* It should not be necessary to GCPRO ARGS, because | |
| 2241 the caller in the interpreter should take care of that. */ | |
| 2242 | |
| 2243 CHECK_STRING (args[0]); | |
| 771 | 2244 return emacs_vsprintf_string_lisp (0, args[0], nargs - 1, args + 1); |
| 428 | 2245 } |
| 2246 | |
| 2247 | |
| 2248 DEFUN ("char-equal", Fchar_equal, 2, 3, 0, /* | |
| 2249 Return t if two characters match, optionally ignoring case. | |
| 2250 Both arguments must be characters (i.e. NOT integers). | |
| 2251 Case is ignored if `case-fold-search' is non-nil in BUFFER. | |
| 2252 If BUFFER is nil, the current buffer is assumed. | |
| 2253 */ | |
| 444 | 2254 (character1, character2, buffer)) |
| 428 | 2255 { |
| 867 | 2256 Ichar x1, x2; |
| 428 | 2257 struct buffer *b = decode_buffer (buffer, 1); |
| 2258 | |
| 444 | 2259 CHECK_CHAR_COERCE_INT (character1); |
| 2260 CHECK_CHAR_COERCE_INT (character2); | |
| 2261 x1 = XCHAR (character1); | |
| 2262 x2 = XCHAR (character2); | |
| 428 | 2263 |
| 2264 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
|
2265 ? CANONCASE (b, x1) == CANONCASE (b, x2) |
| 428 | 2266 : x1 == x2) |
| 2267 ? Qt : Qnil; | |
| 2268 } | |
| 2269 | |
| 2270 #if 0 /* Undebugged FSFmacs code */ | |
| 2271 /* Transpose the markers in two regions of the current buffer, and | |
| 2272 adjust the ones between them if necessary (i.e.: if the regions | |
| 2273 differ in size). | |
| 2274 | |
| 2275 Traverses the entire marker list of the buffer to do so, adding an | |
| 2276 appropriate amount to some, subtracting from some, and leaving the | |
| 2277 rest untouched. Most of this is copied from adjust_markers in insdel.c. | |
| 2278 | |
| 2279 It's the caller's job to see that (start1 <= end1 <= start2 <= end2). */ | |
| 2280 | |
| 2281 void | |
| 665 | 2282 transpose_markers (Charbpos start1, Charbpos end1, Charbpos start2, Charbpos end2) |
| 428 | 2283 { |
| 2284 Charcount amt1, amt2, diff; | |
| 2285 Lisp_Object marker; | |
| 2286 struct buffer *buf = current_buffer; | |
| 2287 | |
| 2288 /* Update point as if it were a marker. */ | |
| 2289 if (BUF_PT (buf) < start1) | |
| 2290 ; | |
| 2291 else if (BUF_PT (buf) < end1) | |
| 2292 BUF_SET_PT (buf, BUF_PT (buf) + (end2 - end1)); | |
| 2293 else if (BUF_PT (buf) < start2) | |
| 2294 BUF_SET_PT (buf, BUF_PT (buf) + (end2 - start2) - (end1 - start1)); | |
| 2295 else if (BUF_PT (buf) < end2) | |
| 2296 BUF_SET_PT (buf, BUF_PT (buf) - (start2 - start1)); | |
| 2297 | |
| 2298 /* We used to adjust the endpoints here to account for the gap, but that | |
| 2299 isn't good enough. Even if we assume the caller has tried to move the | |
| 2300 gap out of our way, it might still be at start1 exactly, for example; | |
| 2301 and that places it `inside' the interval, for our purposes. The amount | |
| 2302 of adjustment is nontrivial if there's a `denormalized' marker whose | |
| 2303 position is between GPT and GPT + GAP_SIZE, so it's simpler to leave | |
| 2304 the dirty work to Fmarker_position, below. */ | |
| 2305 | |
| 2306 /* The difference between the region's lengths */ | |
| 2307 diff = (end2 - start2) - (end1 - start1); | |
| 2308 | |
| 2309 /* For shifting each marker in a region by the length of the other | |
| 2310 * region plus the distance between the regions. | |
| 2311 */ | |
| 2312 amt1 = (end2 - start2) + (start2 - end1); | |
| 2313 amt2 = (end1 - start1) + (start2 - end1); | |
| 2314 | |
| 2315 for (marker = BUF_MARKERS (buf); !NILP (marker); | |
| 2316 marker = XMARKER (marker)->chain) | |
| 2317 { | |
| 665 | 2318 Charbpos mpos = marker_position (marker); |
| 428 | 2319 if (mpos >= start1 && mpos < end2) |
| 2320 { | |
| 2321 if (mpos < end1) | |
| 2322 mpos += amt1; | |
| 2323 else if (mpos < start2) | |
| 2324 mpos += diff; | |
| 2325 else | |
| 2326 mpos -= amt2; | |
| 2327 set_marker_position (marker, mpos); | |
| 2328 } | |
| 2329 } | |
| 2330 } | |
| 2331 | |
| 2332 #endif /* 0 */ | |
| 2333 | |
| 2334 DEFUN ("transpose-regions", Ftranspose_regions, 4, 5, 0, /* | |
| 2335 Transpose region START1 to END1 with START2 to END2. | |
| 2336 The regions may not be overlapping, because the size of the buffer is | |
| 2337 never changed in a transposition. | |
| 2338 | |
| 444 | 2339 Optional fifth arg LEAVE-MARKERS, if non-nil, means don't transpose |
| 428 | 2340 any markers that happen to be located in the regions. (#### BUG: currently |
| 444 | 2341 this function always acts as if LEAVE-MARKERS is non-nil.) |
| 428 | 2342 |
| 2343 Transposing beyond buffer boundaries is an error. | |
| 2344 */ | |
| 2286 | 2345 (start1, end1, start2, end2, UNUSED (leave_markers))) |
| 428 | 2346 { |
| 665 | 2347 Charbpos startr1, endr1, startr2, endr2; |
| 428 | 2348 Charcount len1, len2; |
| 2349 Lisp_Object string1, string2; | |
| 2350 struct buffer *buf = current_buffer; | |
| 2351 | |
| 444 | 2352 get_buffer_range_char (buf, start1, end1, &startr1, &endr1, 0); |
| 2353 get_buffer_range_char (buf, start2, end2, &startr2, &endr2, 0); | |
| 428 | 2354 |
| 444 | 2355 len1 = endr1 - startr1; |
| 2356 len2 = endr2 - startr2; | |
| 428 | 2357 |
| 444 | 2358 if (startr2 < endr1) |
| 563 | 2359 invalid_argument ("transposed regions not properly ordered", Qunbound); |
| 444 | 2360 else if (startr1 == endr1 || startr2 == endr2) |
| 563 | 2361 invalid_argument ("transposed region may not be of length 0", Qunbound); |
| 428 | 2362 |
| 444 | 2363 string1 = make_string_from_buffer (buf, startr1, len1); |
| 2364 string2 = make_string_from_buffer (buf, startr2, len2); | |
| 2365 buffer_delete_range (buf, startr2, endr2, 0); | |
| 2366 buffer_insert_lisp_string_1 (buf, startr2, string1, 0); | |
| 2367 buffer_delete_range (buf, startr1, endr1, 0); | |
| 2368 buffer_insert_lisp_string_1 (buf, startr1, string2, 0); | |
| 428 | 2369 |
| 2370 /* In FSFmacs there is a whole bunch of really ugly code here | |
| 2371 to attempt to transpose the regions without using up any | |
| 2372 extra memory. Although the intent may be good, the result | |
| 2373 was highly bogus. */ | |
| 2374 | |
| 2375 return Qnil; | |
| 2376 } | |
| 2377 | |
| 2378 | |
| 2379 /************************************************************************/ | |
| 2380 /* initialization */ | |
| 2381 /************************************************************************/ | |
| 2382 | |
| 2383 void | |
| 2384 syms_of_editfns (void) | |
| 2385 { | |
| 563 | 2386 DEFSYMBOL (Qpoint); |
| 2387 DEFSYMBOL (Qmark); | |
| 2388 DEFSYMBOL (Qregion_beginning); | |
| 2389 DEFSYMBOL (Qregion_end); | |
| 2390 DEFSYMBOL (Qformat); | |
| 2391 DEFSYMBOL (Quser_files_and_directories); | |
| 428 | 2392 |
| 2393 DEFSUBR (Fchar_equal); | |
| 2394 DEFSUBR (Fgoto_char); | |
| 2395 DEFSUBR (Fstring_to_char); | |
| 2396 DEFSUBR (Fchar_to_string); | |
| 2397 DEFSUBR (Fbuffer_substring); | |
| 2398 DEFSUBR (Fbuffer_substring_no_properties); | |
| 2399 | |
| 2400 DEFSUBR (Fpoint_marker); | |
| 2401 DEFSUBR (Fmark_marker); | |
| 2402 DEFSUBR (Fpoint); | |
| 2403 DEFSUBR (Fregion_beginning); | |
| 2404 DEFSUBR (Fregion_end); | |
| 2405 DEFSUBR (Fsave_excursion); | |
| 2406 DEFSUBR (Fsave_current_buffer); | |
| 2407 | |
| 2408 DEFSUBR (Fbuffer_size); | |
| 2409 DEFSUBR (Fpoint_max); | |
| 2410 DEFSUBR (Fpoint_min); | |
| 2411 DEFSUBR (Fpoint_min_marker); | |
| 2412 DEFSUBR (Fpoint_max_marker); | |
| 2413 | |
| 2414 DEFSUBR (Fbobp); | |
| 2415 DEFSUBR (Feobp); | |
| 2416 DEFSUBR (Fbolp); | |
| 2417 DEFSUBR (Feolp); | |
| 2418 DEFSUBR (Ffollowing_char); | |
| 2419 DEFSUBR (Fpreceding_char); | |
| 2420 DEFSUBR (Fchar_after); | |
| 2421 DEFSUBR (Fchar_before); | |
| 2422 DEFSUBR (Finsert); | |
| 2423 DEFSUBR (Finsert_string); | |
| 2424 DEFSUBR (Finsert_before_markers); | |
| 2425 DEFSUBR (Finsert_char); | |
| 2426 | |
| 2427 DEFSUBR (Ftemp_directory); | |
| 2428 DEFSUBR (Fuser_login_name); | |
| 2429 DEFSUBR (Fuser_real_login_name); | |
| 2430 DEFSUBR (Fuser_uid); | |
| 2431 DEFSUBR (Fuser_real_uid); | |
| 2432 DEFSUBR (Fuser_full_name); | |
| 2433 DEFSUBR (Fuser_home_directory); | |
| 2434 DEFSUBR (Femacs_pid); | |
| 2435 DEFSUBR (Fcurrent_time); | |
| 2436 DEFSUBR (Fcurrent_process_time); | |
| 2437 DEFSUBR (Fformat_time_string); | |
| 2438 DEFSUBR (Fdecode_time); | |
| 2439 DEFSUBR (Fencode_time); | |
| 2440 DEFSUBR (Fcurrent_time_string); | |
| 2441 DEFSUBR (Fcurrent_time_zone); | |
| 2442 DEFSUBR (Fset_time_zone_rule); | |
| 2443 DEFSUBR (Fsystem_name); | |
| 2444 DEFSUBR (Fformat); | |
| 2445 | |
| 2446 DEFSUBR (Finsert_buffer_substring); | |
| 2447 DEFSUBR (Fcompare_buffer_substrings); | |
| 2448 DEFSUBR (Fsubst_char_in_region); | |
| 2449 DEFSUBR (Ftranslate_region); | |
| 2450 DEFSUBR (Fdelete_region); | |
| 2451 DEFSUBR (Fwiden); | |
| 2452 DEFSUBR (Fnarrow_to_region); | |
| 2453 DEFSUBR (Fsave_restriction); | |
| 2454 DEFSUBR (Ftranspose_regions); | |
| 2455 | |
| 563 | 2456 DEFSYMBOL (Qzmacs_update_region); |
| 2457 DEFSYMBOL (Qzmacs_deactivate_region); | |
| 2458 DEFSYMBOL (Qzmacs_region_buffer); | |
| 428 | 2459 } |
| 2460 | |
| 2461 void | |
| 2462 vars_of_editfns (void) | |
| 2463 { | |
| 2464 staticpro (&Vsystem_name); | |
| 2465 #if 0 | |
| 2466 staticpro (&Vuser_name); | |
| 2467 staticpro (&Vuser_real_name); | |
| 2468 #endif | |
| 2469 DEFVAR_BOOL ("zmacs-regions", &zmacs_regions /* | |
| 2470 *Whether LISPM-style active regions should be used. | |
| 2471 This means that commands which operate on the region (the area between the | |
| 2472 point and the mark) will only work while the region is in the ``active'' | |
| 2473 state, which is indicated by highlighting. Executing most commands causes | |
| 2474 the region to not be in the active state, so (for example) \\[kill-region] will only | |
| 2475 work immediately after activating the region. | |
| 2476 | |
| 2477 More specifically: | |
| 2478 | |
| 2479 - Commands which operate on the region only work if the region is active. | |
| 2480 - Only a very small set of commands cause the region to become active: | |
| 444 | 2481 Those commands whose semantics are to mark an area, like `mark-defun'. |
| 428 | 2482 - The region is deactivated after each command that is executed, except that: |
| 2483 - "Motion" commands do not change whether the region is active or not. | |
| 2484 | |
| 2485 set-mark-command (C-SPC) pushes a mark and activates the region. Moving the | |
| 2486 cursor with normal motion commands (C-n, C-p, etc) will cause the region | |
| 2487 between point and the recently-pushed mark to be highlighted. It will | |
| 2488 remain highlighted until some non-motion command is executed. | |
| 2489 | |
| 2490 exchange-point-and-mark (\\[exchange-point-and-mark]) activates the region. So if you mark a | |
| 2491 region and execute a command that operates on it, you can reactivate the | |
| 2492 same region with \\[exchange-point-and-mark] (or perhaps \\[exchange-point-and-mark] \\[exchange-point-and-mark]) to operate on it | |
| 2493 again. | |
| 2494 | |
| 2495 Generally, commands which push marks as a means of navigation (like | |
| 2496 beginning-of-buffer and end-of-buffer (M-< and M->)) do not activate the | |
| 2497 region. But commands which push marks as a means of marking an area of | |
| 2498 text (like mark-defun (\\[mark-defun]), mark-word (\\[mark-word]) or mark-whole-buffer (\\[mark-whole-buffer])) | |
| 2499 do activate the region. | |
| 2500 | |
| 2501 The way the command loop actually works with regard to deactivating the | |
| 2502 region is as follows: | |
| 2503 | |
| 2504 - If the variable `zmacs-region-stays' has been set to t during the command | |
| 2505 just executed, the region is left alone (this is how the motion commands | |
| 2506 make the region stay around; see the `_' flag in the `interactive' | |
| 2507 specification). `zmacs-region-stays' is reset to nil before each command | |
| 2508 is executed. | |
| 2509 - If the function `zmacs-activate-region' has been called during the command | |
| 2510 just executed, the region is left alone. Very few functions should | |
| 2511 actually call this function. | |
| 2512 - Otherwise, if the region is active, the region is deactivated and | |
| 2513 the `zmacs-deactivate-region-hook' is called. | |
| 2514 */ ); | |
| 2515 /* Zmacs style active regions are now ON by default */ | |
| 2516 zmacs_regions = 1; | |
| 2517 | |
| 2518 DEFVAR_BOOL ("zmacs-region-active-p", &zmacs_region_active_p /* | |
| 2519 Do not alter this. It is for internal use only. | |
| 2520 */ ); | |
| 2521 zmacs_region_active_p = 0; | |
| 2522 | |
| 2523 DEFVAR_BOOL ("zmacs-region-stays", &zmacs_region_stays /* | |
| 2524 Whether the current command will deactivate the region. | |
| 2525 Commands which do not wish to affect whether the region is currently | |
| 2526 highlighted should set this to t. Normally, the region is turned off after | |
| 2527 executing each command that did not explicitly turn it on with the function | |
| 2528 zmacs-activate-region. Setting this to true lets a command be non-intrusive. | |
| 2529 See the variable `zmacs-regions'. | |
| 2530 | |
| 2531 The same effect can be achieved using the `_' interactive specification. | |
| 442 | 2532 |
| 2533 `zmacs-region-stays' is reset to nil before each command is executed. | |
| 428 | 2534 */ ); |
| 2535 zmacs_region_stays = 0; | |
| 2536 | |
| 2537 DEFVAR_BOOL ("atomic-extent-goto-char-p", &atomic_extent_goto_char_p /* | |
| 2538 Do not use this -- it will be going away soon. | |
| 2539 Indicates if `goto-char' has just been run. This information is allegedly | |
| 2540 needed to get the desired behavior for atomic extents and unfortunately | |
| 2541 is not available by any other means. | |
| 2542 */ ); | |
| 2543 atomic_extent_goto_char_p = 0; | |
| 2544 #ifdef AMPERSAND_FULL_NAME | |
| 771 | 2545 Fprovide (intern ("ampersand-full-name")); |
| 428 | 2546 #endif |
| 2547 | |
| 2548 DEFVAR_LISP ("user-full-name", &Vuser_full_name /* | |
| 2549 *The name of the user. | |
| 4266 | 2550 The function `user-full-name' will return the value of this variable, when |
| 2551 called without arguments. | |
| 428 | 2552 This is initialized to the value of the NAME environment variable. |
| 2553 */ ); | |
| 2554 /* Initialized at run-time. */ | |
| 2555 Vuser_full_name = Qnil; | |
| 2556 } |