Mercurial > hg > xemacs-beta

comparison src/editfns.c @ 219:262b8bb4a523 r20-4b8

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-4b8
author cvs
date Mon, 13 Aug 2007 10:09:35 +0200
parents 78478c60bfcd
children 65c19d2020f7
comparison
equal deleted inserted replaced
218:c9f226976f56 219:262b8bb4a523
51 use lisp variables here, then they can be 51 use lisp variables here, then they can be
52 initialized to nil and then set to their 52 initialized to nil and then set to their
53 real values upon the first call to the 53 real values upon the first call to the
54 functions that generate them. --stig */ 54 functions that generate them. --stig */
55 Lisp_Object Vuser_real_login_name; /* login name of current user ID */ 55 Lisp_Object Vuser_real_login_name; /* login name of current user ID */
56 Lisp_Object Vuser_full_name; /* full name of current user */
57 Lisp_Object Vuser_login_name; /* user name from LOGNAME or USER. */ 56 Lisp_Object Vuser_login_name; /* user name from LOGNAME or USER. */
58 #endif 57 #endif
58
59 /* It's useful to be able to set this as user customization, so we'll
60 keep it. */
61 Lisp_Object Vuser_full_name;
62 Lisp_Object Fuser_full_name (Lisp_Object);
59 63
60 extern char *get_system_name (void); 64 extern char *get_system_name (void);
61 65
62 Lisp_Object Qformat; 66 Lisp_Object Qformat;
63 67
70 74
71 void 75 void
72 init_editfns (void) 76 init_editfns (void)
73 { 77 {
74 /* Only used in removed code below. */ 78 /* Only used in removed code below. */
75 #if 0 79 Bufbyte *p;
76 char *user_name;
77 Bufbyte *p, *q;
78 struct passwd *pw; /* password entry for the current user */
79 Lisp_Object tem;
80 #endif
81 80
82 environbuf = 0; 81 environbuf = 0;
83 82
84 /* Set up system_name even when dumping. */ 83 /* Set up system_name even when dumping. */
85 init_system_name (); 84 init_system_name ();
86 85
87 #if 0 /* this is now dynamic */
88 /* don't lose utterly if someone uses these during loadup. */
89 Vuser_real_login_name = Qnil;
90 Vuser_login_name = Qnil;
91 Vuser_full_name = Qnil;
92
93 #ifndef CANNOT_DUMP 86 #ifndef CANNOT_DUMP
94 /* Don't bother with this on initial start when just dumping out */
95 if (!initialized) 87 if (!initialized)
96 return; 88 return;
97 #endif /* not CANNOT_DUMP */
98
99 pw = (struct passwd *) getpwuid (getuid ());
100 #ifdef MSDOS
101 /* We let the real user name default to "root" because that's quite
102 accurate on MSDOG and because it lets Emacs find the init file.
103 (The DVX libraries override the Djgpp libraries here.) */
104 Vuser_real_login_name = build_string (pw ? pw->pw_name : "root");
105 #else
106 Vuser_real_login_name = build_string (pw ? pw->pw_name : "unknown");
107 #endif 89 #endif
108 90
109 /* Get the effective user name, by consulting environment variables, 91 if ((p = (Bufbyte *) getenv ("NAME")))
110 or the effective uid if those are unset. */ 92 /* I don't think it's the right thing to do the ampersand
111 user_name = getenv ("LOGNAME"); 93 modification on NAME. Not that it matters anymore... -hniksic */
112 if (!user_name) 94 Vuser_full_name = build_ext_string (p, FORMAT_OS);
113 #ifdef WINDOWSNT 95 else
114 user_name = (char *) getenv ("USERNAME"); /* it's USERNAME on NT */ 96 Vuser_full_name = Fuser_full_name (Qnil);
115 #else /* WINDOWSNT */
116 user_name = (char *) getenv ("USER");
117 #endif /* WINDOWSNT */
118 if (!user_name)
119 {
120 /* #### - do we really want the EFFECTIVE uid here? Are these flipped? */
121 /* I ask because LOGNAME and USER vars WILL NOT MATCH the euid. --Stig */
122 pw = (struct passwd *) getpwuid (geteuid ());
123 user_name = (char *) (pw ? pw->pw_name : "unknown");
124 }
125 Vuser_login_name = build_string (user_name);
126
127 /* If the user name claimed in the environment vars differs from
128 the real uid, use the claimed name to find the full name. */
129 tem = Fstring_equal (Vuser_login_name, Vuser_real_login_name);
130 if (NILP (tem))
131 {
132 /* Jamie reports that IRIX gets wedged by SIGIO/SIGALARM occurring
133 in select(), called from getpwnam(). */
134 slow_down_interrupts ();
135 pw = (struct passwd *)
136 getpwnam ((char *) XSTRING_DATA (Vuser_login_name));
137 speed_up_interrupts ();
138 }
139
140 p = (Bufbyte *) ((pw) ? USER_FULL_NAME : "unknown"); /* don't gettext here */
141 q = (Bufbyte *) strchr ((char *) p, ',');
142 Vuser_full_name = make_ext_string (p, (q ? q - p : strlen ((char *) p)),
143 FORMAT_OS);
144
145 #ifdef AMPERSAND_FULL_NAME
146 p = XSTRING_DATA (Vuser_full_name);
147 q = (Bufbyte *) strchr ((char *) p, '&');
148 /* Substitute the login name for the &, upcasing the first character. */
149 if (q)
150 {
151 char *r = (char *)
152 alloca (strlen ((char *) p) + XSTRING_LENGTH (Vuser_login_name) + 1);
153 Charcount fullname_off = bytecount_to_charcount (p, q - p);
154 memcpy (r, p, q - p);
155 r[q - p] = 0;
156 strcat (r, (char *) XSTRING_DATA (Vuser_login_name));
157 strcat (r, q + 1);
158 Vuser_full_name = build_string (r);
159 set_string_char (XSTRING (Vuser_full_name), fullname_off,
160 UPCASE (current_buffer,
161 string_char (XSTRING (Vuser_full_name),
162 fullname_off)));
163 }
164 #endif /* AMPERSAND_FULL_NAME */
165
166 p = (Bufbyte *) getenv ("NAME");
167 if (p)
168 Vuser_full_name = build_string ((char *) p);
169 #endif /* 0 */
170 } 97 }
171 98
172 DEFUN ("char-to-string", Fchar_to_string, 1, 1, 0, /* 99 DEFUN ("char-to-string", Fchar_to_string, 1, 1, 0, /*
173 Convert arg CH to a one-character string containing that character. 100 Convert arg CH to a one-character string containing that character.
174 */ 101 */
243 (dont_copy_p, buffer)) 170 (dont_copy_p, buffer))
244 { 171 {
245 struct buffer *b = decode_buffer (buffer, 1); 172 struct buffer *b = decode_buffer (buffer, 1);
246 if (NILP (dont_copy_p)) 173 if (NILP (dont_copy_p))
247 return Fcopy_marker (b->point_marker, Qnil); 174 return Fcopy_marker (b->point_marker, Qnil);
248 return b->point_marker; 175 else
176 return b->point_marker;
249 } 177 }
250 178
251 /* The following two functions end up being identical but it's 179 /* The following two functions end up being identical but it's
252 cleaner to declare them separately. */ 180 cleaner to declare them separately. */
253 181
392 return b->mark; 320 return b->mark;
393 return Qnil; 321 return Qnil;
394 } 322 }
395 323
396 324
397 /* The saved object looks like this: 325 /* The saved object is a cons:
398 326
399 (COPY-OF-POINT-MARKER . (COPY-OF-MARK . VISIBLE-P)) 327 (COPY-OF-POINT-MARKER . COPY-OF-MARK)
400 328
401 where 329 We used to have another cons for a VISIBLE-P element, which was t
402 330 if `(eq (current-buffer) (window-buffer (selected-window)))' but it
403 VISIBLE-P is t if `(eq (current-buffer) (window-buffer (selected-window)))' 331 was unused for a long time, so I removed it. --hniksic */
404 but is not actually used any more.
405 */
406 Lisp_Object 332 Lisp_Object
407 save_excursion_save (void) 333 save_excursion_save (void)
408 { 334 {
409 struct buffer *b; 335 struct buffer *b;
410 int visible; 336
411 Lisp_Object tem; 337 /* #### Huh? --hniksic */
412 338 /*if (preparing_for_armageddon) return Qnil;*/
413 if (preparing_for_armageddon)
414 return Qnil;
415 else
416 {
417 b = current_buffer;
418 visible = (XBUFFER (XWINDOW (Fselected_window (Qnil))->buffer) == b);
419 tem = ((visible) ? Qt : Qnil);
420 }
421 339
422 #ifdef ERROR_CHECK_BUFPOS 340 #ifdef ERROR_CHECK_BUFPOS
423 assert (XINT (Fpoint (Qnil)) == 341 assert (XINT (Fpoint (Qnil)) ==
424 XINT (Fmarker_position (Fpoint_marker (Qt, Qnil)))); 342 XINT (Fmarker_position (Fpoint_marker (Qt, Qnil))));
425 #endif 343 #endif
426 344
427 #if 0 /* FSFmacs */ 345 b = current_buffer;
428 tem = Fcons (tem, b->mark_active); 346
429 #endif 347 return noseeum_cons (noseeum_copy_marker (b->point_marker, Qnil),
430 348 noseeum_copy_marker (b->mark, Qnil));
431 return noseeum_cons (noseeum_copy_marker (Fpoint_marker (Qt, Qnil), Qnil),
432 noseeum_cons (noseeum_copy_marker (b->mark, Qnil),
433 tem));
434 } 349 }
435 350
436 Lisp_Object 351 Lisp_Object
437 save_excursion_restore (Lisp_Object info) 352 save_excursion_restore (Lisp_Object info)
438 { 353 {
439 Lisp_Object tem; 354 Lisp_Object buffer = Fmarker_buffer (XCAR (info));
440 int visible; 355
441 struct gcpro gcpro1, gcpro2; 356 /* If buffer being returned to is now deleted, avoid error --
442 357 otherwise could get error here while unwinding to top level and
443 tem = Fmarker_buffer (Fcar (info)); 358 crash. In that case, Fmarker_buffer returns nil now. */
444 /* If buffer being returned to is now deleted, avoid error */ 359 if (!NILP (buffer))
445 /* Otherwise could get error here while unwinding to top level 360 {
446 and crash */ 361 struct buffer *buf = XBUFFER (buffer);
447 /* In that case, Fmarker_buffer returns nil now. */ 362 struct gcpro gcpro1;
448 if (NILP (tem)) 363 GCPRO1 (info);
449 return Qnil; 364 set_buffer_internal (buf);
450 /* Need gcpro in case Lisp hooks get run */ 365 Fgoto_char (XCAR (info), buffer);
451 GCPRO2 (info, tem); 366 Fset_marker (buf->mark, XCDR (info), buffer);
452 Fset_buffer (tem);
453 tem = Fcar (info);
454 Fgoto_char (tem, Fcurrent_buffer ());
455 tem = Fcar (Fcdr (info));
456 Fset_marker (current_buffer->mark, tem, Fcurrent_buffer ());
457 tem = Fcdr (Fcdr (info));
458 visible = !NILP (tem);
459 367
460 #if 0 /* We used to make the current buffer visible in the selected window 368 #if 0 /* We used to make the current buffer visible in the selected window
461 if that was true previously. That avoids some anomalies. 369 if that was true previously. That avoids some anomalies.
462 But it creates others, and it wasn't documented, and it is simpler 370 But it creates others, and it wasn't documented, and it is simpler
463 and cleaner never to alter the window/buffer connections. */ 371 and cleaner never to alter the window/buffer connections. */
464 /* #### I'm certain some code somewhere depends on this behavior. --jwz */ 372 /* I'm certain some code somewhere depends on this behavior. --jwz */
465 373 /* Even if it did, it certainly doesn't matter anymore, because
466 if (visible 374 this has been the behaviour for countless XEmacs releases
467 && (current_buffer != XBUFFER (XWINDOW (selected_window)->buffer))) 375 now. --hniksic */
468 switch_to_buffer (Fcurrent_buffer (), Qnil); 376 if (visible
377 && (current_buffer != XBUFFER (XWINDOW (selected_window)->buffer)))
378 switch_to_buffer (Fcurrent_buffer (), Qnil);
469 #endif 379 #endif
470 380
471 UNGCPRO; 381 UNGCPRO;
382 }
383
472 /* Free all the junk we allocated, so that a `save-excursion' comes 384 /* Free all the junk we allocated, so that a `save-excursion' comes
473 for free in terms of GC junk. */ 385 for free in terms of GC junk. */
474 free_marker (XMARKER (XCAR (info))); 386 free_marker (XMARKER (XCAR (info)));
475 free_marker (XMARKER (XCAR (XCDR (info)))); 387 free_marker (XMARKER (XCDR (info)));
476 free_cons (XCONS (XCDR (info)));
477 free_cons (XCONS (info)); 388 free_cons (XCONS (info));
478 return Qnil; 389 return Qnil;
479 } 390 }
480 391
481 DEFUN ("save-excursion", Fsave_excursion, 0, UNEVALLED, 0, /* 392 DEFUN ("save-excursion", Fsave_excursion, 0, UNEVALLED, 0, /*
496 407
497 Lisp_Object 408 Lisp_Object
498 save_current_buffer_restore (Lisp_Object buffer) 409 save_current_buffer_restore (Lisp_Object buffer)
499 { 410 {
500 struct buffer *buf = XBUFFER (buffer); 411 struct buffer *buf = XBUFFER (buffer);
412 /* Avoid signaling an error if the buffer is no longer alive. This
413 is for consistency with save-excursion. */
501 if (!BUFFER_LIVE_P (buf)) 414 if (!BUFFER_LIVE_P (buf))
502 return Qnil; 415 return Qnil;
503 set_buffer_internal (buf); 416 set_buffer_internal (buf);
504 return Qnil; 417 return Qnil;
505 } 418 }
774 687
775 DEFUN ("user-full-name", Fuser_full_name, 0, 1, 0, /* 688 DEFUN ("user-full-name", Fuser_full_name, 0, 1, 0, /*
776 Return the full name of the user logged in, as a string. 689 Return the full name of the user logged in, as a string.
777 If the optional argument USER is given, then the full name for that 690 If the optional argument USER is given, then the full name for that
778 user is returned, or nil. USER may be either a login name or a uid. 691 user is returned, or nil. USER may be either a login name or a uid.
692
693 If USER is nil, and `user-full-name' contains a string, the
694 value of `user-full-name' is returned.
779 */ 695 */
780 (user)) 696 (user))
781 { 697 {
782 Lisp_Object user_name = (STRINGP (user) ? user : Fuser_login_name (user)); 698 Lisp_Object user_name;
783 struct passwd *pw = NULL; 699 struct passwd *pw = NULL;
784 Lisp_Object tem; 700 Lisp_Object tem;
785 char *p, *q; 701 char *p, *q;
786 702
703 if (NILP (user) && STRINGP (Vuser_full_name))
704 return Vuser_full_name;
705
706 user_name = (STRINGP (user) ? user : Fuser_login_name (user));
787 if (!NILP (user_name)) /* nil when nonexistent UID passed as arg */ 707 if (!NILP (user_name)) /* nil when nonexistent UID passed as arg */
788 { 708 {
789 CONST char *user_name_ext; 709 CONST char *user_name_ext;
790 710
791 /* Fuck me. getpwnam() can call select() and (under IRIX at least) 711 /* Fuck me. getpwnam() can call select() and (under IRIX at least)
828 tem = build_string (r); 748 tem = build_string (r);
829 } 749 }
830 } 750 }
831 #endif /* AMPERSAND_FULL_NAME */ 751 #endif /* AMPERSAND_FULL_NAME */
832 752
833 p = getenv ("NAME");
834 if (p)
835 tem = build_string (p);
836 return tem; 753 return tem;
837 } 754 }
838 755
839 DEFUN ("system-name", Fsystem_name, 0, 0, 0, /* 756 DEFUN ("system-name", Fsystem_name, 0, 0, 0, /*
840 Return the name of the machine you are running on, as a string. 757 Return the name of the machine you are running on, as a string.
925 Lisp_Object high, low; 842 Lisp_Object high, low;
926 high = Fcar (specified_time); 843 high = Fcar (specified_time);
927 CHECK_INT (high); 844 CHECK_INT (high);
928 low = Fcdr (specified_time); 845 low = Fcdr (specified_time);
929 if (CONSP (low)) 846 if (CONSP (low))
930 low = Fcar (low); 847 low = XCAR (low);
931 CHECK_INT (low); 848 CHECK_INT (low);
932 *result = (XINT (high) << 16) + (XINT (low) & 0xffff); 849 *result = (XINT (high) << 16) + (XINT (low) & 0xffff);
933 return *result >> 16 == XINT (high); 850 return *result >> 16 == XINT (high);
934 } 851 }
935 } 852 }
1095 CHECK_INT (*args); tm.tm_year = XINT (*args++) - 1900;/* year */ 1012 CHECK_INT (*args); tm.tm_year = XINT (*args++) - 1900;/* year */
1096 1013
1097 tm.tm_isdst = -1; 1014 tm.tm_isdst = -1;
1098 1015
1099 if (CONSP (zone)) 1016 if (CONSP (zone))
1100 zone = Fcar (zone); 1017 zone = XCAR (zone);
1101 if (NILP (zone)) 1018 if (NILP (zone))
1102 _time = mktime (&tm); 1019 _time = mktime (&tm);
1103 else 1020 else
1104 { 1021 {
1105 char tzbuf[100]; 1022 char tzbuf[100];
1812 struct buffer *buf; 1729 struct buffer *buf;
1813 Charcount newhead, newtail; 1730 Charcount newhead, newtail;
1814 Lisp_Object tem; 1731 Lisp_Object tem;
1815 int local_clip_changed = 0; 1732 int local_clip_changed = 0;
1816 1733
1817 buf = XBUFFER (Fcar (data)); 1734 buf = XBUFFER (XCAR (data));
1818 if (!BUFFER_LIVE_P (buf)) 1735 if (!BUFFER_LIVE_P (buf))
1819 /* someone could have killed the buffer in the meantime ... */ 1736 {
1820 return Qnil; 1737 /* someone could have killed the buffer in the meantime ... */
1821 tem = Fcdr (data); 1738 free_cons (XCONS (XCDR (data)));
1822 newhead = XINT (Fcar (tem)); 1739 free_cons (XCONS (data));
1823 newtail = XINT (Fcdr (tem)); 1740 return Qnil;
1824 while (CONSP (data)) 1741 }
1825 { 1742 tem = XCDR (data);
1826 struct Lisp_Cons *victim = XCONS (data); 1743 newhead = XINT (XCAR (tem));
1827 data = victim->cdr; 1744 newtail = XINT (XCDR (tem));
1828 free_cons (victim); 1745
1829 } 1746 free_cons (XCONS (XCDR (data)));
1747 free_cons (XCONS (data));
1830 1748
1831 if (newhead + newtail > BUF_Z (buf) - BUF_BEG (buf)) 1749 if (newhead + newtail > BUF_Z (buf) - BUF_BEG (buf))
1832 { 1750 {
1833 newhead = 0; 1751 newhead = 0;
1834 newtail = 0; 1752 newtail = 0;
1835 } 1753 }
1754
1836 { 1755 {
1837 Bufpos start, end; 1756 Bufpos start, end;
1838 Bytind bi_start, bi_end; 1757 Bytind bi_start, bi_end;
1839 1758
1840 start = BUF_BEG (buf) + newhead; 1759 start = BUF_BEG (buf) + newhead;
2203 void 2122 void
2204 vars_of_editfns (void) 2123 vars_of_editfns (void)
2205 { 2124 {
2206 staticpro (&Vsystem_name); 2125 staticpro (&Vsystem_name);
2207 #if 0 2126 #if 0
2208 staticpro (&Vuser_full_name);
2209 staticpro (&Vuser_name); 2127 staticpro (&Vuser_name);
2210 staticpro (&Vuser_real_name); 2128 staticpro (&Vuser_real_name);
2211 #endif 2129 #endif
2212 DEFVAR_BOOL ("zmacs-regions", &zmacs_regions /* 2130 DEFVAR_BOOL ("zmacs-regions", &zmacs_regions /*
2213 *Whether LISPM-style active regions should be used. 2131 *Whether LISPM-style active regions should be used.
2262 Do not alter this. It is for internal use only. 2180 Do not alter this. It is for internal use only.
2263 */ ); 2181 */ );
2264 zmacs_region_active_p = 0; 2182 zmacs_region_active_p = 0;
2265 2183
2266 DEFVAR_BOOL ("zmacs-region-stays", &zmacs_region_stays /* 2184 DEFVAR_BOOL ("zmacs-region-stays", &zmacs_region_stays /*
2185 Whether the current command will deactivate the region.
2267 Commands which do not wish to affect whether the region is currently 2186 Commands which do not wish to affect whether the region is currently
2268 highlighted should set this to t. Normally, the region is turned off after 2187 highlighted should set this to t. Normally, the region is turned off after
2269 executing each command that did not explicitly turn it on with the function 2188 executing each command that did not explicitly turn it on with the function
2270 zmacs-activate-region. Setting this to true lets a command be non-intrusive. 2189 zmacs-activate-region. Setting this to true lets a command be non-intrusive.
2271 See the variable `zmacs-regions'. 2190 See the variable `zmacs-regions'.
2191
2192 The same effect can be achieved using the `_' interactive specification.
2272 */ ); 2193 */ );
2273 zmacs_region_stays = 0; 2194 zmacs_region_stays = 0;
2274 2195
2275 DEFVAR_BOOL ("atomic-extent-goto-char-p", &atomic_extent_goto_char_p /* 2196 DEFVAR_BOOL ("atomic-extent-goto-char-p", &atomic_extent_goto_char_p /*
2276 Do not use this -- it will be going away soon. 2197 Do not use this -- it will be going away soon.
2280 */ ); 2201 */ );
2281 atomic_extent_goto_char_p = 0; 2202 atomic_extent_goto_char_p = 0;
2282 #ifdef AMPERSAND_FULL_NAME 2203 #ifdef AMPERSAND_FULL_NAME
2283 Fprovide(intern("ampersand-full-name")); 2204 Fprovide(intern("ampersand-full-name"));
2284 #endif 2205 #endif
2285 } 2206
2207 DEFVAR_LISP ("user-full-name", &Vuser_full_name /*
2208 *The name of the user.
2209 The function `user-full-name', which will return the value of this
2210 variable, when called without arguments.
2211 This is initialized to the value of the NAME environment variable.
2212 */ );
2213 /* Initialized at run-time. */
2214 Vuser_full_name = Qnil;
2215 }