Mercurial > hg > xemacs-beta
annotate src/abbrev.c @ 5518:3cc7470ea71c
gnuclient: if TMPDIR was set and connect failed, try again with /tmp
2011-06-03 Aidan Kehoe <kehoea@parhasard.net>
* gnuslib.c (connect_to_unix_server):
Retry with /tmp as a directory in which to search for Unix sockets
if an attempt to connect with some other directory failed (which
may be because gnuclient and gnuserv don't share an environment
value for TMPDIR, or because gnuserv was compiled with USE_TMPDIR
turned off).
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Fri, 03 Jun 2011 18:40:57 +0100 |
| parents | 0af042a0c116 |
| children | 56144c8593a8 |
| rev | line source |
|---|---|
| 428 | 1 /* Primitives for word-abbrev mode. |
| 2 Copyright (C) 1985, 1986, 1992, 1993 Free Software Foundation, Inc. | |
| 793 | 3 Copyright (C) 2002 Ben Wing. |
| 428 | 4 |
| 5 This file is part of XEmacs. | |
| 6 | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5182
diff
changeset
|
7 XEmacs is free software: you can redistribute it and/or modify it |
| 428 | 8 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:
5182
diff
changeset
|
9 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:
5182
diff
changeset
|
10 option) any later version. |
| 428 | 11 |
| 12 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
| 13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
| 14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
| 15 for more details. | |
| 16 | |
| 17 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:
5182
diff
changeset
|
18 along with XEmacs. If not, see <http://www.gnu.org/licenses/>. */ |
| 428 | 19 |
| 20 /* Synched up with: FSF 19.30. Note that there are many more functions in | |
| 21 FSF's abbrev.c. These have been moved into Lisp in XEmacs. */ | |
| 22 | |
| 23 /* Authorship: | |
| 24 | |
| 25 FSF: Original version; a long time ago. | |
| 26 JWZ or Mly: Mostly moved into Lisp; maybe 1992. | |
| 27 Ben Wing: Some changes for Mule for 19.12. | |
| 28 Hrvoje Niksic: Largely rewritten in June 1997. | |
| 29 */ | |
| 30 | |
| 31 /* This file has been Mule-ized. */ | |
| 32 | |
| 33 #include <config.h> | |
| 34 #include "lisp.h" | |
| 35 | |
| 36 #include "buffer.h" | |
| 37 #include "commands.h" | |
| 38 #include "insdel.h" | |
| 39 #include "syntax.h" | |
| 40 #include "window.h" | |
| 41 | |
| 42 /* An abbrev table is an obarray. | |
| 43 Each defined abbrev is represented by a symbol in that obarray | |
| 44 whose print name is the abbreviation. | |
| 45 The symbol's value is a string which is the expansion. | |
| 46 If its function definition is non-nil, it is called | |
| 47 after the expansion is done. | |
| 48 The plist slot of the abbrev symbol is its usage count. */ | |
| 49 | |
| 50 /* The table of global abbrevs. These are in effect | |
| 51 in any buffer in which abbrev mode is turned on. */ | |
| 52 Lisp_Object Vglobal_abbrev_table; | |
| 53 | |
| 54 int abbrev_all_caps; | |
| 55 | |
| 56 /* Non-nil => use this location as the start of abbrev to expand | |
| 57 (rather than taking the word before point as the abbrev) */ | |
| 58 Lisp_Object Vabbrev_start_location; | |
| 59 | |
| 60 /* Buffer that Vabbrev_start_location applies to */ | |
| 61 Lisp_Object Vabbrev_start_location_buffer; | |
| 62 | |
| 63 /* The symbol representing the abbrev most recently expanded */ | |
| 64 Lisp_Object Vlast_abbrev; | |
| 65 | |
| 66 /* A string for the actual text of the abbrev most recently expanded. | |
| 67 This has more info than Vlast_abbrev since case is significant. */ | |
| 68 Lisp_Object Vlast_abbrev_text; | |
| 69 | |
| 70 /* Character address of start of last abbrev expanded */ | |
| 458 | 71 Fixnum last_abbrev_location; |
| 428 | 72 |
| 73 /* Hook to run before expanding any abbrev. */ | |
| 74 Lisp_Object Vpre_abbrev_expand_hook, Qpre_abbrev_expand_hook; | |
| 75 | |
|
5320
31be2a3d121d
Move Qcount, Q_default, Q_test to general-slots.h; add SYMBOL_KEYWORD_GENERAL()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5307
diff
changeset
|
76 Lisp_Object Qsystem_type; |
| 428 | 77 |
| 826 | 78 struct abbrev_match_mapper_closure |
| 79 { | |
| 428 | 80 struct buffer *buf; |
| 826 | 81 Lisp_Object chartab; |
| 814 | 82 Charbpos point; |
| 83 Charcount maxlen; | |
| 440 | 84 Lisp_Symbol *found; |
| 428 | 85 }; |
| 86 | |
| 87 /* For use by abbrev_match(): Match SYMBOL's name against buffer text | |
| 88 before point, case-insensitively. When found, return non-zero, so | |
| 89 that map_obarray terminates mapping. */ | |
| 90 static int | |
| 91 abbrev_match_mapper (Lisp_Object symbol, void *arg) | |
| 92 { | |
| 93 struct abbrev_match_mapper_closure *closure = | |
| 94 (struct abbrev_match_mapper_closure *)arg; | |
| 95 Charcount abbrev_length; | |
| 440 | 96 Lisp_Symbol *sym = XSYMBOL (symbol); |
| 793 | 97 Lisp_Object abbrev; |
| 428 | 98 |
| 99 /* symbol_value should be OK here, because abbrevs are not expected | |
| 100 to contain any SYMBOL_MAGIC stuff. */ | |
| 101 if (UNBOUNDP (symbol_value (sym)) || NILP (symbol_value (sym))) | |
| 102 { | |
| 103 /* The symbol value of nil means that abbrev got undefined. */ | |
| 104 return 0; | |
| 105 } | |
| 106 abbrev = symbol_name (sym); | |
| 826 | 107 abbrev_length = string_char_length (abbrev); |
| 428 | 108 if (abbrev_length > closure->maxlen) |
| 109 { | |
| 110 /* This abbrev is too large -- it wouldn't fit. */ | |
| 111 return 0; | |
| 112 } | |
| 113 /* If `bar' is an abbrev, and a user presses `fubar<SPC>', we don't | |
| 114 normally want to expand it. OTOH, if the abbrev begins with | |
| 115 non-word syntax (e.g. `#if'), it is OK to abbreviate it anywhere. */ | |
| 116 if (abbrev_length < closure->maxlen && abbrev_length > 0 | |
| 867 | 117 && (WORD_SYNTAX_P (closure->chartab, string_ichar (abbrev, 0))) |
| 428 | 118 && (WORD_SYNTAX_P (closure->chartab, |
| 119 BUF_FETCH_CHAR (closure->buf, | |
| 793 | 120 closure->point - |
| 121 (abbrev_length + 1))))) | |
| 428 | 122 { |
| 123 return 0; | |
| 124 } | |
| 125 /* Match abbreviation string against buffer text. */ | |
| 126 { | |
| 867 | 127 Ibyte *ptr = XSTRING_DATA (abbrev); |
| 428 | 128 Charcount idx; |
| 129 | |
| 130 for (idx = 0; idx < abbrev_length; idx++) | |
| 131 { | |
|
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
3965
diff
changeset
|
132 if (CANONCASE (closure->buf, |
| 428 | 133 BUF_FETCH_CHAR (closure->buf, |
| 134 closure->point - abbrev_length + idx)) | |
|
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
3965
diff
changeset
|
135 != CANONCASE (closure->buf, itext_ichar (ptr))) |
| 428 | 136 { |
| 137 break; | |
| 138 } | |
| 867 | 139 INC_IBYTEPTR (ptr); |
| 428 | 140 } |
| 141 if (idx == abbrev_length) | |
| 142 { | |
| 143 /* This is the one. */ | |
| 144 closure->found = sym; | |
| 145 return 1; | |
| 146 } | |
| 147 } | |
| 148 return 0; | |
| 149 } | |
| 150 | |
| 151 /* Match the buffer text against names of symbols in obarray. Returns | |
| 152 the matching symbol, or 0 if not found. */ | |
| 440 | 153 static Lisp_Symbol * |
| 428 | 154 abbrev_match (struct buffer *buf, Lisp_Object obarray) |
| 155 { | |
| 156 struct abbrev_match_mapper_closure closure; | |
| 157 | |
| 158 /* Precalculate some stuff, so mapper function needn't to it in each | |
| 159 iteration. */ | |
| 160 closure.buf = buf; | |
| 161 closure.point = BUF_PT (buf); | |
| 162 closure.maxlen = closure.point - BUF_BEGV (buf); | |
| 826 | 163 closure.chartab = buf->mirror_syntax_table; |
| 428 | 164 closure.found = 0; |
| 165 | |
| 166 map_obarray (obarray, abbrev_match_mapper, &closure); | |
| 167 | |
| 168 return closure.found; | |
| 169 } | |
| 170 | |
| 171 /* Take the word before point (or Vabbrev_start_location, if non-nil), | |
| 172 and look it up in OBARRAY, and return the symbol (or zero). This | |
| 173 used to be the default method of searching, with the obvious | |
| 174 limitation that the abbrevs may consist only of word characters. | |
| 175 It is an order of magnitude faster than the proper abbrev_match(), | |
| 176 but then again, vi is an order of magnitude faster than Emacs. | |
| 177 | |
| 178 This speed difference should be unnoticeable, though. I have tested | |
| 179 the degenerated cases of thousands of abbrevs being defined, and | |
| 180 abbrev_match() was still fast enough for normal operation. */ | |
| 440 | 181 static Lisp_Symbol * |
| 428 | 182 abbrev_oblookup (struct buffer *buf, Lisp_Object obarray) |
| 183 { | |
| 665 | 184 Charbpos wordstart, wordend; |
| 867 | 185 Ibyte *word, *p; |
| 814 | 186 Charbpos idx; |
| 428 | 187 Lisp_Object lookup; |
| 188 | |
| 189 CHECK_VECTOR (obarray); | |
| 190 | |
| 191 if (!NILP (Vabbrev_start_location)) | |
| 192 { | |
| 193 wordstart = get_buffer_pos_char (buf, Vabbrev_start_location, | |
| 194 GB_COERCE_RANGE); | |
| 195 Vabbrev_start_location = Qnil; | |
| 196 #if 0 | |
| 197 /* Previously, abbrev-prefix-mark crockishly inserted a dash to | |
| 198 indicate the abbrev start point. It now uses an extent with | |
| 199 a begin glyph so there's no dash to remove. */ | |
| 200 if (wordstart != BUF_ZV (buf) | |
| 201 && BUF_FETCH_CHAR (buf, wordstart) == '-') | |
| 202 { | |
| 203 buffer_delete_range (buf, wordstart, wordstart + 1, 0); | |
| 204 } | |
| 205 #endif | |
| 206 wordend = BUF_PT (buf); | |
| 207 } | |
| 208 else | |
| 209 { | |
| 665 | 210 Charbpos point = BUF_PT (buf); |
| 428 | 211 |
| 212 wordstart = scan_words (buf, point, -1); | |
| 213 if (!wordstart) | |
| 214 return 0; | |
| 215 | |
| 216 wordend = scan_words (buf, wordstart, 1); | |
| 217 if (!wordend) | |
| 218 return 0; | |
| 219 if (wordend > BUF_ZV (buf)) | |
| 220 wordend = BUF_ZV (buf); | |
| 221 if (wordend > point) | |
| 222 wordend = point; | |
| 223 /* Unlike the original function, we allow expansion only after | |
| 224 the abbrev, not preceded by a number of spaces. This is | |
| 225 because of consistency with abbrev_match. */ | |
| 226 if (wordend < point) | |
| 227 return 0; | |
| 228 } | |
| 229 | |
| 230 if (wordend <= wordstart) | |
| 231 return 0; | |
| 232 | |
| 2367 | 233 p = word = alloca_ibytes (MAX_ICHAR_LEN * (wordend - wordstart)); |
| 428 | 234 for (idx = wordstart; idx < wordend; idx++) |
| 235 { | |
| 867 | 236 Ichar c = BUF_FETCH_CHAR (buf, idx); |
| 428 | 237 if (UPPERCASEP (buf, c)) |
| 238 c = DOWNCASE (buf, c); | |
| 867 | 239 p += set_itext_ichar (p, c); |
| 428 | 240 } |
| 241 lookup = oblookup (obarray, word, p - word); | |
| 242 if (SYMBOLP (lookup) && !NILP (symbol_value (XSYMBOL (lookup)))) | |
| 243 return XSYMBOL (lookup); | |
| 244 else | |
| 245 return NULL; | |
| 246 } | |
| 247 | |
| 248 /* Return non-zero if OBARRAY contains an interned symbol ` '. */ | |
| 249 static int | |
| 250 obarray_has_blank_p (Lisp_Object obarray) | |
| 251 { | |
| 867 | 252 return !ZEROP (oblookup (obarray, (Ibyte *)" ", 1)); |
| 428 | 253 } |
| 254 | |
| 255 /* Analyze case in the buffer substring, and report it. */ | |
| 256 static void | |
| 665 | 257 abbrev_count_case (struct buffer *buf, Charbpos pos, Charcount length, |
| 428 | 258 int *lccount, int *uccount) |
| 259 { | |
| 260 *lccount = *uccount = 0; | |
| 261 while (length--) | |
| 262 { | |
| 867 | 263 Ichar c = BUF_FETCH_CHAR (buf, pos); |
| 428 | 264 if (UPPERCASEP (buf, c)) |
| 265 ++*uccount; | |
| 266 else if (LOWERCASEP (buf, c)) | |
| 267 ++*lccount; | |
| 268 ++pos; | |
| 269 } | |
| 270 } | |
| 271 | |
| 272 DEFUN ("expand-abbrev", Fexpand_abbrev, 0, 0, "", /* | |
| 273 Expand the abbrev before point, if any. | |
| 274 Effective when explicitly called even when `abbrev-mode' is nil. | |
| 275 Returns the abbrev symbol, if expansion took place. | |
| 276 If no abbrev matched, but `pre-abbrev-expand-hook' changed the buffer, | |
| 277 returns t. | |
| 278 */ | |
| 279 ()) | |
| 280 { | |
| 281 /* This function can GC */ | |
| 282 struct buffer *buf = current_buffer; | |
| 283 int oldmodiff = BUF_MODIFF (buf); | |
| 284 Lisp_Object pre_modiff_p; | |
| 665 | 285 Charbpos point; /* position of point */ |
| 286 Charbpos abbrev_start; /* position of abbreviation beginning */ | |
| 428 | 287 |
| 440 | 288 Lisp_Symbol *(*fun) (struct buffer *, Lisp_Object); |
| 428 | 289 |
| 440 | 290 Lisp_Symbol *abbrev_symbol; |
| 428 | 291 Lisp_Object expansion, count, hook; |
| 292 Charcount abbrev_length; | |
| 293 int lccount, uccount; | |
| 294 | |
| 295 run_hook (Qpre_abbrev_expand_hook); | |
| 296 /* If the hook changes the buffer, treat that as having "done an | |
| 297 expansion". */ | |
| 298 pre_modiff_p = (BUF_MODIFF (buf) != oldmodiff ? Qt : Qnil); | |
| 299 | |
| 300 abbrev_symbol = NULL; | |
| 301 if (!BUFFERP (Vabbrev_start_location_buffer) || | |
| 302 XBUFFER (Vabbrev_start_location_buffer) != buf) | |
| 303 Vabbrev_start_location = Qnil; | |
| 304 /* We use the more general abbrev_match() if the obarray blank flag | |
| 305 is not set, and Vabbrev_start_location is nil. Otherwise, use | |
| 306 abbrev_oblookup(). */ | |
| 307 #define MATCHFUN(tbl) ((obarray_has_blank_p (tbl) \ | |
| 308 && NILP (Vabbrev_start_location)) \ | |
| 309 ? abbrev_match : abbrev_oblookup) | |
| 310 if (!NILP (buf->abbrev_table)) | |
| 311 { | |
| 312 fun = MATCHFUN (buf->abbrev_table); | |
| 313 abbrev_symbol = fun (buf, buf->abbrev_table); | |
| 314 } | |
| 315 if (!abbrev_symbol && !NILP (Vglobal_abbrev_table)) | |
| 316 { | |
| 317 fun = MATCHFUN (Vglobal_abbrev_table); | |
| 318 abbrev_symbol = fun (buf, Vglobal_abbrev_table); | |
| 319 } | |
| 320 if (!abbrev_symbol) | |
| 321 return pre_modiff_p; | |
| 322 | |
| 323 /* NOTE: we hope that `pre-abbrev-expand-hook' didn't do something | |
| 324 nasty, such as changed the buffer. Here we protect against the | |
| 325 buffer getting killed. */ | |
| 326 if (! BUFFER_LIVE_P (buf)) | |
| 327 return Qnil; | |
| 328 point = BUF_PT (buf); | |
| 329 | |
| 330 /* OK, we're out of the must-be-fast part. An abbreviation matched. | |
| 331 Now find the parameters, insert the expansion, and make it all | |
| 332 look pretty. */ | |
| 826 | 333 abbrev_length = string_char_length (symbol_name (abbrev_symbol)); |
| 428 | 334 abbrev_start = point - abbrev_length; |
| 335 | |
| 336 expansion = symbol_value (abbrev_symbol); | |
| 337 CHECK_STRING (expansion); | |
| 338 | |
| 339 count = symbol_plist (abbrev_symbol); /* Gag */ | |
| 340 if (NILP (count)) | |
| 341 count = Qzero; | |
| 342 else | |
| 343 CHECK_NATNUM (count); | |
|
5307
c096d8051f89
Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5182
diff
changeset
|
344 symbol_plist (abbrev_symbol) = Fadd1 (count); |
| 428 | 345 |
| 346 /* Count the case in the original text. */ | |
| 347 abbrev_count_case (buf, abbrev_start, abbrev_length, &lccount, &uccount); | |
| 348 | |
| 349 /* Remember the last abbrev text, location, etc. */ | |
| 793 | 350 Vlast_abbrev = wrap_symbol (abbrev_symbol); |
| 428 | 351 Vlast_abbrev_text = |
| 352 make_string_from_buffer (buf, abbrev_start, abbrev_length); | |
| 353 last_abbrev_location = abbrev_start; | |
| 354 | |
| 355 /* Add an undo boundary, in case we are doing this for a | |
| 356 self-inserting command which has avoided making one so far. */ | |
| 357 if (INTERACTIVE) | |
| 358 Fundo_boundary (); | |
| 359 | |
| 360 /* Remove the abbrev */ | |
| 361 buffer_delete_range (buf, abbrev_start, point, 0); | |
| 362 /* And insert the expansion. */ | |
| 363 buffer_insert_lisp_string (buf, expansion); | |
| 364 point = BUF_PT (buf); | |
| 365 | |
| 366 /* Now fiddle with the case. */ | |
| 367 if (uccount && !lccount) | |
| 368 { | |
| 369 /* Abbrev was all caps */ | |
| 370 if (!abbrev_all_caps | |
| 371 && scan_words (buf, point, -1) > scan_words (buf, abbrev_start, 1)) | |
| 372 { | |
| 373 Fupcase_initials_region (make_int (abbrev_start), make_int (point), | |
| 771 | 374 wrap_buffer (buf)); |
| 428 | 375 } |
| 376 else | |
| 377 { | |
| 378 /* If expansion is one word, or if user says so, upcase it all. */ | |
| 379 Fupcase_region (make_int (abbrev_start), make_int (point), | |
| 771 | 380 wrap_buffer (buf)); |
| 428 | 381 } |
| 382 } | |
| 383 else if (uccount) | |
| 384 { | |
| 385 /* Abbrev included some caps. Cap first initial of expansion */ | |
| 665 | 386 Charbpos pos = abbrev_start; |
| 428 | 387 /* Find the initial. */ |
| 388 while (pos < point | |
| 826 | 389 && !WORD_SYNTAX_P (buf->mirror_syntax_table, |
| 428 | 390 BUF_FETCH_CHAR (buf, pos))) |
| 391 pos++; | |
| 392 /* Change just that. */ | |
| 393 Fupcase_initials_region (make_int (pos), make_int (pos + 1), | |
| 771 | 394 wrap_buffer (buf)); |
| 428 | 395 } |
| 396 | |
| 397 hook = symbol_function (abbrev_symbol); | |
| 398 if (!NILP (hook) && !UNBOUNDP (hook)) | |
| 399 call0 (hook); | |
| 400 | |
| 401 return Vlast_abbrev; | |
| 402 } | |
| 403 | |
| 3965 | 404 static void |
| 405 write_abbrev (Lisp_Object sym, Lisp_Object stream) | |
| 406 { | |
| 407 Lisp_Object name, count, system_flag; | |
| 408 /* This function can GC */ | |
| 409 struct buffer *buf = current_buffer; | |
| 410 | |
| 411 if (INTP (XSYMBOL (sym)->plist)) | |
| 412 { | |
| 413 count = XSYMBOL (sym)->plist; | |
| 414 system_flag = Qnil; | |
| 415 } | |
| 416 else | |
| 417 { | |
| 418 count = Fget (sym, Qcount, Qunbound); | |
| 419 system_flag = Fget (sym, Qsystem_type, Qunbound); | |
| 420 } | |
| 421 | |
| 422 if (NILP (XSYMBOL_VALUE (sym)) || ! NILP (system_flag)) | |
| 423 return; | |
| 424 | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
3965
diff
changeset
|
425 buffer_insert_ascstring (buf, " ("); |
| 3965 | 426 name = Fsymbol_name (sym); |
| 427 Fprin1 (name, stream); | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
3965
diff
changeset
|
428 buffer_insert_ascstring (buf, " "); |
| 3965 | 429 Fprin1 (XSYMBOL_VALUE (sym), stream); |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
3965
diff
changeset
|
430 buffer_insert_ascstring (buf, " "); |
| 3965 | 431 Fprin1 (XSYMBOL (sym)->function, stream); |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
3965
diff
changeset
|
432 buffer_insert_ascstring (buf, " "); |
| 3965 | 433 Fprin1 (count, stream); |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
3965
diff
changeset
|
434 buffer_insert_ascstring (buf, ")\n"); |
| 3965 | 435 } |
| 436 | |
| 437 static void | |
| 438 describe_abbrev (Lisp_Object sym, Lisp_Object stream) | |
| 439 { | |
| 440 Lisp_Object one, count, system_flag; | |
| 441 /* This function can GC */ | |
| 442 struct buffer *buf = current_buffer; | |
| 443 | |
| 444 if (INTP (XSYMBOL (sym)->plist)) | |
| 445 { | |
| 446 count = XSYMBOL (sym)->plist; | |
| 447 system_flag = Qnil; | |
| 448 } | |
| 449 else | |
| 450 { | |
| 451 count = Fget (sym, Qcount, Qunbound); | |
| 452 system_flag = Fget (sym, Qsystem_type, Qunbound); | |
| 453 } | |
| 454 | |
| 455 if (NILP (XSYMBOL_VALUE (sym))) | |
| 456 return; | |
| 457 | |
| 458 one = make_int (1); | |
| 459 Fprin1 (Fsymbol_name (sym), stream); | |
| 460 | |
| 461 if (!NILP (system_flag)) | |
| 462 { | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
3965
diff
changeset
|
463 buffer_insert_ascstring (buf, " (sys)"); |
| 3965 | 464 Findent_to (make_int (20), one, Qnil); |
| 465 } | |
| 466 else | |
| 467 Findent_to (make_int (15), one, Qnil); | |
| 468 | |
| 469 Fprin1 (count, stream); | |
| 470 Findent_to (make_int (20), one, Qnil); | |
| 471 Fprin1 (XSYMBOL_VALUE (sym), stream); | |
| 472 if (!NILP (XSYMBOL (sym)->function)) | |
| 473 { | |
| 474 Findent_to (make_int (45), one, Qnil); | |
| 475 Fprin1 (XSYMBOL (sym)->function, stream); | |
| 476 } | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
3965
diff
changeset
|
477 buffer_insert_ascstring (buf, "\n"); |
| 3965 | 478 } |
| 479 | |
| 480 static int | |
| 481 record_symbol (Lisp_Object sym, void *arg) | |
| 482 { | |
| 483 Lisp_Object closure = * (Lisp_Object *) arg; | |
| 484 XSETCDR (closure, Fcons (sym, XCDR (closure))); | |
| 485 return 0; /* Never stop */ | |
| 486 } | |
| 487 | |
| 488 DEFUN ("insert-abbrev-table-description", Finsert_abbrev_table_description, | |
| 489 1, 2, 0, /* | |
| 490 Insert before point a full description of abbrev table named NAME. | |
| 491 NAME is a symbol whose value is an abbrev table. | |
| 492 If optional 2nd arg READABLE is non-nil, a human-readable description | |
| 493 is inserted. Otherwise the description is an expression, | |
| 494 a call to `define-abbrev-table', which would | |
| 495 define the abbrev table NAME exactly as it is currently defined. | |
| 496 | |
| 497 Abbrevs marked as "system abbrevs" are normally omitted. However, if | |
| 498 READABLE is non-nil, they are listed. */ | |
| 499 (name, readable)) | |
| 500 { | |
| 501 Lisp_Object table; | |
| 502 Lisp_Object symbols; | |
| 503 Lisp_Object stream; | |
| 504 /* This function can GC */ | |
| 505 struct buffer *buf = current_buffer; | |
| 506 | |
| 507 CHECK_SYMBOL (name); | |
| 508 table = Fsymbol_value (name); | |
| 509 CHECK_VECTOR (table); | |
| 510 | |
| 511 /* FIXME: what's the XEmacs equivalent? APA */ | |
| 512 /* XSETBUFFER (stream, current_buffer); */ | |
| 513 /* Does not seem to work: */ | |
| 514 /* Fset_buffer (stream); */ | |
| 515 stream = wrap_buffer (current_buffer); | |
| 516 | |
| 517 symbols = Fcons (Qnil, Qnil); | |
| 518 /* Lisp_Object closure = Fcons (Qnil, Qnil); */ | |
| 519 /* struct gcpro gcpro1; */ | |
| 520 /* GCPRO1 (closure); */ | |
| 521 /* map_obarray (table, record_symbol, symbols); */ | |
| 522 map_obarray (table, record_symbol, &symbols); | |
| 523 /* map_obarray (table, record_symbol, &closure); */ | |
| 524 symbols = XCDR (symbols); | |
|
5350
94bbd4792049
Have #'sort*, #'merge use the same test approach as functions from cl-seq.el
Aidan Kehoe <kehoea@parhasard.net>
parents:
5320
diff
changeset
|
525 symbols = list_sort (symbols, check_string_lessp_nokey, Qnil, Qnil); |
| 3965 | 526 |
| 527 if (!NILP (readable)) | |
| 528 { | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
3965
diff
changeset
|
529 buffer_insert_ascstring (buf, "("); |
| 3965 | 530 Fprin1 (name, stream); |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
3965
diff
changeset
|
531 buffer_insert_ascstring (buf, ")\n\n"); |
| 3965 | 532 while (! NILP (symbols)) |
| 533 { | |
| 534 describe_abbrev (XCAR (symbols), stream); | |
| 535 symbols = XCDR (symbols); | |
| 536 } | |
| 537 | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
3965
diff
changeset
|
538 buffer_insert_ascstring (buf, "\n\n"); |
| 3965 | 539 } |
| 540 else | |
| 541 { | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
3965
diff
changeset
|
542 buffer_insert_ascstring (buf, "(define-abbrev-table '"); |
| 3965 | 543 Fprin1 (name, stream); |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
3965
diff
changeset
|
544 buffer_insert_ascstring (buf, " '(\n"); |
| 3965 | 545 while (! NILP (symbols)) |
| 546 { | |
| 547 write_abbrev (XCAR (symbols), stream); | |
| 548 symbols = XCDR (symbols); | |
| 549 } | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
3965
diff
changeset
|
550 buffer_insert_ascstring (buf, " ))\n\n"); |
| 3965 | 551 } |
| 552 | |
| 553 return Qnil; | |
| 554 } | |
| 428 | 555 |
| 556 void | |
| 557 syms_of_abbrev (void) | |
| 558 { | |
| 3965 | 559 DEFSYMBOL(Qsystem_type); |
| 560 Qsystem_type = intern ("system-type"); | |
| 563 | 561 DEFSYMBOL (Qpre_abbrev_expand_hook); |
| 428 | 562 DEFSUBR (Fexpand_abbrev); |
| 3965 | 563 DEFSUBR (Finsert_abbrev_table_description); |
| 428 | 564 } |
| 565 | |
| 566 void | |
| 567 vars_of_abbrev (void) | |
| 568 { | |
| 569 DEFVAR_LISP ("global-abbrev-table", &Vglobal_abbrev_table /* | |
| 570 The abbrev table whose abbrevs affect all buffers. | |
| 571 Each buffer may also have a local abbrev table. | |
| 572 If it does, the local table overrides the global one | |
| 573 for any particular abbrev defined in both. | |
| 574 */ ); | |
| 575 Vglobal_abbrev_table = Qnil; /* setup by Lisp code */ | |
| 576 | |
| 577 DEFVAR_LISP ("last-abbrev", &Vlast_abbrev /* | |
| 578 The abbrev-symbol of the last abbrev expanded. | |
| 579 See the function `abbrev-symbol'. | |
| 580 */ ); | |
| 581 | |
| 582 DEFVAR_LISP ("last-abbrev-text", &Vlast_abbrev_text /* | |
| 583 The exact text of the last abbrev expanded. | |
| 584 nil if the abbrev has already been unexpanded. | |
| 585 */ ); | |
| 586 | |
| 587 DEFVAR_INT ("last-abbrev-location", &last_abbrev_location /* | |
| 588 The location of the start of the last abbrev expanded. | |
| 589 */ ); | |
| 590 | |
| 591 Vlast_abbrev = Qnil; | |
| 592 Vlast_abbrev_text = Qnil; | |
| 593 last_abbrev_location = 0; | |
| 594 | |
| 595 DEFVAR_LISP ("abbrev-start-location", &Vabbrev_start_location /* | |
| 596 Buffer position for `expand-abbrev' to use as the start of the abbrev. | |
| 597 nil means use the word before point as the abbrev. | |
| 598 Calling `expand-abbrev' sets this to nil. | |
| 599 */ ); | |
| 600 Vabbrev_start_location = Qnil; | |
| 601 | |
| 602 DEFVAR_LISP ("abbrev-start-location-buffer", &Vabbrev_start_location_buffer /* | |
| 603 Buffer that `abbrev-start-location' has been set for. | |
| 604 Trying to expand an abbrev in any other buffer clears `abbrev-start-location'. | |
| 605 */ ); | |
| 606 Vabbrev_start_location_buffer = Qnil; | |
| 607 | |
| 608 DEFVAR_BOOL ("abbrev-all-caps", &abbrev_all_caps /* | |
| 609 *Non-nil means expand multi-word abbrevs all caps if abbrev was so. | |
| 610 */ ); | |
| 611 abbrev_all_caps = 0; | |
| 612 | |
| 613 DEFVAR_LISP ("pre-abbrev-expand-hook", &Vpre_abbrev_expand_hook /* | |
| 614 Function or functions to be called before abbrev expansion is done. | |
| 615 This is the first thing that `expand-abbrev' does, and so this may change | |
| 616 the current abbrev table before abbrev lookup happens. | |
| 617 */ ); | |
| 618 Vpre_abbrev_expand_hook = Qnil; | |
| 619 } |