Mercurial > hg > xemacs-beta
annotate src/abbrev.c @ 5353:38e24b8be4ea
Improve the lexical scoping in #'block, #'return-from.
lisp/ChangeLog addition:
2011-02-07 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el:
* bytecomp.el (byte-compile-initial-macro-environment):
Shadow `block', `return-from' here, we implement them differently
when byte-compiling.
* bytecomp.el (byte-compile-active-blocks): New.
* bytecomp.el (byte-compile-block-1): New.
* bytecomp.el (byte-compile-return-from-1): New.
* bytecomp.el (return-from-1): New.
* bytecomp.el (block-1): New.
These are two aliases that exist to have their own associated
byte-compile functions, which functions implement `block' and
`return-from'.
* cl-extra.el (cl-macroexpand-all):
Fix a bug here when macros in the environment have been compiled.
* cl-macs.el (block):
* cl-macs.el (return):
* cl-macs.el (return-from):
Be more careful about lexical scope in these macros.
* cl.el:
* cl.el ('cl-block-wrapper): Removed.
* cl.el ('cl-block-throw): Removed.
These aren't needed in code generated by this XEmacs. They
shouldn't be needed in code generated by XEmacs 21.4, but if it
turns out the packages do need them, we can put them back.
2011-01-30 Mike Sperber <mike@xemacs.org>
* font-lock.el (font-lock-fontify-pending-extents): Don't fail if
`font-lock-mode' is unset, which can happen in the middle of
`revert-buffer'.
2011-01-23 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (delete):
* cl-macs.el (delq):
* cl-macs.el (remove):
* cl-macs.el (remq):
Don't use the compiler macro if these functions were given the
wrong number of arguments, as happens in lisp-tests.el.
* cl-seq.el (remove, remq): Removed.
I added these to subr.el, and forgot to remove them from here.
2011-01-22 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el (byte-compile-setq, byte-compile-set):
Remove kludge allowing keywords' values to be set, all the code
that does that is gone.
* cl-compat.el (elt-satisfies-test-p):
* faces.el (set-face-parent):
* faces.el (face-doc-string):
* gtk-font-menu.el:
* gtk-font-menu.el (gtk-reset-device-font-menus):
* msw-font-menu.el:
* msw-font-menu.el (mswindows-reset-device-font-menus):
* package-get.el (package-get-installedp):
* select.el (select-convert-from-image-data):
* sound.el:
* sound.el (load-sound-file):
* x-font-menu.el (x-reset-device-font-menus-core):
Don't quote keywords, they're self-quoting, and the
win from backward-compatibility is sufficiently small now that the
style problem overrides it.
2011-01-22 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (block, return-from): Require that NAME be a symbol
in these macros, as always documented in the #'block docstring and
as required by Common Lisp.
* descr-text.el (unidata-initialize-unihan-database):
Correct the use of non-symbols in #'block and #'return-from in
this function.
2011-01-15 Aidan Kehoe <kehoea@parhasard.net>
* cl-extra.el (concatenate): Accept more complicated TYPEs in this
function, handing the sequences over to #'coerce if we don't
understand them here.
* cl-macs.el (inline): Don't proclaim #'concatenate as inline, its
compiler macro is more useful than doing that.
2011-01-11 Aidan Kehoe <kehoea@parhasard.net>
* subr.el (delete, delq, remove, remq): Move #'remove, #'remq
here, they don't belong in cl-seq.el; move #'delete, #'delq here
from fns.c, implement them in terms of #'delete*, allowing support
for sequences generally.
* update-elc.el (do-autoload-commands): Use #'delete*, not #'delq
here, now the latter's no longer dumped.
* cl-macs.el (delete, delq): Add compiler macros transforming
#'delete and #'delq to #'delete* calls.
2011-01-10 Aidan Kehoe <kehoea@parhasard.net>
* dialog.el (make-dialog-box): Correct a misplaced parenthesis
here, thank you Mats Lidell in 87zkr9gqrh.fsf@mail.contactor.se !
2011-01-02 Aidan Kehoe <kehoea@parhasard.net>
* dialog.el (make-dialog-box):
* list-mode.el (display-completion-list):
These functions used to use cl-parsing-keywords; change them to
use defun* instead, fixing the build. (Not sure what led to me
not including this change in d1b17a33450b!)
2011-01-02 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (define-star-compiler-macros):
Make sure the form has ITEM and LIST specified before attempting
to change to calls with explicit tests; necessary for some tests
in lisp-tests.el to compile correctly.
(stable-union, stable-intersection): Add compiler macros for these
functions, in the same way we do for most of the other functions
in cl-seq.el.
2011-01-01 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (dolist, dotimes, do-symbols, macrolet)
(symbol-macrolet):
Define these macros with defmacro* instead of parsing the argument
list by hand, for the sake of style and readability; use backquote
where appropriate, instead of calling #'list and and friends, for
the same reason.
2010-12-30 Aidan Kehoe <kehoea@parhasard.net>
* x-misc.el (device-x-display):
Provide this function, documented in the Lispref for years, but
not existing previously. Thank you Julian Bradfield, thank you
Jeff Mincy.
2010-12-30 Aidan Kehoe <kehoea@parhasard.net>
* cl-seq.el:
Move the heavy lifting from this file to C. Dump the
cl-parsing-keywords macro, but don't use defun* for the functions
we define that do take keywords, dynamic scope lossage makes that
not practical.
* subr.el (sort, fillarray): Move these aliases here.
(map-plist): #'nsublis is now built-in, but at this point #'eql
isn't necessarily available as a test; use #'eq.
* obsolete.el (cl-delete-duplicates): Make this available for old
compiler macros and old code.
(memql): Document that this is equivalent to #'member*, and worse.
* cl.el (adjoin, subst): Removed. These are in C.
2010-12-30 Aidan Kehoe <kehoea@parhasard.net>
* simple.el (assoc-ignore-case): Remove a duplicate definition of
this function (it's already in subr.el).
* iso8859-1.el (char-width):
On non-Mule, make this function equivalent to that produced by
(constantly 1), but preserve its docstring.
* subr.el (subst-char-in-string): Define this in terms of
#'substitute, #'nsubstitute.
(string-width): Define this using #'reduce and #'char-width.
(char-width): Give this a simpler definition, it makes far more
sense to check for mule at load time and redefine, as we do in
iso8859-1.el.
(store-substring): Implement this in terms of #'replace, now
#'replace is cheap.
2010-12-30 Aidan Kehoe <kehoea@parhasard.net>
* update-elc.el (lisp-files-needed-for-byte-compilation)
(lisp-files-needing-early-byte-compilation):
cl-macs belongs in the former, not the latter, it is as
fundamental as bytecomp.el.
2010-12-30 Aidan Kehoe <kehoea@parhasard.net>
* cl.el:
Provde the Common Lisp program-error, type-error as error
symbols. This doesn't nearly go far enough for anyone using the
Common Lisp errors.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (delete-duplicates):
If the form has an incorrect number of arguments, don't attempt a
compiler macroexpansion.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (cl-safe-expr-p):
Forms that start with the symbol lambda are also safe.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (= < > <= >=):
For these functions' compiler macros, the optimisation is safe
even if the first and the last arguments have side effects, since
they're only used the once.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (inline-side-effect-free-compiler-macros):
Unroll a loop here at macro-expansion time, so these compiler
macros are compiled. Use #'eql instead of #'eq in a couple of
places for better style.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* cl-extra.el (notany, notevery): Avoid some dynamic scope
stupidity with local variable names in these functions, when they
weren't prefixed with cl-; go into some more detail in the doc
strings.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* byte-optimize.el (side-effect-free-fns): #'remove, #'remq are
free of side-effects.
(side-effect-and-error-free-fns):
Drop dot, dot-marker from the list.
2010-11-17 Aidan Kehoe <kehoea@parhasard.net>
* cl-extra.el (coerce):
In the argument list, name the first argument OBJECT, not X; the
former name was always used in the doc string and is clearer.
Handle vector type specifications which include the length of the
target sequence, error if there's a mismatch.
* cl-macs.el (cl-make-type-test): Handle type specifications
starting with the symbol 'eql.
2010-11-14 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (eql): Don't remove the byte-compile property of this
symbol. That was necessary to override a bug in bytecomp.el where
#'eql was confused with #'eq, which bug we no longer have.
If neither expression is constant, don't attempt to handle the
expression in this compiler macro, leave it to byte-compile-eql,
which produces better code anyway.
* bytecomp.el (eq): #'eql is not the function associated with the
byte-eq byte code.
(byte-compile-eql): Add an explicit compile method for this
function, for cases where the cl-macs compiler macro hasn't
reduced it to #'eq or #'equal.
2010-10-25 Aidan Kehoe <kehoea@parhasard.net>
Add compiler macros and compilation sanity-checking for various
functions that take keywords.
* byte-optimize.el (side-effect-free-fns): #'symbol-value is
side-effect free and not error free.
* bytecomp.el (byte-compile-normal-call): Check keyword argument
lists for sanity; store information about the positions where
keyword arguments start using the new byte-compile-keyword-start
property.
* cl-macs.el (cl-const-expr-val): Take a new optional argument,
cl-not-constant, defaulting to nil, in this function; return it if
the expression is not constant.
(cl-non-fixnum-number-p): Make this into a separate function, we
want to pass it to #'every.
(eql): Use it.
(define-star-compiler-macros): Use the same code to generate the
member*, assoc* and rassoc* compiler macros; special-case some
code in #'add-to-list in subr.el.
(remove, remq): Add compiler macros for these two functions, in
preparation for #'remove being in C.
(define-foo-if-compiler-macros): Transform (remove-if-not ...) calls to
(remove ... :if-not) at compile time, which will be a real win
once the latter is in C.
(define-substitute-if-compiler-macros)
(define-subst-if-compiler-macros): Similarly for these functions.
(delete-duplicates): Change this compiler macro to use
#'plists-equal; if we don't have information about the type of
SEQUENCE at compile time, don't bother attempting to inline the
call, the function will be in C soon enough.
(equalp): Remove an old commented-out compiler macro for this, if
we want to see it it's in version control.
(subst-char-in-string): Transform this to a call to nsubstitute or
nsubstitute, if that is appropriate.
* cl.el (ldiff): Don't call setf here, this makes for a load-time
dependency problem in cl-macs.el
2010-06-14 Stephen J. Turnbull <stephen@xemacs.org>
* term/vt100.el:
Refer to XEmacs, not GNU Emacs, in permissions.
* term/bg-mouse.el:
* term/sup-mouse.el:
Put copyright notice in canonical "Copyright DATE AUTHOR" form.
Refer to XEmacs, not GNU Emacs, in permissions.
* site-load.el:
Add permission boilerplate.
* mule/canna-leim.el:
* alist.el:
Refer to XEmacs, not APEL/this program, in permissions.
* mule/canna-leim.el:
Remove my copyright, I've assigned it to the FSF.
2010-06-14 Stephen J. Turnbull <stephen@xemacs.org>
* gtk.el:
* gtk-widget-accessors.el:
* gtk-package.el:
* gtk-marshal.el:
* gtk-compose.el:
* gnome.el:
Add copyright notice based on internal evidence.
2010-06-14 Stephen J. Turnbull <stephen@xemacs.org>
* easymenu.el: Add reference to COPYING to permission notice.
* gutter.el:
* gutter-items.el:
* menubar-items.el:
Fix typo "Xmacs" in permissions notice.
2010-06-14 Stephen J. Turnbull <stephen@xemacs.org>
* auto-save.el:
* font.el:
* fontconfig.el:
* mule/kinsoku.el:
Add "part of XEmacs" text to permission notice.
2010-10-14 Aidan Kehoe <kehoea@parhasard.net>
* byte-optimize.el (side-effect-free-fns):
* cl-macs.el (remf, getf):
* cl-extra.el (tailp, cl-set-getf, cl-do-remf):
* cl.el (ldiff, endp):
Tighten up Common Lisp compatibility for #'ldiff, #'endp, #'tailp;
add circularity checking for the first two.
#'cl-set-getf and #'cl-do-remf were Lisp implementations of
#'plist-put and #'plist-remprop; change the names to aliases,
changes the macros that use them to using #'plist-put and
#'plist-remprop directly.
2010-10-12 Aidan Kehoe <kehoea@parhasard.net>
* abbrev.el (fundamental-mode-abbrev-table, global-abbrev-table):
Create both these abbrev tables using the usual
#'define-abbrev-table calls, rather than attempting to
special-case them.
* cl-extra.el: Force cl-macs to be loaded here, if cl-extra.el is
being loaded interpreted. Previously other, later files would
redundantly call (load "cl-macs") when interpreted, it's more
reasonable to do it here, once.
* cmdloop.el (read-quoted-char-radix): Use defcustom here, we
don't have any dump-order dependencies that would prevent that.
* custom.el (eval-when-compile): Don't load cl-macs when
interpreted or when byte-compiling, rely on cl-extra.el in the
former case and the appropriate entry in bytecomp-load-hook in the
latter. Get rid of custom-declare-variable-list, we have no
dump-time dependencies that would require it.
* faces.el (eval-when-compile): Don't load cl-macs when
interpreted or when byte-compiling.
* packages.el: Remove some inaccurate comments.
* post-gc.el (cleanup-simple-finalizers): Use #'delete-if-not
here, now the order of preloaded-file-list has been changed to
make it available.
* subr.el (custom-declare-variable-list): Remove. No need for it.
Also remove a stub define-abbrev-table from this file, given the
current order of preloaded-file-list there's no need for it.
2010-10-10 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el (byte-compile-constp) Forms quoted with FUNCTION are
also constant.
(byte-compile-initial-macro-environment): In #'the, if FORM is
constant and does not match TYPE, warn at byte-compile time.
2010-10-10 Aidan Kehoe <kehoea@parhasard.net>
* backquote.el (bq-vector-contents, bq-list*): Remove; the former
is equivalent to (append VECTOR nil), the latter to (list* ...).
(bq-process-2): Use (append VECTOR nil) instead of using
#'bq-vector-contents to convert to a list.
(bq-process-1): Now we use list* instead of bq-list
* subr.el (list*): Moved from cl.el, since it is now required to
be available the first time a backquoted form is encountered.
* cl.el (list*): Move to subr.el.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* test-harness.el (Check-Message):
Add an omitted comma here, thank you the buildbot.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* hash-table.el (hash-table-key-list, hash-table-value-list)
(hash-table-key-value-alist, hash-table-key-value-plist):
Remove some useless #'nreverse calls in these files; our hash
tables have no order, it's not helpful to pretend they do.
* behavior.el (read-behavior):
Do the same in this file, in some code evidently copied from
hash-table.el.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* info.el (Info-insert-dir):
* format.el (format-deannotate-region):
* files.el (cd, save-buffers-kill-emacs):
Use #'some, #'every and related functions for applying boolean
operations to lists, instead of rolling our own ones that cons and
don't short-circuit.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el (byte-compile-initial-macro-environment):
* cl-macs.el (the):
Rephrase the docstring, make its implementation when compiling
files a little nicer.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* descr-text.el (unidata-initialize-unicodedata-database)
(unidata-initialize-unihan-database, describe-char-unicode-data)
(describe-char-unicode-data):
Wrap calls to the database functions with (with-fboundp ...),
avoiding byte compile warnings on builds without support for the
database functions.
(describe-char): (reduce #'max ...), not (apply #'max ...), no
need to cons needlessly.
(describe-char): Remove a redundant lambda wrapping
#'extent-properties.
(describe-char-unicode-data): Call #'nsubst when replacing "" with
nil in the result of #'split-string, instead of consing inside
mapcar.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* x-faces.el (x-available-font-sizes):
* specifier.el (let-specifier):
* package-ui.el (pui-add-required-packages):
* msw-faces.el (mswindows-available-font-sizes):
* modeline.el (modeline-minor-mode-menu):
* minibuf.el (minibuf-directory-files):
Replace the O2N (delq nil (mapcar (lambda (W) (and X Y)) Z)) with
the ON (mapcan (lambda (W) (and X (list Y))) Z) in these files.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (= < > <= >=):
When these functions are handed more than two arguments, and those
arguments have no side effects, transform to a series of two
argument calls, avoiding funcall in the byte-compiled code.
* mule/mule-cmds.el (finish-set-language-environment):
Take advantage of this change in a function called 256 times at
startup.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el (byte-compile-function-form, byte-compile-quote)
(byte-compile-quote-form):
Warn at compile time, and error at runtime, if a (quote ...) or a
(function ...) form attempts to quote more than one object.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* byte-optimize.el (byte-optimize-apply): Transform (apply 'nconc
(mapcar ...)) to (mapcan ...); warn about use of the first idiom.
* update-elc.el (do-autoload-commands):
* packages.el (packages-find-package-library-path):
* frame.el (frame-list):
* extents.el (extent-descendants):
* etags.el (buffer-tag-table-files):
* dumped-lisp.el (preloaded-file-list):
* device.el (device-list):
* bytecomp-runtime.el (proclaim-inline, proclaim-notinline)
Use #'mapcan, not (apply #'nconc (mapcar ...) in all these files.
* bytecomp-runtime.el (eval-when-compile, eval-and-compile):
In passing, mention that these macros also evaluate the body when
interpreted.
tests/ChangeLog addition:
2011-02-07 Aidan Kehoe <kehoea@parhasard.net>
* automated/lisp-tests.el:
Test lexical scope for `block', `return-from'; add a
Known-Bug-Expect-Failure for a contorted example that fails when
byte-compiled.
author | Aidan Kehoe <kehoea@parhasard.net> |
---|---|
date | Mon, 07 Feb 2011 12:01:24 +0000 |
parents | 94bbd4792049 |
children | 0af042a0c116 |
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 | |
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 | |
9 Free Software Foundation; either version 2, or (at your option) any | |
10 later version. | |
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 | |
18 along with XEmacs; see the file COPYING. If not, write to | |
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
20 Boston, MA 02111-1307, USA. */ | |
21 | |
22 /* Synched up with: FSF 19.30. Note that there are many more functions in | |
23 FSF's abbrev.c. These have been moved into Lisp in XEmacs. */ | |
24 | |
25 /* Authorship: | |
26 | |
27 FSF: Original version; a long time ago. | |
28 JWZ or Mly: Mostly moved into Lisp; maybe 1992. | |
29 Ben Wing: Some changes for Mule for 19.12. | |
30 Hrvoje Niksic: Largely rewritten in June 1997. | |
31 */ | |
32 | |
33 /* This file has been Mule-ized. */ | |
34 | |
35 #include <config.h> | |
36 #include "lisp.h" | |
37 | |
38 #include "buffer.h" | |
39 #include "commands.h" | |
40 #include "insdel.h" | |
41 #include "syntax.h" | |
42 #include "window.h" | |
43 | |
44 /* An abbrev table is an obarray. | |
45 Each defined abbrev is represented by a symbol in that obarray | |
46 whose print name is the abbreviation. | |
47 The symbol's value is a string which is the expansion. | |
48 If its function definition is non-nil, it is called | |
49 after the expansion is done. | |
50 The plist slot of the abbrev symbol is its usage count. */ | |
51 | |
52 /* The table of global abbrevs. These are in effect | |
53 in any buffer in which abbrev mode is turned on. */ | |
54 Lisp_Object Vglobal_abbrev_table; | |
55 | |
56 int abbrev_all_caps; | |
57 | |
58 /* Non-nil => use this location as the start of abbrev to expand | |
59 (rather than taking the word before point as the abbrev) */ | |
60 Lisp_Object Vabbrev_start_location; | |
61 | |
62 /* Buffer that Vabbrev_start_location applies to */ | |
63 Lisp_Object Vabbrev_start_location_buffer; | |
64 | |
65 /* The symbol representing the abbrev most recently expanded */ | |
66 Lisp_Object Vlast_abbrev; | |
67 | |
68 /* A string for the actual text of the abbrev most recently expanded. | |
69 This has more info than Vlast_abbrev since case is significant. */ | |
70 Lisp_Object Vlast_abbrev_text; | |
71 | |
72 /* Character address of start of last abbrev expanded */ | |
458 | 73 Fixnum last_abbrev_location; |
428 | 74 |
75 /* Hook to run before expanding any abbrev. */ | |
76 Lisp_Object Vpre_abbrev_expand_hook, Qpre_abbrev_expand_hook; | |
77 | |
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
|
78 Lisp_Object Qsystem_type; |
428 | 79 |
826 | 80 struct abbrev_match_mapper_closure |
81 { | |
428 | 82 struct buffer *buf; |
826 | 83 Lisp_Object chartab; |
814 | 84 Charbpos point; |
85 Charcount maxlen; | |
440 | 86 Lisp_Symbol *found; |
428 | 87 }; |
88 | |
89 /* For use by abbrev_match(): Match SYMBOL's name against buffer text | |
90 before point, case-insensitively. When found, return non-zero, so | |
91 that map_obarray terminates mapping. */ | |
92 static int | |
93 abbrev_match_mapper (Lisp_Object symbol, void *arg) | |
94 { | |
95 struct abbrev_match_mapper_closure *closure = | |
96 (struct abbrev_match_mapper_closure *)arg; | |
97 Charcount abbrev_length; | |
440 | 98 Lisp_Symbol *sym = XSYMBOL (symbol); |
793 | 99 Lisp_Object abbrev; |
428 | 100 |
101 /* symbol_value should be OK here, because abbrevs are not expected | |
102 to contain any SYMBOL_MAGIC stuff. */ | |
103 if (UNBOUNDP (symbol_value (sym)) || NILP (symbol_value (sym))) | |
104 { | |
105 /* The symbol value of nil means that abbrev got undefined. */ | |
106 return 0; | |
107 } | |
108 abbrev = symbol_name (sym); | |
826 | 109 abbrev_length = string_char_length (abbrev); |
428 | 110 if (abbrev_length > closure->maxlen) |
111 { | |
112 /* This abbrev is too large -- it wouldn't fit. */ | |
113 return 0; | |
114 } | |
115 /* If `bar' is an abbrev, and a user presses `fubar<SPC>', we don't | |
116 normally want to expand it. OTOH, if the abbrev begins with | |
117 non-word syntax (e.g. `#if'), it is OK to abbreviate it anywhere. */ | |
118 if (abbrev_length < closure->maxlen && abbrev_length > 0 | |
867 | 119 && (WORD_SYNTAX_P (closure->chartab, string_ichar (abbrev, 0))) |
428 | 120 && (WORD_SYNTAX_P (closure->chartab, |
121 BUF_FETCH_CHAR (closure->buf, | |
793 | 122 closure->point - |
123 (abbrev_length + 1))))) | |
428 | 124 { |
125 return 0; | |
126 } | |
127 /* Match abbreviation string against buffer text. */ | |
128 { | |
867 | 129 Ibyte *ptr = XSTRING_DATA (abbrev); |
428 | 130 Charcount idx; |
131 | |
132 for (idx = 0; idx < abbrev_length; idx++) | |
133 { | |
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
3965
diff
changeset
|
134 if (CANONCASE (closure->buf, |
428 | 135 BUF_FETCH_CHAR (closure->buf, |
136 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
|
137 != CANONCASE (closure->buf, itext_ichar (ptr))) |
428 | 138 { |
139 break; | |
140 } | |
867 | 141 INC_IBYTEPTR (ptr); |
428 | 142 } |
143 if (idx == abbrev_length) | |
144 { | |
145 /* This is the one. */ | |
146 closure->found = sym; | |
147 return 1; | |
148 } | |
149 } | |
150 return 0; | |
151 } | |
152 | |
153 /* Match the buffer text against names of symbols in obarray. Returns | |
154 the matching symbol, or 0 if not found. */ | |
440 | 155 static Lisp_Symbol * |
428 | 156 abbrev_match (struct buffer *buf, Lisp_Object obarray) |
157 { | |
158 struct abbrev_match_mapper_closure closure; | |
159 | |
160 /* Precalculate some stuff, so mapper function needn't to it in each | |
161 iteration. */ | |
162 closure.buf = buf; | |
163 closure.point = BUF_PT (buf); | |
164 closure.maxlen = closure.point - BUF_BEGV (buf); | |
826 | 165 closure.chartab = buf->mirror_syntax_table; |
428 | 166 closure.found = 0; |
167 | |
168 map_obarray (obarray, abbrev_match_mapper, &closure); | |
169 | |
170 return closure.found; | |
171 } | |
172 | |
173 /* Take the word before point (or Vabbrev_start_location, if non-nil), | |
174 and look it up in OBARRAY, and return the symbol (or zero). This | |
175 used to be the default method of searching, with the obvious | |
176 limitation that the abbrevs may consist only of word characters. | |
177 It is an order of magnitude faster than the proper abbrev_match(), | |
178 but then again, vi is an order of magnitude faster than Emacs. | |
179 | |
180 This speed difference should be unnoticeable, though. I have tested | |
181 the degenerated cases of thousands of abbrevs being defined, and | |
182 abbrev_match() was still fast enough for normal operation. */ | |
440 | 183 static Lisp_Symbol * |
428 | 184 abbrev_oblookup (struct buffer *buf, Lisp_Object obarray) |
185 { | |
665 | 186 Charbpos wordstart, wordend; |
867 | 187 Ibyte *word, *p; |
814 | 188 Charbpos idx; |
428 | 189 Lisp_Object lookup; |
190 | |
191 CHECK_VECTOR (obarray); | |
192 | |
193 if (!NILP (Vabbrev_start_location)) | |
194 { | |
195 wordstart = get_buffer_pos_char (buf, Vabbrev_start_location, | |
196 GB_COERCE_RANGE); | |
197 Vabbrev_start_location = Qnil; | |
198 #if 0 | |
199 /* Previously, abbrev-prefix-mark crockishly inserted a dash to | |
200 indicate the abbrev start point. It now uses an extent with | |
201 a begin glyph so there's no dash to remove. */ | |
202 if (wordstart != BUF_ZV (buf) | |
203 && BUF_FETCH_CHAR (buf, wordstart) == '-') | |
204 { | |
205 buffer_delete_range (buf, wordstart, wordstart + 1, 0); | |
206 } | |
207 #endif | |
208 wordend = BUF_PT (buf); | |
209 } | |
210 else | |
211 { | |
665 | 212 Charbpos point = BUF_PT (buf); |
428 | 213 |
214 wordstart = scan_words (buf, point, -1); | |
215 if (!wordstart) | |
216 return 0; | |
217 | |
218 wordend = scan_words (buf, wordstart, 1); | |
219 if (!wordend) | |
220 return 0; | |
221 if (wordend > BUF_ZV (buf)) | |
222 wordend = BUF_ZV (buf); | |
223 if (wordend > point) | |
224 wordend = point; | |
225 /* Unlike the original function, we allow expansion only after | |
226 the abbrev, not preceded by a number of spaces. This is | |
227 because of consistency with abbrev_match. */ | |
228 if (wordend < point) | |
229 return 0; | |
230 } | |
231 | |
232 if (wordend <= wordstart) | |
233 return 0; | |
234 | |
2367 | 235 p = word = alloca_ibytes (MAX_ICHAR_LEN * (wordend - wordstart)); |
428 | 236 for (idx = wordstart; idx < wordend; idx++) |
237 { | |
867 | 238 Ichar c = BUF_FETCH_CHAR (buf, idx); |
428 | 239 if (UPPERCASEP (buf, c)) |
240 c = DOWNCASE (buf, c); | |
867 | 241 p += set_itext_ichar (p, c); |
428 | 242 } |
243 lookup = oblookup (obarray, word, p - word); | |
244 if (SYMBOLP (lookup) && !NILP (symbol_value (XSYMBOL (lookup)))) | |
245 return XSYMBOL (lookup); | |
246 else | |
247 return NULL; | |
248 } | |
249 | |
250 /* Return non-zero if OBARRAY contains an interned symbol ` '. */ | |
251 static int | |
252 obarray_has_blank_p (Lisp_Object obarray) | |
253 { | |
867 | 254 return !ZEROP (oblookup (obarray, (Ibyte *)" ", 1)); |
428 | 255 } |
256 | |
257 /* Analyze case in the buffer substring, and report it. */ | |
258 static void | |
665 | 259 abbrev_count_case (struct buffer *buf, Charbpos pos, Charcount length, |
428 | 260 int *lccount, int *uccount) |
261 { | |
262 *lccount = *uccount = 0; | |
263 while (length--) | |
264 { | |
867 | 265 Ichar c = BUF_FETCH_CHAR (buf, pos); |
428 | 266 if (UPPERCASEP (buf, c)) |
267 ++*uccount; | |
268 else if (LOWERCASEP (buf, c)) | |
269 ++*lccount; | |
270 ++pos; | |
271 } | |
272 } | |
273 | |
274 DEFUN ("expand-abbrev", Fexpand_abbrev, 0, 0, "", /* | |
275 Expand the abbrev before point, if any. | |
276 Effective when explicitly called even when `abbrev-mode' is nil. | |
277 Returns the abbrev symbol, if expansion took place. | |
278 If no abbrev matched, but `pre-abbrev-expand-hook' changed the buffer, | |
279 returns t. | |
280 */ | |
281 ()) | |
282 { | |
283 /* This function can GC */ | |
284 struct buffer *buf = current_buffer; | |
285 int oldmodiff = BUF_MODIFF (buf); | |
286 Lisp_Object pre_modiff_p; | |
665 | 287 Charbpos point; /* position of point */ |
288 Charbpos abbrev_start; /* position of abbreviation beginning */ | |
428 | 289 |
440 | 290 Lisp_Symbol *(*fun) (struct buffer *, Lisp_Object); |
428 | 291 |
440 | 292 Lisp_Symbol *abbrev_symbol; |
428 | 293 Lisp_Object expansion, count, hook; |
294 Charcount abbrev_length; | |
295 int lccount, uccount; | |
296 | |
297 run_hook (Qpre_abbrev_expand_hook); | |
298 /* If the hook changes the buffer, treat that as having "done an | |
299 expansion". */ | |
300 pre_modiff_p = (BUF_MODIFF (buf) != oldmodiff ? Qt : Qnil); | |
301 | |
302 abbrev_symbol = NULL; | |
303 if (!BUFFERP (Vabbrev_start_location_buffer) || | |
304 XBUFFER (Vabbrev_start_location_buffer) != buf) | |
305 Vabbrev_start_location = Qnil; | |
306 /* We use the more general abbrev_match() if the obarray blank flag | |
307 is not set, and Vabbrev_start_location is nil. Otherwise, use | |
308 abbrev_oblookup(). */ | |
309 #define MATCHFUN(tbl) ((obarray_has_blank_p (tbl) \ | |
310 && NILP (Vabbrev_start_location)) \ | |
311 ? abbrev_match : abbrev_oblookup) | |
312 if (!NILP (buf->abbrev_table)) | |
313 { | |
314 fun = MATCHFUN (buf->abbrev_table); | |
315 abbrev_symbol = fun (buf, buf->abbrev_table); | |
316 } | |
317 if (!abbrev_symbol && !NILP (Vglobal_abbrev_table)) | |
318 { | |
319 fun = MATCHFUN (Vglobal_abbrev_table); | |
320 abbrev_symbol = fun (buf, Vglobal_abbrev_table); | |
321 } | |
322 if (!abbrev_symbol) | |
323 return pre_modiff_p; | |
324 | |
325 /* NOTE: we hope that `pre-abbrev-expand-hook' didn't do something | |
326 nasty, such as changed the buffer. Here we protect against the | |
327 buffer getting killed. */ | |
328 if (! BUFFER_LIVE_P (buf)) | |
329 return Qnil; | |
330 point = BUF_PT (buf); | |
331 | |
332 /* OK, we're out of the must-be-fast part. An abbreviation matched. | |
333 Now find the parameters, insert the expansion, and make it all | |
334 look pretty. */ | |
826 | 335 abbrev_length = string_char_length (symbol_name (abbrev_symbol)); |
428 | 336 abbrev_start = point - abbrev_length; |
337 | |
338 expansion = symbol_value (abbrev_symbol); | |
339 CHECK_STRING (expansion); | |
340 | |
341 count = symbol_plist (abbrev_symbol); /* Gag */ | |
342 if (NILP (count)) | |
343 count = Qzero; | |
344 else | |
345 CHECK_NATNUM (count); | |
5307
c096d8051f89
Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5182
diff
changeset
|
346 symbol_plist (abbrev_symbol) = Fadd1 (count); |
428 | 347 |
348 /* Count the case in the original text. */ | |
349 abbrev_count_case (buf, abbrev_start, abbrev_length, &lccount, &uccount); | |
350 | |
351 /* Remember the last abbrev text, location, etc. */ | |
793 | 352 Vlast_abbrev = wrap_symbol (abbrev_symbol); |
428 | 353 Vlast_abbrev_text = |
354 make_string_from_buffer (buf, abbrev_start, abbrev_length); | |
355 last_abbrev_location = abbrev_start; | |
356 | |
357 /* Add an undo boundary, in case we are doing this for a | |
358 self-inserting command which has avoided making one so far. */ | |
359 if (INTERACTIVE) | |
360 Fundo_boundary (); | |
361 | |
362 /* Remove the abbrev */ | |
363 buffer_delete_range (buf, abbrev_start, point, 0); | |
364 /* And insert the expansion. */ | |
365 buffer_insert_lisp_string (buf, expansion); | |
366 point = BUF_PT (buf); | |
367 | |
368 /* Now fiddle with the case. */ | |
369 if (uccount && !lccount) | |
370 { | |
371 /* Abbrev was all caps */ | |
372 if (!abbrev_all_caps | |
373 && scan_words (buf, point, -1) > scan_words (buf, abbrev_start, 1)) | |
374 { | |
375 Fupcase_initials_region (make_int (abbrev_start), make_int (point), | |
771 | 376 wrap_buffer (buf)); |
428 | 377 } |
378 else | |
379 { | |
380 /* If expansion is one word, or if user says so, upcase it all. */ | |
381 Fupcase_region (make_int (abbrev_start), make_int (point), | |
771 | 382 wrap_buffer (buf)); |
428 | 383 } |
384 } | |
385 else if (uccount) | |
386 { | |
387 /* Abbrev included some caps. Cap first initial of expansion */ | |
665 | 388 Charbpos pos = abbrev_start; |
428 | 389 /* Find the initial. */ |
390 while (pos < point | |
826 | 391 && !WORD_SYNTAX_P (buf->mirror_syntax_table, |
428 | 392 BUF_FETCH_CHAR (buf, pos))) |
393 pos++; | |
394 /* Change just that. */ | |
395 Fupcase_initials_region (make_int (pos), make_int (pos + 1), | |
771 | 396 wrap_buffer (buf)); |
428 | 397 } |
398 | |
399 hook = symbol_function (abbrev_symbol); | |
400 if (!NILP (hook) && !UNBOUNDP (hook)) | |
401 call0 (hook); | |
402 | |
403 return Vlast_abbrev; | |
404 } | |
405 | |
3965 | 406 static void |
407 write_abbrev (Lisp_Object sym, Lisp_Object stream) | |
408 { | |
409 Lisp_Object name, count, system_flag; | |
410 /* This function can GC */ | |
411 struct buffer *buf = current_buffer; | |
412 | |
413 if (INTP (XSYMBOL (sym)->plist)) | |
414 { | |
415 count = XSYMBOL (sym)->plist; | |
416 system_flag = Qnil; | |
417 } | |
418 else | |
419 { | |
420 count = Fget (sym, Qcount, Qunbound); | |
421 system_flag = Fget (sym, Qsystem_type, Qunbound); | |
422 } | |
423 | |
424 if (NILP (XSYMBOL_VALUE (sym)) || ! NILP (system_flag)) | |
425 return; | |
426 | |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
3965
diff
changeset
|
427 buffer_insert_ascstring (buf, " ("); |
3965 | 428 name = Fsymbol_name (sym); |
429 Fprin1 (name, 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_VALUE (sym), 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 (XSYMBOL (sym)->function, 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, " "); |
3965 | 435 Fprin1 (count, stream); |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
3965
diff
changeset
|
436 buffer_insert_ascstring (buf, ")\n"); |
3965 | 437 } |
438 | |
439 static void | |
440 describe_abbrev (Lisp_Object sym, Lisp_Object stream) | |
441 { | |
442 Lisp_Object one, count, system_flag; | |
443 /* This function can GC */ | |
444 struct buffer *buf = current_buffer; | |
445 | |
446 if (INTP (XSYMBOL (sym)->plist)) | |
447 { | |
448 count = XSYMBOL (sym)->plist; | |
449 system_flag = Qnil; | |
450 } | |
451 else | |
452 { | |
453 count = Fget (sym, Qcount, Qunbound); | |
454 system_flag = Fget (sym, Qsystem_type, Qunbound); | |
455 } | |
456 | |
457 if (NILP (XSYMBOL_VALUE (sym))) | |
458 return; | |
459 | |
460 one = make_int (1); | |
461 Fprin1 (Fsymbol_name (sym), stream); | |
462 | |
463 if (!NILP (system_flag)) | |
464 { | |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
3965
diff
changeset
|
465 buffer_insert_ascstring (buf, " (sys)"); |
3965 | 466 Findent_to (make_int (20), one, Qnil); |
467 } | |
468 else | |
469 Findent_to (make_int (15), one, Qnil); | |
470 | |
471 Fprin1 (count, stream); | |
472 Findent_to (make_int (20), one, Qnil); | |
473 Fprin1 (XSYMBOL_VALUE (sym), stream); | |
474 if (!NILP (XSYMBOL (sym)->function)) | |
475 { | |
476 Findent_to (make_int (45), one, Qnil); | |
477 Fprin1 (XSYMBOL (sym)->function, stream); | |
478 } | |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
3965
diff
changeset
|
479 buffer_insert_ascstring (buf, "\n"); |
3965 | 480 } |
481 | |
482 static int | |
483 record_symbol (Lisp_Object sym, void *arg) | |
484 { | |
485 Lisp_Object closure = * (Lisp_Object *) arg; | |
486 XSETCDR (closure, Fcons (sym, XCDR (closure))); | |
487 return 0; /* Never stop */ | |
488 } | |
489 | |
490 DEFUN ("insert-abbrev-table-description", Finsert_abbrev_table_description, | |
491 1, 2, 0, /* | |
492 Insert before point a full description of abbrev table named NAME. | |
493 NAME is a symbol whose value is an abbrev table. | |
494 If optional 2nd arg READABLE is non-nil, a human-readable description | |
495 is inserted. Otherwise the description is an expression, | |
496 a call to `define-abbrev-table', which would | |
497 define the abbrev table NAME exactly as it is currently defined. | |
498 | |
499 Abbrevs marked as "system abbrevs" are normally omitted. However, if | |
500 READABLE is non-nil, they are listed. */ | |
501 (name, readable)) | |
502 { | |
503 Lisp_Object table; | |
504 Lisp_Object symbols; | |
505 Lisp_Object stream; | |
506 /* This function can GC */ | |
507 struct buffer *buf = current_buffer; | |
508 | |
509 CHECK_SYMBOL (name); | |
510 table = Fsymbol_value (name); | |
511 CHECK_VECTOR (table); | |
512 | |
513 /* FIXME: what's the XEmacs equivalent? APA */ | |
514 /* XSETBUFFER (stream, current_buffer); */ | |
515 /* Does not seem to work: */ | |
516 /* Fset_buffer (stream); */ | |
517 stream = wrap_buffer (current_buffer); | |
518 | |
519 symbols = Fcons (Qnil, Qnil); | |
520 /* Lisp_Object closure = Fcons (Qnil, Qnil); */ | |
521 /* struct gcpro gcpro1; */ | |
522 /* GCPRO1 (closure); */ | |
523 /* map_obarray (table, record_symbol, symbols); */ | |
524 map_obarray (table, record_symbol, &symbols); | |
525 /* map_obarray (table, record_symbol, &closure); */ | |
526 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
|
527 symbols = list_sort (symbols, check_string_lessp_nokey, Qnil, Qnil); |
3965 | 528 |
529 if (!NILP (readable)) | |
530 { | |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
3965
diff
changeset
|
531 buffer_insert_ascstring (buf, "("); |
3965 | 532 Fprin1 (name, stream); |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
3965
diff
changeset
|
533 buffer_insert_ascstring (buf, ")\n\n"); |
3965 | 534 while (! NILP (symbols)) |
535 { | |
536 describe_abbrev (XCAR (symbols), stream); | |
537 symbols = XCDR (symbols); | |
538 } | |
539 | |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
3965
diff
changeset
|
540 buffer_insert_ascstring (buf, "\n\n"); |
3965 | 541 } |
542 else | |
543 { | |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
3965
diff
changeset
|
544 buffer_insert_ascstring (buf, "(define-abbrev-table '"); |
3965 | 545 Fprin1 (name, stream); |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
3965
diff
changeset
|
546 buffer_insert_ascstring (buf, " '(\n"); |
3965 | 547 while (! NILP (symbols)) |
548 { | |
549 write_abbrev (XCAR (symbols), stream); | |
550 symbols = XCDR (symbols); | |
551 } | |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
3965
diff
changeset
|
552 buffer_insert_ascstring (buf, " ))\n\n"); |
3965 | 553 } |
554 | |
555 return Qnil; | |
556 } | |
428 | 557 |
558 void | |
559 syms_of_abbrev (void) | |
560 { | |
3965 | 561 DEFSYMBOL(Qsystem_type); |
562 Qsystem_type = intern ("system-type"); | |
563 | 563 DEFSYMBOL (Qpre_abbrev_expand_hook); |
428 | 564 DEFSUBR (Fexpand_abbrev); |
3965 | 565 DEFSUBR (Finsert_abbrev_table_description); |
428 | 566 } |
567 | |
568 void | |
569 vars_of_abbrev (void) | |
570 { | |
571 DEFVAR_LISP ("global-abbrev-table", &Vglobal_abbrev_table /* | |
572 The abbrev table whose abbrevs affect all buffers. | |
573 Each buffer may also have a local abbrev table. | |
574 If it does, the local table overrides the global one | |
575 for any particular abbrev defined in both. | |
576 */ ); | |
577 Vglobal_abbrev_table = Qnil; /* setup by Lisp code */ | |
578 | |
579 DEFVAR_LISP ("last-abbrev", &Vlast_abbrev /* | |
580 The abbrev-symbol of the last abbrev expanded. | |
581 See the function `abbrev-symbol'. | |
582 */ ); | |
583 | |
584 DEFVAR_LISP ("last-abbrev-text", &Vlast_abbrev_text /* | |
585 The exact text of the last abbrev expanded. | |
586 nil if the abbrev has already been unexpanded. | |
587 */ ); | |
588 | |
589 DEFVAR_INT ("last-abbrev-location", &last_abbrev_location /* | |
590 The location of the start of the last abbrev expanded. | |
591 */ ); | |
592 | |
593 Vlast_abbrev = Qnil; | |
594 Vlast_abbrev_text = Qnil; | |
595 last_abbrev_location = 0; | |
596 | |
597 DEFVAR_LISP ("abbrev-start-location", &Vabbrev_start_location /* | |
598 Buffer position for `expand-abbrev' to use as the start of the abbrev. | |
599 nil means use the word before point as the abbrev. | |
600 Calling `expand-abbrev' sets this to nil. | |
601 */ ); | |
602 Vabbrev_start_location = Qnil; | |
603 | |
604 DEFVAR_LISP ("abbrev-start-location-buffer", &Vabbrev_start_location_buffer /* | |
605 Buffer that `abbrev-start-location' has been set for. | |
606 Trying to expand an abbrev in any other buffer clears `abbrev-start-location'. | |
607 */ ); | |
608 Vabbrev_start_location_buffer = Qnil; | |
609 | |
610 DEFVAR_BOOL ("abbrev-all-caps", &abbrev_all_caps /* | |
611 *Non-nil means expand multi-word abbrevs all caps if abbrev was so. | |
612 */ ); | |
613 abbrev_all_caps = 0; | |
614 | |
615 DEFVAR_LISP ("pre-abbrev-expand-hook", &Vpre_abbrev_expand_hook /* | |
616 Function or functions to be called before abbrev expansion is done. | |
617 This is the first thing that `expand-abbrev' does, and so this may change | |
618 the current abbrev table before abbrev lookup happens. | |
619 */ ); | |
620 Vpre_abbrev_expand_hook = Qnil; | |
621 } |