Mercurial > hg > xemacs-beta

comparison src/symbols.c @ 771:943eaba38521

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2002-03-13 08:51:24 by ben] The big ben-mule-21-5 check-in! Various files were added and deleted. See CHANGES-ben-mule. There are still some test suite failures. No crashes, though. Many of the failures have to do with problems in the test suite itself rather than in the actual code. I'll be addressing these in the next day or so -- none of the test suite failures are at all critical. Meanwhile I'll be trying to address the biggest issues -- i.e. build or run failures, which will almost certainly happen on various platforms. All comments should be sent to ben@xemacs.org -- use a Cc: if necessary when sending to mailing lists. There will be pre- and post- tags, something like pre-ben-mule-21-5-merge-in, and post-ben-mule-21-5-merge-in.
author ben
date Wed, 13 Mar 2002 08:54:06 +0000
parents fdefd0186b75
children e38acbeb1cae
comparison
equal deleted inserted replaced
770:336a418893b5 771:943eaba38521
1 /* "intern" and friends -- moved here from lread.c and data.c 1 /* "intern" and friends -- moved here from lread.c and data.c
2 Copyright (C) 1985-1989, 1992-1994 Free Software Foundation, Inc. 2 Copyright (C) 1985-1989, 1992-1994 Free Software Foundation, Inc.
3 Copyright (C) 1995, 2000 Ben Wing. 3 Copyright (C) 1995, 2000, 2001 Ben Wing.
4 4
5 This file is part of XEmacs. 5 This file is part of XEmacs.
6 6
7 XEmacs is free software; you can redistribute it and/or modify it 7 XEmacs is free software; you can redistribute it and/or modify it
8 under the terms of the GNU General Public License as published by the 8 under the terms of the GNU General Public License as published by the
175 } 175 }
176 return obarray; 176 return obarray;
177 } 177 }
178 178
179 Lisp_Object 179 Lisp_Object
180 intern (const char *str) 180 intern_int (const Intbyte *str)
181 { 181 {
182 Bytecount len = strlen (str); 182 Bytecount len = qxestrlen (str);
183 const Intbyte *buf = (const Intbyte *) str;
184 Lisp_Object obarray = Vobarray; 183 Lisp_Object obarray = Vobarray;
185 184
186 if (!VECTORP (obarray) || XVECTOR_LENGTH (obarray) == 0) 185 if (!VECTORP (obarray) || XVECTOR_LENGTH (obarray) == 0)
187 obarray = check_obarray (obarray); 186 obarray = check_obarray (obarray);
188 187
189 { 188 {
190 Lisp_Object tem = oblookup (obarray, buf, len); 189 Lisp_Object tem = oblookup (obarray, str, len);
191 if (SYMBOLP (tem)) 190 if (SYMBOLP (tem))
192 return tem; 191 return tem;
193 } 192 }
194 193
195 return Fintern (make_string (buf, len), obarray); 194 return Fintern (make_string (str, len), obarray);
195 }
196
197 Lisp_Object
198 intern (const CIntbyte *str)
199 {
200 return intern_int ((Intbyte *) str);
196 } 201 }
197 202
198 DEFUN ("intern", Fintern, 1, 2, 0, /* 203 DEFUN ("intern", Fintern, 1, 2, 0, /*
199 Return the canonical symbol whose name is STRING. 204 Return the canonical symbol whose name is STRING.
200 If there is none, one is created by this function and returned. 205 If there is none, one is created by this function and returned.
1133 { 1138 {
1134 struct buffer *b = XBUFFER (XCDR (elt)); 1139 struct buffer *b = XBUFFER (XCDR (elt));
1135 if (!(b->local_var_flags & mask)) 1140 if (!(b->local_var_flags & mask))
1136 { 1141 {
1137 if (magicfun) 1142 if (magicfun)
1138 magicfun (sym, &value, make_buffer (b), 0); 1143 magicfun (sym, &value, wrap_buffer (b), 0);
1139 *((Lisp_Object *) (offset + (char *) b)) = value; 1144 *((Lisp_Object *) (offset + (char *) b)) = value;
1140 } 1145 }
1141 } 1146 }
1142 } 1147 }
1143 } 1148 }
1250 set_default_buffer_slot_variable (sym, newval); 1255 set_default_buffer_slot_variable (sym, newval);
1251 return; 1256 return;
1252 1257
1253 case SYMVAL_CURRENT_BUFFER_FORWARD: 1258 case SYMVAL_CURRENT_BUFFER_FORWARD:
1254 if (magicfun) 1259 if (magicfun)
1255 magicfun (sym, &newval, make_buffer (current_buffer), 0); 1260 magicfun (sym, &newval, wrap_buffer (current_buffer), 0);
1256 *((Lisp_Object *) ((char *) current_buffer 1261 *((Lisp_Object *) ((char *) current_buffer
1257 + ((char *) symbol_value_forward_forward (fwd) 1262 + ((char *) symbol_value_forward_forward (fwd)
1258 - (char *) &buffer_local_flags))) 1263 - (char *) &buffer_local_flags)))
1259 = newval; 1264 = newval;
1260 return; 1265 return;
2377 Lisp_Object in_object, int flags) = 2382 Lisp_Object in_object, int flags) =
2378 symbol_value_forward_magicfun (fwd); 2383 symbol_value_forward_magicfun (fwd);
2379 Lisp_Object oldval = * (Lisp_Object *) 2384 Lisp_Object oldval = * (Lisp_Object *)
2380 (offset + (char *) XBUFFER (Vbuffer_defaults)); 2385 (offset + (char *) XBUFFER (Vbuffer_defaults));
2381 if (magicfun) 2386 if (magicfun)
2382 (magicfun) (variable, &oldval, make_buffer (current_buffer), 0); 2387 (magicfun) (variable, &oldval, wrap_buffer (current_buffer), 0);
2383 *(Lisp_Object *) (offset + (char *) current_buffer) 2388 *(Lisp_Object *) (offset + (char *) current_buffer)
2384 = oldval; 2389 = oldval;
2385 current_buffer->local_var_flags &= ~mask; 2390 current_buffer->local_var_flags &= ~mask;
2386 } 2391 }
2387 return variable; 2392 return variable;
3252 } 3257 }
3253 3258
3254 void 3259 void
3255 reinit_symbols_once_early (void) 3260 reinit_symbols_once_early (void)
3256 { 3261 {
3257 #ifndef Qzero
3258 Qzero = make_int (0); /* Only used if Lisp_Object is a union type */
3259 #endif
3260
3261 #ifndef Qnull_pointer
3262 /* C guarantees that Qnull_pointer will be initialized to all 0 bits,
3263 so the following is actually a no-op. */
3264 XSETOBJ (Qnull_pointer, 0);
3265 #endif
3266 } 3262 }
3267 3263
3268 static void 3264 static void
3269 defsymbol_massage_name_1 (Lisp_Object *location, const char *name, int dump_p, 3265 defsymbol_massage_name_1 (Lisp_Object *location, const char *name, int dump_p,
3270 int multiword_predicate_p) 3266 int multiword_predicate_p)
3455 defsymbol (symbol, name); 3451 defsymbol (symbol, name);
3456 3452
3457 assert (SYMBOLP (inherits_from)); 3453 assert (SYMBOLP (inherits_from));
3458 conds = Fget (inherits_from, Qerror_conditions, Qnil); 3454 conds = Fget (inherits_from, Qerror_conditions, Qnil);
3459 Fput (*symbol, Qerror_conditions, Fcons (*symbol, conds)); 3455 Fput (*symbol, Qerror_conditions, Fcons (*symbol, conds));
3460 /* NOT build_translated_string (). This function is called at load time 3456 /* NOT build_msg_string (). This function is called at load time
3461 and the string needs to get translated at run time. (This happens 3457 and the string needs to get translated at run time. (This happens
3462 in the function (display-error) in cmdloop.el.) */ 3458 in the function (display-error) in cmdloop.el.) */
3463 Fput (*symbol, Qerror_message, build_string (messuhhj)); 3459 Fput (*symbol, Qerror_message, build_msg_string (messuhhj));
3464 } 3460 }
3465 3461
3466 void 3462 void
3467 deferror (Lisp_Object *symbol, const char *name, const char *messuhhj, 3463 deferror (Lisp_Object *symbol, const char *name, const char *messuhhj,
3468 Lisp_Object inherits_from) 3464 Lisp_Object inherits_from)