/* Take the word before point (or Vabbrev_start_location, if non-nil),
and look it up in OBARRAY, and return the symbol (or zero). This
used to be the default method of searching, with the obvious
limitation that the abbrevs may consist only of word characters.
It is an order of magnitude faster than the proper abbrev_match(),
but then again, vi is an order of magnitude faster than Emacs.
This speed difference should be unnoticeable, though. I have tested
the degenerated cases of thousands of abbrevs being defined, and
abbrev_match() was still fast enough for normal operation. */
static Lisp_Symbol *abbrev_oblookup(struct buffer *buf, Lisp_Object obarray)
{
Bufpos wordstart, wordend;
Bufbyte *word, *p;
Bytecount idx;
Lisp_Object lookup;
CHECK_VECTOR(obarray);
if (!NILP(Vabbrev_start_location)) {
wordstart = get_buffer_pos_char(buf, Vabbrev_start_location,
GB_COERCE_RANGE);
Vabbrev_start_location = Qnil;
#if 0
/* Previously, abbrev-prefix-mark crockishly inserted a dash to
indicate the abbrev start point. It now uses an extent with
a begin glyph so there's no dash to remove. */
if (wordstart != BUF_ZV(buf)
&& BUF_FETCH_CHAR(buf, wordstart) == '-') {
buffer_delete_range(buf, wordstart, wordstart + 1, 0);
}
#endif
wordend = BUF_PT(buf);
} else {
Bufpos point = BUF_PT(buf);
wordstart = scan_words(buf, point, -1);
if (!wordstart)
return 0;
wordend = scan_words(buf, wordstart, 1);
if (!wordend)
return 0;
if (wordend > BUF_ZV(buf))
wordend = BUF_ZV(buf);
if (wordend > point)
wordend = point;
/* Unlike the original function, we allow expansion only after
the abbrev, not preceded by a number of spaces. This is
because of consistency with abbrev_match. */
if (wordend < point)
return 0;
}
if (wordend <= wordstart)
return 0;
p = word = (Bufbyte *) alloca(MAX_EMCHAR_LEN * (wordend - wordstart));
for (idx = wordstart; idx < wordend; idx++) {
Emchar c = BUF_FETCH_CHAR(buf, idx);
if (UPPERCASEP(buf, c))
c = DOWNCASE(buf, c);
p += set_charptr_emchar(p, c);
}
lookup = oblookup(obarray, word, p - word);
if (SYMBOLP(lookup) && !NILP(symbol_value(XSYMBOL(lookup))))
return XSYMBOL(lookup);
else
return NULL;
}
static void
ase_metric_prnt(Lisp_Object obj, Lisp_Object pcf, int unused)
{
EMOD_ASE_DEBUG_METR("m:0x%08x@0x%08x (rc:%d)\n",
(unsigned int)(XASE_METRIC(obj)),
(unsigned int)obj, 1);
write_c_string("#<", pcf);
print_internal(XDYNACAT_TYPE(obj), pcf, unused);
{
if (NILP(XASE_METRIC_LDIST(obj))) {
write_hex_ptr(XASE_METRIC_DIST(obj),pcf);
} else {
Lisp_Object ldist = XASE_METRIC_LDIST(obj);
if (SYMBOLP(ldist)) {
Lisp_String *name =
symbol_name(XSYMBOL(ldist));
write_fmt_string(pcf, " #'%s", string_data(name));
} else if (SUBRP(ldist)) {
const char *name = subr_name(XSUBR(ldist));
write_fmt_string(pcf, " #'%s", name);
} else {
write_c_string(" #'(lambda ...)", pcf);
}
}
}
write_c_string(">", pcf);
return;
}
static void
weird_doc (Lisp_Object sym, const Ascbyte *weirdness, const Ascbyte *type,
int pos)
{
if (!strcmp (weirdness, "duplicate")) return;
message ("Note: Strange doc (%s) for %s %s @ %d",
GETTEXT (weirdness), GETTEXT (type),
XSTRING_DATA (XSYMBOL (sym)->name), pos);
}
static void
print_database (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
{
char buf[64];
Lisp_Database *db = XDATABASE (obj);
if (print_readably)
error ("printing unreadable object #<database 0x%x>", db->header.uid);
write_c_string ("#<database \"", printcharfun);
print_internal (db->fname, printcharfun, 0);
sprintf (buf, "\" (%s/%s/%s) 0x%x>",
(char *) string_data (XSYMBOL (db->funcs->get_type (db))->name),
(char *) string_data (XSYMBOL (db->funcs->get_subtype (db))->name),
(!DATABASE_LIVE_P (db) ? "closed" :
(db->access_ & O_WRONLY) ? "writeonly" :
(db->access_ & O_RDWR) ? "readwrite" : "readonly"),
db->header.uid);
write_c_string (buf, printcharfun);
}
/* For use by abbrev_match(): Match SYMBOL's name against buffer text
before point, case-insensitively. When found, return non-zero, so
that map_obarray terminates mapping. */
static int abbrev_match_mapper(Lisp_Object symbol, void *arg)
{
struct abbrev_match_mapper_closure *closure =
(struct abbrev_match_mapper_closure *)arg;
Charcount abbrev_length;
Lisp_Symbol *sym = XSYMBOL(symbol);
Lisp_String *abbrev;
/* symbol_value should be OK here, because abbrevs are not expected
to contain any SYMBOL_MAGIC stuff. */
if (UNBOUNDP(symbol_value(sym)) || NILP(symbol_value(sym))) {
/* The symbol value of nil means that abbrev got undefined. */
return 0;
}
abbrev = symbol_name(sym);
abbrev_length = string_char_length(abbrev);
if (abbrev_length > closure->maxlen) {
/* This abbrev is too large -- it wouldn't fit. */
return 0;
}
/* If `bar' is an abbrev, and a user presses `fubar<SPC>', we don't
normally want to expand it. OTOH, if the abbrev begins with
non-word syntax (e.g. `#if'), it is OK to abbreviate it anywhere. */
if (abbrev_length < closure->maxlen && abbrev_length > 0
&& (WORD_SYNTAX_P(closure->chartab, string_char(abbrev, 0)))
&& (WORD_SYNTAX_P(closure->chartab,
BUF_FETCH_CHAR(closure->buf,
closure->point - (abbrev_length +
1))))) {
return 0;
}
/* Match abbreviation string against buffer text. */
{
Bufbyte *ptr = string_data(abbrev);
Charcount idx;
for (idx = 0; idx < abbrev_length; idx++) {
if (DOWNCASE(closure->buf,
BUF_FETCH_CHAR(closure->buf,
closure->point -
abbrev_length + idx))
!= DOWNCASE(closure->buf, charptr_emchar(ptr))) {
break;
}
INC_CHARPTR(ptr);
}
if (idx == abbrev_length) {
/* This is the one. */
closure->found = sym;
return 1;
}
}
return 0;
}
static void
store_function_docstring (Lisp_Object obj, ptrdiff_t offset)
{
/* Don't use indirect_function here, or defaliases will apply their
docstrings to the base functions (Bug#2603). */
Lisp_Object fun = SYMBOLP (obj) ? XSYMBOL (obj)->function : obj;
/* The type determines where the docstring is stored. */
/* Lisp_Subrs have a slot for it. */
if (SUBRP (fun))
{
intptr_t negative_offset = - offset;
XSUBR (fun)->doc = (char *) negative_offset;
}
/* If it's a lisp form, stick it in the form. */
else if (CONSP (fun))
{
Lisp_Object tem;
tem = XCAR (fun);
if (EQ (tem, Qlambda) || EQ (tem, Qautoload)
|| (EQ (tem, Qclosure) && (fun = XCDR (fun), 1)))
{
tem = Fcdr (Fcdr (fun));
if (CONSP (tem) && INTEGERP (XCAR (tem)))
/* FIXME: This modifies typically pure hash-cons'd data, so its
correctness is quite delicate. */
XSETCAR (tem, make_number (offset));
}
else if (EQ (tem, Qmacro))
store_function_docstring (XCDR (fun), offset);
}
/* Bytecode objects sometimes have slots for it. */
else if (COMPILEDP (fun))
{
/* This bytecode object must have a slot for the
docstring, since we've found a docstring for it. */
if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_DOC_STRING)
ASET (fun, COMPILED_DOC_STRING, make_number (offset));
else
{
AUTO_STRING (format, "No docstring slot for %s");
CALLN (Fmessage, format,
(SYMBOLP (obj)
? SYMBOL_NAME (obj)
: build_string ("<anonymous>")));
}
}
}
static void
store_function_docstring (Lisp_Object obj, EMACS_INT offset)
/* Use EMACS_INT because we get offset from pointer subtraction. */
{
/* Don't use indirect_function here, or defaliases will apply their
docstrings to the base functions (Bug#2603). */
Lisp_Object fun = SYMBOLP (obj) ? XSYMBOL (obj)->function : obj;
/* The type determines where the docstring is stored. */
/* Lisp_Subrs have a slot for it. */
if (SUBRP (fun))
{
intptr_t negative_offset = - offset;
XSUBR (fun)->doc = (char *) negative_offset;
}
/* If it's a lisp form, stick it in the form. */
else if (CONSP (fun))
{
Lisp_Object tem;
tem = XCAR (fun);
if (EQ (tem, Qlambda) || EQ (tem, Qautoload)
|| (EQ (tem, Qclosure) && (fun = XCDR (fun), 1)))
{
tem = Fcdr (Fcdr (fun));
if (CONSP (tem) && INTEGERP (XCAR (tem)))
XSETCAR (tem, make_number (offset));
}
else if (EQ (tem, Qmacro))
store_function_docstring (XCDR (fun), offset);
}
/* Bytecode objects sometimes have slots for it. */
else if (COMPILEDP (fun))
{
/* This bytecode object must have a slot for the
docstring, since we've found a docstring for it. */
if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_DOC_STRING)
ASET (fun, COMPILED_DOC_STRING, make_number (offset));
}
}
static void print_object(l_object obj)
{
extern char iobuf[];
if (NILP(obj)) {
writestr("nil");
} else if (INTEGERP(obj)) {
snprintf(iobuf, IOBUF_SIZE, "%d", (int) XINT(obj));
writestr(iobuf);
} else if (SYMBOLP(obj)) {
writestr(XSYMBOL(obj)->name);
} else if (CONSP(obj)) {
writestr("(");
print_list(obj);
writestr(")");
} else {
abort();
}
}
