Mercurial > emacs
changeset 85710:beb909dfc54d
Rewrite abbrev.c in Elisp.
* image.c (Qcount): Don't declare as extern.
(syms_of_image): Initialize and staticpro `Qcount'.
* puresize.h (BASE_PURESIZE): Increase for the new abbrev.el functions.
* emacs.c (main): Don't call syms_of_abbrev.
* Makefile.in (obj): Remove abbrev.o.
(abbrev.o): Remove.
* abbrev.c: Remove.
Rewrite abbrev.c in Elisp.
* abbrev.el (abbrev-mode): Move custom group from cus-edit.el.
(abbrev-table-get, abbrev-table-put, abbrev-get)
(abbrev-put, make-abbrev-table, abbrev-table-p, clear-abbrev-table)
(define-abbrev, abbrev--check-chars, define-global-abbrev)
(define-mode-abbrev, abbrev--active-tables, abbrev-symbol)
(abbrev-expansion, abbrev--before-point, expand-abbrev)
(unexpand-abbrev, abbrev--write, abbrev--describe)
(insert-abbrev-table-description, define-abbrev-table):
New funs, largely transcribed from abbrev.c.
(abbrev-with-wrapper-hook): New macro.
(abbrev-table-name-list, global-abbrev-table)
(abbrev-minor-mode-table-alist, fundamental-mode-abbrev-table)
(abbrevs-changed, abbrev-all-caps, abbrev-start-location)
(abbrev-start-location-buffer, last-abbrev, last-abbrev-text)
(last-abbrev-location, pre-abbrev-expand-hook, abbrev-expand-function):
New vars, largely transcribed from abbrev.c.
* cus-edit.el (abbrev-mode): Remove. Move to abbrev.el.
* cus-start.el: Remove abbrev-all-caps and pre-abbrev-expand-hook.
* loadup.el: Load "abbrev.el" before "lisp-mode.el".
| author | Stefan Monnier <monnier@iro.umontreal.ca> |
|---|---|
| date | Sun, 28 Oct 2007 02:41:00 +0000 |
| parents | 2dabdbde81e8 |
| children | b6f5dc84b2e1 |
| files | doc/lispref/abbrevs.texi etc/NEWS lisp/ChangeLog lisp/abbrev.el lisp/cus-edit.el lisp/cus-start.el lisp/loadup.el src/ChangeLog src/Makefile.in src/abbrev.c src/emacs.c src/image.c src/puresize.h |
| diffstat | 13 files changed, 746 insertions(+), 873 deletions(-) [+] |
line wrap: on
line diff
--- a/doc/lispref/abbrevs.texi Sat Oct 27 22:15:27 2007 +0000 +++ b/doc/lispref/abbrevs.texi Sun Oct 28 02:41:00 2007 +0000 @@ -47,6 +47,10 @@ * Files: Abbrev Files. Saving abbrevs in files. * Expansion: Abbrev Expansion. Controlling expansion; expansion subroutines. * Standard Abbrev Tables:: Abbrev tables used by various major modes. +* Abbrev Properties:: How to read and set abbrev properties. + Which properties have which effect. +* Abbrev Table Properties:: How to read and set abbrev table properties. + Which properties have which effect. @end menu @node Abbrev Mode, Abbrev Tables, Abbrevs, Abbrevs @@ -75,9 +79,14 @@ This section describes how to create and manipulate abbrev tables. -@defun make-abbrev-table +@defun make-abbrev-table &rest props This function creates and returns a new, empty abbrev table---an obarray -containing no symbols. It is a vector filled with zeros. +containing no symbols. It is a vector filled with zeros. @var{props} +is a property list that is applied to the new table. +@end defun + +@defun abbrev-table-p table +Return non-@code{nil} is @var{table} is an abbrev table. @end defun @defun clear-abbrev-table table @@ -92,15 +101,18 @@ function sets the property lists of all copied abbrevs to 0. @end defun -@defun define-abbrev-table tabname definitions +@defun define-abbrev-table tabname definitions &optional docstring &rest props This function defines @var{tabname} (a symbol) as an abbrev table name, i.e., as a variable whose value is an abbrev table. It defines abbrevs in the table according to @var{definitions}, a list of elements of the form @code{(@var{abbrevname} @var{expansion} -@var{hook} @var{usecount} @var{system-flag})}. If an element of -@var{definitions} has length less than five, omitted elements default -to @code{nil}. A value of @code{nil} for @var{usecount} is equivalent -to zero. The return value is always @code{nil}. +[@var{hook}] [@var{props}...])}. These elements are passed as +arguments to @code{define-abbrev}. The return value is always +@code{nil}. + +The optional string @var{docstring} is the documentation string of the +variable @var{tabname}. The property list @var{props} is applied to +the abbrev table (@pxref{Abbrev Table Properties}). If this function is called more than once for the same @var{tabname}, subsequent calls add the definitions in @var{definitions} to @@ -132,20 +144,17 @@ @section Defining Abbrevs @code{define-abbrev} is the low-level basic function for defining an abbrev in a specified abbrev table. When major modes predefine standard -abbrevs, they should call @code{define-abbrev} and specify @code{t} for -@var{system-flag}. Be aware that any saved non-``system'' abbrevs are +abbrevs, they should call @code{define-abbrev} and specify a @code{t} for +the @code{system-flag} property. +Be aware that any saved non-``system'' abbrevs are restored at startup, i.e. before some major modes are loaded. Major modes should therefore not assume that when they are first loaded their abbrev tables are empty. -@defun define-abbrev table name expansion &optional hook count system-flag +@defun define-abbrev table name expansion &optional hook &rest props This function defines an abbrev named @var{name}, in @var{table}, to -expand to @var{expansion} and call @var{hook}. The return value is -@var{name}. - -The value of @var{count}, if specified, initializes the abbrev's -usage-count. If @var{count} is not specified or @code{nil}, the use -count is initialized to zero. +expand to @var{expansion} and call @var{hook}, with properties +@var{props} (@pxref{Abbrev Properties}). The return value is @var{name}. The argument @var{name} should be a string. The argument @var{expansion} is normally the desired expansion (a string), or @@ -167,12 +176,6 @@ returns @code{nil}, @code{expand-abbrev} also returns @code{nil}, as if expansion had not really occurred. -If @var{system-flag} is non-@code{nil}, that marks the abbrev as a -``system'' abbrev with the @code{system-type} property. Unless -@var{system-flag} has the value @code{force}, a ``system'' abbrev will -not overwrite an existing definition for a non-``system'' abbrev of the -same name. - Normally the function @code{define-abbrev} sets the variable @code{abbrevs-changed} to @code{t}, if it actually changes the abbrev. (This is so that some commands will offer to save the abbrevs.) It @@ -329,20 +332,19 @@ @code{expand-abbrev} for the sake of the @code{unexpand-abbrev} command. @end defvar -@c Emacs 19 feature -@defvar pre-abbrev-expand-hook -This is a normal hook whose functions are executed, in sequence, just -before any expansion of an abbrev. @xref{Hooks}. Since it is a normal -hook, the hook functions receive no arguments. However, they can find -the abbrev to be expanded by looking in the buffer before point. -Running the hook is the first thing that @code{expand-abbrev} does, and -so a hook function can be used to change the current abbrev table before -abbrev lookup happens. (Although you have to do this carefully. See -the example below.) +@defvar abbrev-expand-functions +This is a special hook run @emph{around} the @code{expand-abbrev} +function. Functions on this hook are called with a single argument +which is a function that performs the normal abbrev expansion. +The hook function can hence do anything it wants before and after +performing the expansion. It can also choose not to call its argument +and thus override the default behavior, or it may even call it +several times. The function should return the abbrev symbol if +expansion took place. @end defvar The following sample code shows a simple use of -@code{pre-abbrev-expand-hook}. It assumes that @code{foo-mode} is a +@code{abbrev-expand-functions}. It assumes that @code{foo-mode} is a mode for editing certain files in which lines that start with @samp{#} are comments. You want to use Text mode abbrevs for those lines. The regular local abbrev table, @code{foo-mode-abbrev-table} is @@ -351,30 +353,22 @@ definitions of @code{local-abbrev-table} and @code{text-mode-abbrev-table}. @smallexample -(defun foo-mode-pre-abbrev-expand () - (when (save-excursion (forward-line 0) (eq (char-after) ?#)) - (let ((local-abbrev-table text-mode-abbrev-table) - ;; Avoid infinite loop. - (pre-abbrev-expand-hook nil)) - (expand-abbrev)) - ;; We have already called `expand-abbrev' in this hook. - ;; Hence we want the "actual" call following this hook to be a no-op. - (setq abbrev-start-location (point-max) - abbrev-start-location-buffer (current-buffer)))) +(defun foo-mode-abbrev-expand-function (expand) + (if (not (save-excursion (forward-line 0) (eq (char-after) ?#))) + ;; Performs normal expansion. + (funcall expand) + ;; We're inside a comment: use the text-mode abbrevs. + (let ((local-abbrev-table text-mode-abbrev-table)) + (funcall expand)))) (add-hook 'foo-mode-hook #'(lambda () - (add-hook 'pre-abbrev-expand-hook - 'foo-mode-pre-abbrev-expand + (add-hook 'abbrev-expand-functions + 'foo-mode-abbrev-expand-function nil t))) @end smallexample -Note that @code{foo-mode-pre-abbrev-expand} just returns @code{nil} -without doing anything for lines not starting with @samp{#}. Hence -abbrevs expand normally using @code{foo-mode-abbrev-table} as local -abbrev table for such lines. - -@node Standard Abbrev Tables, , Abbrev Expansion, Abbrevs +@node Standard Abbrev Tables, Abbrev Properties, Abbrev Expansion, Abbrevs @comment node-name, next, previous, up @section Standard Abbrev Tables @@ -390,7 +384,16 @@ @defvar local-abbrev-table The value of this buffer-local variable is the (mode-specific) -abbreviation table of the current buffer. +abbreviation table of the current buffer. It can also be a list of +such tables. +@end defvar + +@defvar abbrev-minor-mode-table-alist +The value of this variable is a list of elements of the form +@code{(@var{mode} . @var{abbrev-table})} where @var{mode} is the name +of a variable: if the variable is bound to a non-@code{nil} value, +then the @var{abbrev-table} is active, otherwise it is ignored. +@var{abbrev-table} can also be a list of abbrev tables. @end defvar @defvar fundamental-mode-abbrev-table @@ -406,6 +409,105 @@ This is the local abbrev table used in Lisp mode and Emacs Lisp mode. @end defvar +@node Abbrev Properties, Abbrev Table Properties, Standard Abbrev Tables, Abbrevs +@section Abbrev Properties + +Abbrevs have properties, some of which influence the way they work. +They are usually set by providing the relevant arguments to +@code{define-abbrev} and can be manipulated with the functions: + +@defun abbrev-put abbrev prop val +Set the property @var{prop} of abbrev @var{abbrev} to value @var{val}. +@end defun + +@defun abbrev-get abbrev prop +Return the property @var{prop} of abbrev @var{abbrev}, or @code{nil} +if the abbrev has no such property. +@end defun + +The following properties have special meaning: + +@table @code +@item count +This property counts the number of times the abbrev has +been expanded. If not explicitly set, it is initialized to 0 by +@code{define-abbrev}. + +@item system-flag +If non-@code{nil}, this property marks the abbrev as a ``system'' +abbrev. Such abbrevs will not be saved to @var{abbrev-file-name}. +Also, unless @code{system-flag} has the value @code{force}, +a ``system'' abbrev will not overwrite an existing definition for +a non-``system'' abbrev of the same name. + +@item :enable-function +If non-@code{nil}, this property should be set to a function of no +arguments which returns @code{nil} if the abbrev should not be used +and @code{t} otherwise. + +@item :case-fixed +If non-@code{nil}, this property indicates that the case of the +abbrev's name is significant and should only match a text with the +same capitalization. It also disables the code that modifies the +capitalization of the expansion. + +@end table + +@node Abbrev Table Properties, , Abbrev Properties, Abbrevs +@section Abbrev Table Properties + +Like abbrevs, abble tables have properties, some of which influence +the way they work. They are usually set by providing the relevant +arguments to @code{define-abbrev-table} and can be manipulated with +the functions: + +@defun abbrev-table-put table prop val +Set the property @var{prop} of abbrev table @var{table} to value @var{val}. +@end defun + +@defun abbrev-table-get table prop +Return the property @var{prop} of abbrev table @var{table}, or @code{nil} +if the abbrev has no such property. +@end defun + +The following properties have special meaning: + +@table @code +@item :enable-function +If non-@code{nil}, this property should be set to a function of no +arguments which returns @code{nil} if the abbrev table should not be +used and @code{t} otherwise. This is like the @code{:enable-function} +abbrev property except that it applies to all abbrevs in the table and +is used even before trying to find the abbrev before point. + +@item :case-fixed +If non-@code{nil}, this property indicates that the case of the names +is significant for all abbrevs in the table and should only match +a text with the same capitalization. It also disables the code that +modifies the capitalization of the expansion. This is like the +@code{:case-fixed} abbrev property except that it applies to all +abbrevs in the table. + +@item :regexp +If non-@code{nil}, this property is a regular expression that +indicates how to extract the name of the abbrev before point before +looking it up in the table. When the regular expression matches +before point, the abbrev name is expected to be in submatch 1. +If this property is nil, @code{expand-function} defaults to +@code{"\\<\\(\\w+\\)\\W"}. This property allows the use of abbrevs +whose name contains characters of non-word syntax. + +@item :parents +This property holds the list of tables from which to inherit +other abbrevs. + +@item :abbrev-table-modiff +This property holds a counter incremented each time a new abbrev is +added to the table. + +@end table + + @ignore arch-tag: 5ffdbe08-2cd4-48ec-a5a8-080f95756eec @end ignore
--- a/etc/NEWS Sat Oct 27 22:15:27 2007 +0000 +++ b/etc/NEWS Sun Oct 28 02:41:00 2007 +0000 @@ -166,6 +166,20 @@ * Changes in Specialized Modes and Packages in Emacs 23.1 +** abbrev was rewritten in Elisp and extended with more flexibility. +*** New functions: abbrev-get, abbrev-put, abbrev-table-get, abbrev-table-put, + abbrev-table-p. +*** Special hook `abbrev-expand-functions' obsoletes `pre-abbrev-expand-hook'. +*** `make-abbrev-table', `define-abbrev', `define-abbrev-table' all take + extra arguments for arbitrary properties. +*** New variable `abbrev-minor-mode-table-alist'. +*** `local-abbrev-table' can hold a list of abbrev-tables. +*** Abbrevs have now the following special properties: + `count', `system-flag', `:enable-function', `:case-fixed'. +*** Abbrev-tables have now the following special properties: + `:parents', `:case-fixed', `:enable-function', `:regexp', + `abbrev-table-modiff'. + ** isearch can now search through multiple ChangeLog files. When running isearch in a ChangeLog file, if the search fails, then another C-s tries searching the previous ChangeLog,
--- a/lisp/ChangeLog Sat Oct 27 22:15:27 2007 +0000 +++ b/lisp/ChangeLog Sun Oct 28 02:41:00 2007 +0000 @@ -1,3 +1,26 @@ +2007-10-28 Stefan Monnier <monnier@iro.umontreal.ca> + + Rewrite abbrev.c in Elisp. + * abbrev.el (abbrev-mode): Move custom group from cus-edit.el. + (abbrev-table-get, abbrev-table-put, abbrev-get) + (abbrev-put, make-abbrev-table, abbrev-table-p, clear-abbrev-table) + (define-abbrev, abbrev--check-chars, define-global-abbrev) + (define-mode-abbrev, abbrev--active-tables, abbrev-symbol) + (abbrev-expansion, abbrev--before-point, expand-abbrev) + (unexpand-abbrev, abbrev--write, abbrev--describe) + (insert-abbrev-table-description, define-abbrev-table): + New funs, largely transcribed from abbrev.c. + (abbrev-with-wrapper-hook): New macro. + (abbrev-table-name-list, global-abbrev-table) + (abbrev-minor-mode-table-alist, fundamental-mode-abbrev-table) + (abbrevs-changed, abbrev-all-caps, abbrev-start-location) + (abbrev-start-location-buffer, last-abbrev, last-abbrev-text) + (last-abbrev-location, pre-abbrev-expand-hook, abbrev-expand-function): + New vars, largely transcribed from abbrev.c. + * cus-edit.el (abbrev-mode): Remove. Move to abbrev.el. + * cus-start.el: Remove abbrev-all-caps and pre-abbrev-expand-hook. + * loadup.el: Load "abbrev.el" before "lisp-mode.el". + 2007-10-27 Glenn Morris <rgm@gnu.org> * shell.el (shell-dirtrack-verbose, shell-directory-tracker): Doc fix.
--- a/lisp/abbrev.el Sat Oct 27 22:15:27 2007 +0000 +++ b/lisp/abbrev.el Sun Oct 28 02:41:00 2007 +0000 @@ -27,8 +27,20 @@ ;; This facility is documented in the Emacs Manual. +;; Todo: + +;; - Make abbrev-file-name obey user-emacs-directory. +;; - Cleanup name space. + ;;; Code: +(eval-when-compile (require 'cl)) + +(defgroup abbrev-mode nil + "Word abbreviations mode." + :link '(custom-manual "(emacs)Abbrevs") + :group 'abbrev) + (defcustom only-global-abbrevs nil "Non-nil means user plans to use global abbrevs only. This makes the commands that normally define mode-specific abbrevs @@ -363,6 +375,528 @@ (if (or noquery (y-or-n-p (format "Expand `%s'? " string))) (expand-abbrev))))))) +;;; Abbrev properties. + +(defun abbrev-table-get (table prop) + "Get the PROP property of abbrev table TABLE." + (let ((sym (intern-soft "" table))) + (if sym (get sym prop)))) + +(defun abbrev-table-put (table prop val) + "Set the PROP property of abbrev table TABLE to VAL." + (let ((sym (intern "" table))) + (set sym nil) ; Make sure it won't be confused for an abbrev. + (put sym prop val))) + +(defun abbrev-get (sym prop) + "Get the property PROP of abbrev SYM." + (let ((plist (symbol-plist sym))) + (if (listp plist) + (plist-get plist prop) + (if (eq 'count prop) plist)))) + +(defun abbrev-put (sym prop val) + "Set the property PROP of abbrev SYM to value VAL. +See `define-abbrev' for the effect of some special properties." + (let ((plist (symbol-plist sym))) + (if (consp plist) + (put sym prop val) + (setplist sym (if (eq 'count prop) val + (list 'count plist prop val)))))) + +(defmacro abbrev-with-wrapper-hook (var &rest body) + "Run BODY wrapped with the VAR hook. +VAR is a special hook: its functions are called with one argument which +is the \"original\" code (the BODY), so the hook function can wrap the +original function, can call it several times, or even not call it at all. +VAR is normally a symbol (a variable) in which case it is treated like a hook, +with a buffer-local and a global part. But it can also be an arbitrary expression. +This is similar to an `around' advice." + (declare (indent 1) (debug t)) + ;; We need those two gensyms because CL's lexical scoping is not available + ;; for function arguments :-( + (let ((funs (make-symbol "funs")) + (global (make-symbol "global"))) + ;; Since the hook is a wrapper, the loop has to be done via + ;; recursion: a given hook function will call its parameter in order to + ;; continue looping. + `(labels ((runrestofhook (,funs ,global) + ;; `funs' holds the functions left on the hook and `global' + ;; holds the functions left on the global part of the hook + ;; (in case the hook is local). + (lexical-let ((funs ,funs) + (global ,global)) + (if (consp funs) + (if (eq t (car funs)) + (runrestofhook (append global (cdr funs)) nil) + (funcall (car funs) + (lambda () (runrestofhook (cdr funs) global)))) + ;; Once there are no more functions on the hook, run + ;; the original body. + ,@body)))) + (runrestofhook ,var + ;; The global part of the hook, if any. + ,(if (symbolp var) + `(if (local-variable-p ',var) + (default-value ',var))))))) + + +;;; Code that used to be implemented in src/abbrev.c + +(defvar abbrev-table-name-list '(fundamental-mode-abbrev-table + global-abbrev-table) + "List of symbols whose values are abbrev tables.") + +(defun make-abbrev-table (&optional props) + "Create a new, empty abbrev table object. +PROPS is a " + ;; The value 59 is an arbitrary prime number. + (let ((table (make-vector 59 0))) + ;; Each abbrev-table has a `modiff' counter which can be used to detect + ;; when an abbreviation was added. An example of use would be to + ;; construct :regexp dynamically as the union of all abbrev names, so + ;; `modiff' can let us detect that an abbrev was added and hence :regexp + ;; needs to be refreshed. + ;; The presence of `modiff' entry is also used as a tag indicating this + ;; vector is really an abbrev-table. + (abbrev-table-put table :abbrev-table-modiff 0) + (while (consp props) + (abbrev-table-put table (pop props) (pop props))) + table)) + +(defun abbrev-table-p (object) + (and (vectorp object) + (numberp (abbrev-table-get object :abbrev-table-modiff)))) + +(defvar global-abbrev-table (make-abbrev-table) + "The abbrev table whose abbrevs affect all buffers. +Each buffer may also have a local abbrev table. +If it does, the local table overrides the global one +for any particular abbrev defined in both.") + +(defvar abbrev-minor-mode-table-alist nil + "Alist of abbrev tables to use for minor modes. +Each element looks like (VARIABLE . ABBREV-TABLE); +ABBREV-TABLE is active whenever VARIABLE's value is non-nil.") + +(defvar fundamental-mode-abbrev-table + (let ((table (make-abbrev-table))) + ;; Set local-abbrev-table's default to be fundamental-mode-abbrev-table. + (setq-default local-abbrev-table table) + table) + "The abbrev table of mode-specific abbrevs for Fundamental Mode.") + +(defvar abbrevs-changed nil + "Set non-nil by defining or altering any word abbrevs. +This causes `save-some-buffers' to offer to save the abbrevs.") + +(defcustom abbrev-all-caps nil + "Non-nil means expand multi-word abbrevs all caps if abbrev was so." + :type 'boolean + :group 'abbrev-mode) + +(defvar abbrev-start-location nil + "Buffer position for `expand-abbrev' to use as the start of the abbrev. +When nil, use the word before point as the abbrev. +Calling `expand-abbrev' sets this to nil.") + +(defvar abbrev-start-location-buffer nil + "Buffer that `abbrev-start-location' has been set for. +Trying to expand an abbrev in any other buffer clears `abbrev-start-location'.") + +(defvar last-abbrev nil + "The abbrev-symbol of the last abbrev expanded. See `abbrev-symbol'.") + +(defvar last-abbrev-text nil + "The exact text of the last abbrev expanded. +nil if the abbrev has already been unexpanded.") + +(defvar last-abbrev-location 0 + "The location of the start of the last abbrev expanded.") + +;; (defvar local-abbrev-table fundamental-mode-abbrev-table +;; "Local (mode-specific) abbrev table of current buffer.") +;; (make-variable-buffer-local 'local-abbrev-table) + +(defcustom pre-abbrev-expand-hook nil + "Function or functions to be called before abbrev expansion is done. +This is the first thing that `expand-abbrev' does, and so this may change +the current abbrev table before abbrev lookup happens." + :type 'hook + :group 'abbrev-mode) +(make-obsolete-variable 'pre-abbrev-expand-hook 'abbrev-expand-functions "23.1") + +(defun clear-abbrev-table (table) + "Undefine all abbrevs in abbrev table TABLE, leaving it empty." + (setq abbrevs-changed t) + (dotimes (i (length table)) + (aset table i 0))) + +(defun define-abbrev (table name expansion &optional hook &rest props) + "Define an abbrev in TABLE named NAME, to expand to EXPANSION and call HOOK. +NAME must be a string, and should be lower-case. +EXPANSION should usually be a string. +To undefine an abbrev, define it with EXPANSION = nil. +If HOOK is non-nil, it should be a function of no arguments; +it is called after EXPANSION is inserted. +If EXPANSION is not a string, the abbrev is a special one, + which does not expand in the usual way but only runs HOOK. + +PROPS is a property list. The following properties are special: +- `count': the value for the abbrev's usage-count, which is incremented each time + the abbrev is used (the default is zero). +- `system-flag': if non-nil, says that this is a \"system\" abbreviation + which should not be saved in the user's abbreviation file. + Unless `system-flag' is `force', a system abbreviation will not + overwrite a non-system abbreviation of the same name. +- `:case-fixed': non-nil means that abbreviations are looked up without + case-folding, and the expansion is not capitalized/upcased. +- `:enable-function': a function of no argument which returns non-nil iff the + abbrev should be used for a particular call of `expand-abbrev'. + +An obsolete but still supported calling form is: + +\(define-abbrev TABLE NAME EXPANSION &optional HOOK COUNT SYSTEM-FLAG)." + (when (and (consp props) (or (null (car props)) (numberp (car props)))) + ;; Old-style calling convention. + (setq props (list* 'count (car props) + (if (cadr props) (list 'system-flag (cadr props)))))) + (unless (plist-get props 'count) + (setq props (plist-put props 'count 0))) + (let ((system-flag (plist-get props 'system-flag)) + (sym (intern name table))) + ;; Don't override a prior user-defined abbrev with a system abbrev, + ;; unless system-flag is `force'. + (unless (and (not (memq system-flag '(nil force))) + (boundp sym) (symbol-value sym) + (not (abbrev-get sym 'system-flag))) + (unless (or system-flag + (and (boundp sym) (fboundp sym) + ;; load-file-name + (equal (symbol-value sym) expansion) + (equal (symbol-function sym) hook))) + (setq abbrevs-changed t)) + (set sym expansion) + (fset sym hook) + (setplist sym props) + (abbrev-table-put table :abbrev-table-modiff + (1+ (abbrev-table-get table :abbrev-table-modiff)))) + name)) + +(defun abbrev--check-chars (abbrev global) + "Check if the characters in ABBREV have word syntax in either the +current (if global is nil) or standard syntax table." + (with-syntax-table + (cond ((null global) (standard-syntax-table)) + ;; ((syntax-table-p global) global) + (t (syntax-table))) + (when (string-match "\\W" abbrev) + (let ((badchars ()) + (pos 0)) + (while (string-match "\\W" abbrev pos) + (pushnew (aref abbrev (match-beginning 0)) badchars) + (setq pos (1+ pos))) + (error "Some abbrev characters (%s) are not word constituents %s" + (apply 'string (nreverse badchars)) + (if global "in the standard syntax" "in this mode")))))) + +(defun define-global-abbrev (abbrev expansion) + "Define ABBREV as a global abbreviation for EXPANSION. +The characters in ABBREV must all be word constituents in the standard +syntax table." + (interactive "sDefine global abbrev: \nsExpansion for %s: ") + (abbrev--check-chars abbrev 'global) + (define-abbrev global-abbrev-table (downcase abbrev) expansion)) + +(defun define-mode-abbrev (abbrev expansion) + "Define ABBREV as a mode-specific abbreviation for EXPANSION. +The characters in ABBREV must all be word-constituents in the current mode." + (interactive "sDefine mode abbrev: \nsExpansion for %s: ") + (unless local-abbrev-table + (error "Major mode has no abbrev table")) + (abbrev--check-chars abbrev nil) + (define-abbrev local-abbrev-table (downcase abbrev) expansion)) + +(defun abbrev--active-tables (&optional tables) + "Return the list of abbrev tables currently active. +TABLES if non-nil overrides the usual rules. It can hold +either a single abbrev table or a list of abbrev tables." + ;; We could just remove the `tables' arg and let callers use + ;; (or table (abbrev--active-tables)) but then they'd have to be careful + ;; to treat the distinction between a single table and a list of tables. + (cond + ((consp tables) tables) + ((vectorp tables) (list tables)) + (t + (let ((tables (if (listp local-abbrev-table) + (append local-abbrev-table + (list global-abbrev-table)) + (list local-abbrev-table global-abbrev-table)))) + ;; Add the minor-mode abbrev tables. + (dolist (x abbrev-minor-mode-table-alist) + (when (and (symbolp (car x)) (boundp (car x)) (symbol-value (car x))) + (setq tables + (if (listp (cdr x)) + (append (cdr x) tables) (cons (cdr x) tables))))) + tables)))) + + +(defun abbrev-symbol (abbrev &optional table) + "Return the symbol representing abbrev named ABBREV. +This symbol's name is ABBREV, but it is not the canonical symbol of that name; +it is interned in an abbrev-table rather than the normal obarray. +The value is nil if that abbrev is not defined. +Optional second arg TABLE is abbrev table to look it up in. +The default is to try buffer's mode-specific abbrev table, then global table." + (let ((tables (abbrev--active-tables table)) + sym) + (while (and tables (not (symbol-value sym))) + (let ((table (pop tables)) + (case-fold (not (abbrev-table-get table :case-fixed)))) + (setq tables (append (abbrev-table-get table :parents) tables)) + ;; In case the table doesn't set :case-fixed but some of the + ;; abbrevs do, we have to be careful. + (setq sym + ;; First try without case-folding. + (or (intern-soft abbrev table) + (when case-fold + ;; We didn't find any abbrev, try case-folding. + (let ((sym (intern-soft (downcase abbrev) table))) + ;; Only use it if it doesn't require :case-fixed. + (and sym (not (abbrev-get sym :case-fixed)) + sym))))))) + (if (symbol-value sym) + sym))) + + +(defun abbrev-expansion (abbrev &optional table) + "Return the string that ABBREV expands into in the current buffer. +Optionally specify an abbrev table as second arg; +then ABBREV is looked up in that table only." + (symbol-value (abbrev-symbol abbrev table))) + + +(defun abbrev--before-point () + "Try and find an abbrev before point. Return it if found, nil otherwise." + (unless (eq abbrev-start-location-buffer (current-buffer)) + (setq abbrev-start-location nil)) + + (let ((tables (abbrev--active-tables)) + (pos (point)) + start end name res) + + (if abbrev-start-location + (progn + (setq start abbrev-start-location) + (setq abbrev-start-location nil) + ;; Remove the hyphen inserted by `abbrev-prefix-mark'. + (if (and (< start (point-max)) + (eq (char-after start) ?-)) + (delete-region start (1+ start))) + (skip-syntax-backward " ") + (setq end (point)) + (setq name (buffer-substring start end)) + (goto-char pos) ; Restore point. + (list (abbrev-symbol name tables) name start end)) + + (while (and tables (not (car res))) + (let* ((table (pop tables)) + (enable-fun (abbrev-table-get table :enable-function))) + (setq tables (append (abbrev-table-get table :parents) tables)) + (setq res + (and (or (not enable-fun) (funcall enable-fun)) + (looking-back (or (abbrev-table-get table :regexp) + "\\<\\(\\w+\\)\\W*") + (line-beginning-position)) + (setq start (match-beginning 1)) + (setq end (match-end 1)) + (setq name (buffer-substring start end)) + ;; This will also look it up in parent tables. + ;; This is not on purpose, but it seems harmless. + (list (abbrev-symbol name table) name start end))) + ;; Restore point. + (goto-char pos))) + res))) + +(defvar abbrev-expand-functions nil + "Wrapper hook around `expand-abbrev'. +The functions on this special hook are called with one argument: +a function that performs the abbrev expansion. It should return +the abbrev symbol if expansion took place.") + +(defun expand-abbrev () + "Expand the abbrev before point, if there is an abbrev there. +Effective when explicitly called even when `abbrev-mode' is nil. +Returns the abbrev symbol, if expansion took place." + (interactive) + (run-hooks 'pre-abbrev-expand-hook) + (abbrev-with-wrapper-hook abbrev-expand-functions + (destructuring-bind (&optional sym name wordstart wordend) + (abbrev--before-point) + (when sym + (let ((value sym)) + (unless (or ;; executing-kbd-macro + noninteractive + (window-minibuffer-p (selected-window))) + ;; Add an undo boundary, in case we are doing this for + ;; a self-inserting command which has avoided making one so far. + (undo-boundary)) + ;; Now sym is the abbrev symbol. + (setq last-abbrev-text name) + (setq last-abbrev sym) + (setq last-abbrev-location wordstart) + ;; Increment use count. + (abbrev-put sym 'count (1+ (abbrev-get sym 'count))) + ;; If this abbrev has an expansion, delete the abbrev + ;; and insert the expansion. + (when (stringp (symbol-value sym)) + (goto-char wordend) + (insert (symbol-value sym)) + (delete-region wordstart wordend) + (let ((case-fold-search nil)) + ;; If the abbrev's name is different from the buffer text (the + ;; only difference should be capitalization), then we may want + ;; to adjust the capitalization of the expansion. + (when (and (not (equal name (symbol-name sym))) + (string-match "[[:upper:]]" name)) + (if (not (string-match "[[:lower:]]" name)) + ;; Abbrev was all caps. If expansion is multiple words, + ;; normally capitalize each word. + (if (and (not abbrev-all-caps) + (save-excursion + (> (progn (backward-word 1) (point)) + (progn (goto-char wordstart) + (forward-word 1) (point))))) + (upcase-initials-region wordstart (point)) + (upcase-region wordstart (point))) + ;; Abbrev included some caps. Cap first initial of expansion. + (let ((end (point))) + ;; Find the initial. + (goto-char wordstart) + (skip-syntax-forward "^w" (1- end)) + ;; Change just that. + (upcase-initials-region (point) (1+ (point)))))))) + (when (symbol-function sym) + (let* ((hook (symbol-function sym)) + (expanded + ;; If the abbrev has a hook function, run it. + (funcall hook))) + ;; In addition, if the hook function is a symbol with + ;; a non-nil `no-self-insert' property, let the value it + ;; returned specify whether we consider that an expansion took + ;; place. If it returns nil, no expansion has been done. + (if (and (symbolp hook) + (null expanded) + (get hook 'no-self-insert)) + (setq value nil)))) + value))))) + +(defun unexpand-abbrev () + "Undo the expansion of the last abbrev that expanded. +This differs from ordinary undo in that other editing done since then +is not undone." + (interactive) + (save-excursion + (unless (or (< last-abbrev-location (point-min)) + (> last-abbrev-location (point-max))) + (goto-char last-abbrev-location) + (when (stringp last-abbrev-text) + ;; This isn't correct if last-abbrev's hook was used + ;; to do the expansion. + (let ((val (symbol-value last-abbrev))) + (unless (stringp val) + (error "value of abbrev-symbol must be a string")) + (delete-region (point) (+ (point) (length val))) + ;; Don't inherit properties here; just copy from old contents. + (insert last-abbrev-text) + (setq last-abbrev-text nil)))))) + +(defun abbrev--write (sym) + "Write the abbrev in a `read'able form. +Only writes the non-system abbrevs. +Presumes that `standard-output' points to `current-buffer'." + (unless (or (null (symbol-value sym)) (abbrev-get sym 'system-flag)) + (insert " (") + (prin1 name) + (insert " ") + (prin1 (symbol-value sym)) + (insert " ") + (prin1 (symbol-function sym)) + (insert " ") + (prin1 (abbrev-get sym 'count)) + (insert ")\n"))) + +(defun abbrev--describe (sym) + (when (symbol-value sym) + (prin1 (symbol-name sym)) + (if (null (abbrev-get sym 'system-flag)) + (indent-to 15 1) + (insert " (sys)") + (indent-to 20 1)) + (prin1 (abbrev-get sym 'count)) + (indent-to 20 1) + (prin1 (symbol-value sym)) + (when (symbol-function sym) + (indent-to 45 1) + (prin1 (symbol-function sym))) + (terpri))) + +(defun insert-abbrev-table-description (name &optional readable) + "Insert before point a full description of abbrev table named NAME. +NAME is a symbol whose value is an abbrev table. +If optional 2nd arg READABLE is non-nil, a human-readable description +is inserted. Otherwise the description is an expression, +a call to `define-abbrev-table', which would +define the abbrev table NAME exactly as it is currently defined. + +Abbrevs marked as \"system abbrevs\" are omitted." + (let ((table (symbol-value name)) + (symbols ())) + (mapatoms (lambda (sym) (if (symbol-value sym) (push sym symbols))) table) + (setq symbols (sort symbols 'string-lessp)) + (let ((standard-output (current-buffer))) + (if readable + (progn + (insert "(") + (prin1 name) + (insert ")\n\n") + (mapc 'abbrev--describe symbols) + (insert "\n\n")) + (insert "(define-abbrev-table '") + (prin1 name) + (insert " '(") + (mapc 'abbrev--write symbols) + (insert " ))\n\n")) + nil))) + +(defun define-abbrev-table (tablename definitions + &optional docstring &rest props) + "Define TABLENAME (a symbol) as an abbrev table name. +Define abbrevs in it according to DEFINITIONS, which is a list of elements +of the form (ABBREVNAME EXPANSION HOOK USECOUNT SYSTEMFLAG). +\(If the list is shorter than that, omitted elements default to nil). +PROPS is a property list to apply to the table. +Properties with special meaning: +- `:parents' contains a list of abbrev tables from which this table inherits + abbreviations. +- `:case-fixed' non-nil means that abbreviations are looked up without + case-folding, and the expansion is not capitalized/upcased. +- `:regexp' describes the form of abbrevs. It defaults to \\<\\(\\w+\\)\\W* which + means that an abbrev can only be a single word. The submatch 1 is treated + as the potential name of an abbrev. +- `:enable-function' can be set to a function of no argument which returns + non-nil iff the abbrevs in this table should be used for this instance + of `expand-abbrev'." + (let ((table (if (boundp tablename) (symbol-value tablename)))) + (unless table + (setq table (make-abbrev-table props)) + (set tablename table) + (push tablename abbrev-table-name-list)) + (when (stringp docstring) + (put tablename 'variable-documentation docstring)) + (dolist (elt definitions) + (apply 'define-abbrev table elt)))) + (provide 'abbrev) ;; arch-tag: dbd6f3ae-dfe3-40ba-b00f-f9e3ff960df5
--- a/lisp/cus-edit.el Sat Oct 27 22:15:27 2007 +0000 +++ b/lisp/cus-edit.el Sun Oct 28 02:41:00 2007 +0000 @@ -374,11 +374,6 @@ :prefix "custom-" :group 'customize) -(defgroup abbrev-mode nil - "Word abbreviations mode." - :link '(custom-manual "(emacs)Abbrevs") - :group 'abbrev) - (defgroup alloc nil "Storage allocation and gc for GNU Emacs Lisp interpreter." :tag "Storage Allocation"
--- a/lisp/cus-start.el Sat Oct 27 22:15:27 2007 +0000 +++ b/lisp/cus-start.el Sun Oct 28 02:41:00 2007 +0000 @@ -35,10 +35,7 @@ ;;; Code: -(let ((all '(;; abbrev.c - (abbrev-all-caps abbrev-mode boolean) - (pre-abbrev-expand-hook abbrev-mode hook) - ;; alloc.c +(let ((all '(;; alloc.c (gc-cons-threshold alloc integer) (garbage-collection-messages alloc boolean) ;; buffer.c
--- a/lisp/loadup.el Sat Oct 27 22:15:27 2007 +0000 +++ b/lisp/loadup.el Sun Oct 28 02:41:00 2007 +0000 @@ -160,6 +160,7 @@ (load "textmodes/page") (load "register") (load "textmodes/paragraphs") +(load "abbrev") ;lisp-mode.el uses define-abbrev-table. (load "emacs-lisp/lisp-mode") (load "textmodes/text-mode") (load "textmodes/fill") @@ -169,7 +170,6 @@ (if (eq system-type 'vax-vms) (progn (load "vmsproc"))) -(load "abbrev") (load "buff-menu") (if (fboundp 'x-create-frame)
--- a/src/ChangeLog Sat Oct 27 22:15:27 2007 +0000 +++ b/src/ChangeLog Sun Oct 28 02:41:00 2007 +0000 @@ -1,3 +1,14 @@ +2007-10-28 Stefan Monnier <monnier@iro.umontreal.ca> + + Rewrite abbrev.c in Elisp. + * image.c (Qcount): Don't declare as extern. + (syms_of_image): Initialize and staticpro `Qcount'. + * puresize.h (BASE_PURESIZE): Increase for the new abbrev.el functions. + * emacs.c (main): Don't call syms_of_abbrev. + * Makefile.in (obj): Remove abbrev.o. + (abbrev.o): Remove. + * abbrev.c: Remove. + 2007-10-26 Martin Rudalics <rudalics@gmx.at> * window.c (window_min_size_2): Don't count header-line.
--- a/src/Makefile.in Sat Oct 27 22:15:27 2007 +0000 +++ b/src/Makefile.in Sun Oct 28 02:41:00 2007 +0000 @@ -603,7 +603,7 @@ cmds.o casetab.o casefiddle.o indent.o search.o regex.o undo.o \ alloc.o data.o doc.o editfns.o callint.o \ eval.o floatfns.o fns.o print.o lread.o \ - abbrev.o syntax.o UNEXEC bytecode.o \ + syntax.o UNEXEC bytecode.o \ process.o callproc.o \ region-cache.o sound.o atimer.o \ doprnt.o strftime.o intervals.o textprop.o composite.o md5.o \ @@ -1094,8 +1094,6 @@ it is so often changed in ways that do not require any recompilation and so rarely changed in ways that do require any. */ -abbrev.o: abbrev.c buffer.h window.h dispextern.h commands.h charset.h \ - syntax.h $(config_h) buffer.o: buffer.c buffer.h region-cache.h commands.h window.h \ dispextern.h $(INTERVAL_SRC) blockinput.h atimer.h systime.h charset.h \ $(config_h) @@ -1279,7 +1277,7 @@ sunfns.o: sunfns.c buffer.h window.h dispextern.h termhooks.h $(config_h) #ifdef HAVE_CARBON -abbrev.o buffer.o callint.o cmds.o dispnew.o editfns.o fileio.o frame.o \ +buffer.o callint.o cmds.o dispnew.o editfns.o fileio.o frame.o \ fontset.o indent.o insdel.o keyboard.o macros.o minibuf.o msdos.o process.o \ scroll.o sysdep.o term.o terminal.o widget.o window.o xdisp.o xfaces.o xfns.o xmenu.o \ xterm.o xselect.o sound.o: macgui.h
--- a/src/abbrev.c Sat Oct 27 22:15:27 2007 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,803 +0,0 @@ -/* Primitives for word-abbrev mode. - Copyright (C) 1985, 1986, 1993, 1996, 1998, 2001, 2002, 2003, 2004, - 2005, 2006, 2007 Free Software Foundation, Inc. - -This file is part of GNU Emacs. - -GNU Emacs is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Emacs is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -You should have received a copy of the GNU General Public License -along with GNU Emacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -Boston, MA 02110-1301, USA. */ - - -#include <config.h> -#include <stdio.h> - -#include "lisp.h" -#include "commands.h" -#include "buffer.h" -#include "window.h" -#include "charset.h" -#include "syntax.h" - -/* An abbrev table is an obarray. - Each defined abbrev is represented by a symbol in that obarray - whose print name is the abbreviation. - The symbol's value is a string which is the expansion. - If its function definition is non-nil, it is called - after the expansion is done. - The plist slot of the abbrev symbol is its usage count. */ - -/* List of all abbrev-table name symbols: - symbols whose values are abbrev tables. */ - -Lisp_Object Vabbrev_table_name_list; - -/* The table of global abbrevs. These are in effect - in any buffer in which abbrev mode is turned on. */ - -Lisp_Object Vglobal_abbrev_table; - -/* The local abbrev table used by default (in Fundamental Mode buffers) */ - -Lisp_Object Vfundamental_mode_abbrev_table; - -/* Set nonzero when an abbrev definition is changed */ - -int abbrevs_changed; - -int abbrev_all_caps; - -/* Non-nil => use this location as the start of abbrev to expand - (rather than taking the word before point as the abbrev) */ - -Lisp_Object Vabbrev_start_location; - -/* Buffer that Vabbrev_start_location applies to */ -Lisp_Object Vabbrev_start_location_buffer; - -/* The symbol representing the abbrev most recently expanded */ - -Lisp_Object Vlast_abbrev; - -/* A string for the actual text of the abbrev most recently expanded. - This has more info than Vlast_abbrev since case is significant. */ - -Lisp_Object Vlast_abbrev_text; - -/* Character address of start of last abbrev expanded */ - -EMACS_INT last_abbrev_point; - -/* Hook to run before expanding any abbrev. */ - -Lisp_Object Vpre_abbrev_expand_hook, Qpre_abbrev_expand_hook; - -Lisp_Object Qsystem_type, Qcount, Qforce; - -DEFUN ("make-abbrev-table", Fmake_abbrev_table, Smake_abbrev_table, 0, 0, 0, - doc: /* Create a new, empty abbrev table object. */) - () -{ - /* The value 59 is arbitrary chosen prime number. */ - return Fmake_vector (make_number (59), make_number (0)); -} - -DEFUN ("clear-abbrev-table", Fclear_abbrev_table, Sclear_abbrev_table, 1, 1, 0, - doc: /* Undefine all abbrevs in abbrev table TABLE, leaving it empty. */) - (table) - Lisp_Object table; -{ - int i, size; - - CHECK_VECTOR (table); - size = XVECTOR (table)->size; - abbrevs_changed = 1; - for (i = 0; i < size; i++) - XVECTOR (table)->contents[i] = make_number (0); - return Qnil; -} - -DEFUN ("define-abbrev", Fdefine_abbrev, Sdefine_abbrev, 3, 6, 0, - doc: /* Define an abbrev in TABLE named NAME, to expand to EXPANSION and call HOOK. -NAME must be a string, and should be lower-case. -EXPANSION should usually be a string. -To undefine an abbrev, define it with EXPANSION = nil. -If HOOK is non-nil, it should be a function of no arguments; -it is called after EXPANSION is inserted. -If EXPANSION is not a string, the abbrev is a special one, - which does not expand in the usual way but only runs HOOK. - -COUNT, if specified, gives the initial value for the abbrev's -usage-count, which is incremented each time the abbrev is used. -\(The default is zero.) - -SYSTEM-FLAG, if non-nil, says that this is a "system" abbreviation -which should not be saved in the user's abbreviation file. -Unless SYSTEM-FLAG is `force', a system abbreviation will not -overwrite a non-system abbreviation of the same name. */) - (table, name, expansion, hook, count, system_flag) - Lisp_Object table, name, expansion, hook, count, system_flag; -{ - Lisp_Object sym, oexp, ohook, tem; - CHECK_VECTOR (table); - CHECK_STRING (name); - - /* If defining a system abbrev, do not overwrite a non-system abbrev - of the same name, unless 'force is used. */ - if (!NILP (system_flag) && !EQ (system_flag, Qforce)) - { - sym = Fintern_soft (name, table); - - if (!NILP (SYMBOL_VALUE (sym)) && - NILP (Fplist_get (XSYMBOL (sym)->plist, Qsystem_type))) return Qnil; - } - - if (NILP (count)) - count = make_number (0); - else - CHECK_NUMBER (count); - - sym = Fintern (name, table); - - oexp = SYMBOL_VALUE (sym); - ohook = XSYMBOL (sym)->function; - if (!((EQ (oexp, expansion) - || (STRINGP (oexp) && STRINGP (expansion) - && (tem = Fstring_equal (oexp, expansion), !NILP (tem)))) - && - (EQ (ohook, hook) - || (tem = Fequal (ohook, hook), !NILP (tem)))) - && NILP (system_flag)) - abbrevs_changed = 1; - - Fset (sym, expansion); - Ffset (sym, hook); - - if (! NILP (system_flag)) - Fsetplist (sym, list4 (Qcount, count, Qsystem_type, system_flag)); - else - Fsetplist (sym, count); - - return name; -} - -/* Check if the characters in ABBREV have word syntax in either the - * current (if global == 0) or standard syntax table. */ -static void -abbrev_check_chars (abbrev, global) - Lisp_Object abbrev; - int global; -{ - int i, i_byte, len, nbad = 0; - int j, found, nuniq = 0; - char *badchars, *baduniq; - - CHECK_STRING (abbrev); - len = SCHARS (abbrev); - - badchars = (char *) alloca (len + 1); - - for (i = 0, i_byte = 0; i < len; ) - { - int c; - - FETCH_STRING_CHAR_ADVANCE (c, abbrev, i, i_byte); - - if (global) - { - /* Copied from SYNTAX in syntax.h, except using FOLLOW_PARENT. */ - Lisp_Object syntax_temp - = SYNTAX_ENTRY_FOLLOW_PARENT (Vstandard_syntax_table, c); - if ( (CONSP (syntax_temp) - ? (enum syntaxcode) (XINT (XCAR (syntax_temp)) & 0xff) - : Swhitespace) != Sword ) badchars[nbad++] = c; - } - else if (SYNTAX (c) != Sword) - badchars[nbad++] = c; - } - - if (nbad == 0) return; - - baduniq = (char *) alloca (nbad + 1); - - for (i = 0; i < nbad; i++) - { - found = 0; - - for (j = 0; j < nuniq; j++) - { - if (badchars[i] == baduniq[j]) - { - found = 1; - break; - } - } - - if (found) continue ; - - baduniq[nuniq++] = badchars[i]; - } - - baduniq[nuniq] = '\0'; - - error ("Some abbrev characters (%s) are not word constituents %s", - baduniq, global ? "in the standard syntax" : "in this mode" ); -} - -DEFUN ("define-global-abbrev", Fdefine_global_abbrev, Sdefine_global_abbrev, 2, 2, - "sDefine global abbrev: \nsExpansion for %s: ", - doc: /* Define ABBREV as a global abbreviation for EXPANSION. -The characters in ABBREV must all be word constituents in the standard -syntax table. */) - (abbrev, expansion) - Lisp_Object abbrev, expansion; -{ - abbrev_check_chars (abbrev, 1); - - Fdefine_abbrev (Vglobal_abbrev_table, Fdowncase (abbrev), - expansion, Qnil, make_number (0), Qnil); - return abbrev; -} - -DEFUN ("define-mode-abbrev", Fdefine_mode_abbrev, Sdefine_mode_abbrev, 2, 2, - "sDefine mode abbrev: \nsExpansion for %s: ", - doc: /* Define ABBREV as a mode-specific abbreviation for EXPANSION. -The characters in ABBREV must all be word-constituents in the current mode. */) - (abbrev, expansion) - Lisp_Object abbrev, expansion; -{ - if (NILP (current_buffer->abbrev_table)) - error ("Major mode has no abbrev table"); - - abbrev_check_chars (abbrev, 0); - - Fdefine_abbrev (current_buffer->abbrev_table, Fdowncase (abbrev), - expansion, Qnil, make_number (0), Qnil); - return abbrev; -} - -DEFUN ("abbrev-symbol", Fabbrev_symbol, Sabbrev_symbol, 1, 2, 0, - doc: /* Return the symbol representing abbrev named ABBREV. -This symbol's name is ABBREV, but it is not the canonical symbol of that name; -it is interned in an abbrev-table rather than the normal obarray. -The value is nil if that abbrev is not defined. -Optional second arg TABLE is abbrev table to look it up in. -The default is to try buffer's mode-specific abbrev table, then global table. */) - (abbrev, table) - Lisp_Object abbrev, table; -{ - Lisp_Object sym; - CHECK_STRING (abbrev); - if (!NILP (table)) - sym = Fintern_soft (abbrev, table); - else - { - sym = Qnil; - if (!NILP (current_buffer->abbrev_table)) - sym = Fintern_soft (abbrev, current_buffer->abbrev_table); - if (NILP (SYMBOL_VALUE (sym))) - sym = Qnil; - if (NILP (sym)) - sym = Fintern_soft (abbrev, Vglobal_abbrev_table); - } - if (NILP (SYMBOL_VALUE (sym))) - return Qnil; - return sym; -} - -DEFUN ("abbrev-expansion", Fabbrev_expansion, Sabbrev_expansion, 1, 2, 0, - doc: /* Return the string that ABBREV expands into in the current buffer. -Optionally specify an abbrev table as second arg; -then ABBREV is looked up in that table only. */) - (abbrev, table) - Lisp_Object abbrev, table; -{ - Lisp_Object sym; - sym = Fabbrev_symbol (abbrev, table); - if (NILP (sym)) return sym; - return Fsymbol_value (sym); -} - -/* Expand the word before point, if it is an abbrev. - Returns 1 if an expansion is done. */ - -DEFUN ("expand-abbrev", Fexpand_abbrev, Sexpand_abbrev, 0, 0, "", - doc: /* Expand the abbrev before point, if there is an abbrev there. -Effective when explicitly called even when `abbrev-mode' is nil. -Returns the abbrev symbol, if expansion took place. */) - () -{ - register char *buffer, *p; - int wordstart, wordend; - register int wordstart_byte, wordend_byte, idx, idx_byte; - int whitecnt; - int uccount = 0, lccount = 0; - register Lisp_Object sym; - Lisp_Object expansion, hook, tem; - Lisp_Object value; - int multibyte = ! NILP (current_buffer->enable_multibyte_characters); - - value = Qnil; - - Frun_hooks (1, &Qpre_abbrev_expand_hook); - - wordstart = 0; - if (!(BUFFERP (Vabbrev_start_location_buffer) - && XBUFFER (Vabbrev_start_location_buffer) == current_buffer)) - Vabbrev_start_location = Qnil; - if (!NILP (Vabbrev_start_location)) - { - tem = Vabbrev_start_location; - CHECK_NUMBER_COERCE_MARKER (tem); - wordstart = XINT (tem); - Vabbrev_start_location = Qnil; - if (wordstart < BEGV || wordstart > ZV) - wordstart = 0; - if (wordstart && wordstart != ZV) - { - wordstart_byte = CHAR_TO_BYTE (wordstart); - if (FETCH_BYTE (wordstart_byte) == '-') - del_range (wordstart, wordstart + 1); - } - } - if (!wordstart) - wordstart = scan_words (PT, -1); - - if (!wordstart) - return value; - - wordstart_byte = CHAR_TO_BYTE (wordstart); - wordend = scan_words (wordstart, 1); - if (!wordend) - return value; - - if (wordend > PT) - wordend = PT; - - wordend_byte = CHAR_TO_BYTE (wordend); - whitecnt = PT - wordend; - if (wordend <= wordstart) - return value; - - p = buffer = (char *) alloca (wordend_byte - wordstart_byte); - - for (idx = wordstart, idx_byte = wordstart_byte; idx < wordend; ) - { - register int c; - - if (multibyte) - { - FETCH_CHAR_ADVANCE (c, idx, idx_byte); - } - else - { - c = FETCH_BYTE (idx_byte); - idx++, idx_byte++; - } - - if (UPPERCASEP (c)) - c = DOWNCASE (c), uccount++; - else if (! NOCASEP (c)) - lccount++; - if (multibyte) - p += CHAR_STRING (c, p); - else - *p++ = c; - } - - if (VECTORP (current_buffer->abbrev_table)) - sym = oblookup (current_buffer->abbrev_table, buffer, - wordend - wordstart, p - buffer); - else - XSETFASTINT (sym, 0); - - if (INTEGERP (sym) || NILP (SYMBOL_VALUE (sym))) - sym = oblookup (Vglobal_abbrev_table, buffer, - wordend - wordstart, p - buffer); - if (INTEGERP (sym) || NILP (SYMBOL_VALUE (sym))) - return value; - - if (INTERACTIVE && !EQ (minibuf_window, selected_window)) - { - /* Add an undo boundary, in case we are doing this for - a self-inserting command which has avoided making one so far. */ - SET_PT (wordend); - Fundo_boundary (); - } - - Vlast_abbrev_text - = Fbuffer_substring (make_number (wordstart), make_number (wordend)); - - /* Now sym is the abbrev symbol. */ - Vlast_abbrev = sym; - value = sym; - last_abbrev_point = wordstart; - - /* Increment use count. */ - if (INTEGERP (XSYMBOL (sym)->plist)) - XSETINT (XSYMBOL (sym)->plist, - XINT (XSYMBOL (sym)->plist) + 1); - else if (INTEGERP (tem = Fget (sym, Qcount))) - Fput (sym, Qcount, make_number (XINT (tem) + 1)); - - /* If this abbrev has an expansion, delete the abbrev - and insert the expansion. */ - expansion = SYMBOL_VALUE (sym); - if (STRINGP (expansion)) - { - SET_PT (wordstart); - - insert_from_string (expansion, 0, 0, SCHARS (expansion), - SBYTES (expansion), 1); - del_range_both (PT, PT_BYTE, - wordend + (PT - wordstart), - wordend_byte + (PT_BYTE - wordstart_byte), - 1); - - SET_PT (PT + whitecnt); - - if (uccount && !lccount) - { - /* Abbrev was all caps */ - /* If expansion is multiple words, normally capitalize each word */ - /* This used to be if (!... && ... >= ...) Fcapitalize; else Fupcase - but Megatest 68000 compiler can't handle that */ - if (!abbrev_all_caps) - if (scan_words (PT, -1) > scan_words (wordstart, 1)) - { - Fupcase_initials_region (make_number (wordstart), - make_number (PT)); - goto caped; - } - /* If expansion is one word, or if user says so, upcase it all. */ - Fupcase_region (make_number (wordstart), make_number (PT)); - caped: ; - } - else if (uccount) - { - /* Abbrev included some caps. Cap first initial of expansion */ - int pos = wordstart_byte; - - /* Find the initial. */ - while (pos < PT_BYTE - && SYNTAX (*BUF_BYTE_ADDRESS (current_buffer, pos)) != Sword) - pos++; - - /* Change just that. */ - pos = BYTE_TO_CHAR (pos); - Fupcase_initials_region (make_number (pos), make_number (pos + 1)); - } - } - - hook = XSYMBOL (sym)->function; - if (!NILP (hook)) - { - Lisp_Object expanded, prop; - - /* If the abbrev has a hook function, run it. */ - expanded = call0 (hook); - - /* In addition, if the hook function is a symbol with - a non-nil `no-self-insert' property, let the value it returned - specify whether we consider that an expansion took place. If - it returns nil, no expansion has been done. */ - - if (SYMBOLP (hook) - && NILP (expanded) - && (prop = Fget (hook, intern ("no-self-insert")), - !NILP (prop))) - value = Qnil; - } - - return value; -} - -DEFUN ("unexpand-abbrev", Funexpand_abbrev, Sunexpand_abbrev, 0, 0, "", - doc: /* Undo the expansion of the last abbrev that expanded. -This differs from ordinary undo in that other editing done since then -is not undone. */) - () -{ - int opoint = PT; - int adjust = 0; - if (last_abbrev_point < BEGV - || last_abbrev_point > ZV) - return Qnil; - SET_PT (last_abbrev_point); - if (STRINGP (Vlast_abbrev_text)) - { - /* This isn't correct if Vlast_abbrev->function was used - to do the expansion */ - Lisp_Object val; - int zv_before; - - val = SYMBOL_VALUE (Vlast_abbrev); - if (!STRINGP (val)) - error ("Value of `abbrev-symbol' must be a string"); - zv_before = ZV; - del_range_byte (PT_BYTE, PT_BYTE + SBYTES (val), 1); - /* Don't inherit properties here; just copy from old contents. */ - insert_from_string (Vlast_abbrev_text, 0, 0, - SCHARS (Vlast_abbrev_text), - SBYTES (Vlast_abbrev_text), 0); - Vlast_abbrev_text = Qnil; - /* Total number of characters deleted. */ - adjust = ZV - zv_before; - } - SET_PT (last_abbrev_point < opoint ? opoint + adjust : opoint); - return Qnil; -} - -static void -write_abbrev (sym, stream) - Lisp_Object sym, stream; -{ - Lisp_Object name, count, system_flag; - - if (INTEGERP (XSYMBOL (sym)->plist)) - { - count = XSYMBOL (sym)->plist; - system_flag = Qnil; - } - else - { - count = Fget (sym, Qcount); - system_flag = Fget (sym, Qsystem_type); - } - - if (NILP (SYMBOL_VALUE (sym)) || ! NILP (system_flag)) - return; - - insert (" (", 5); - name = SYMBOL_NAME (sym); - Fprin1 (name, stream); - insert (" ", 1); - Fprin1 (SYMBOL_VALUE (sym), stream); - insert (" ", 1); - Fprin1 (XSYMBOL (sym)->function, stream); - insert (" ", 1); - Fprin1 (count, stream); - insert (")\n", 2); -} - -static void -describe_abbrev (sym, stream) - Lisp_Object sym, stream; -{ - Lisp_Object one, count, system_flag; - - if (INTEGERP (XSYMBOL (sym)->plist)) - { - count = XSYMBOL (sym)->plist; - system_flag = Qnil; - } - else - { - count = Fget (sym, Qcount); - system_flag = Fget (sym, Qsystem_type); - } - - if (NILP (SYMBOL_VALUE (sym))) - return; - - one = make_number (1); - Fprin1 (Fsymbol_name (sym), stream); - - if (!NILP (system_flag)) - { - insert_string (" (sys)"); - Findent_to (make_number (20), one); - } - else - Findent_to (make_number (15), one); - - Fprin1 (count, stream); - Findent_to (make_number (20), one); - Fprin1 (SYMBOL_VALUE (sym), stream); - if (!NILP (XSYMBOL (sym)->function)) - { - Findent_to (make_number (45), one); - Fprin1 (XSYMBOL (sym)->function, stream); - } - Fterpri (stream); -} - -static void -record_symbol (sym, list) - Lisp_Object sym, list; -{ - XSETCDR (list, Fcons (sym, XCDR (list))); -} - -DEFUN ("insert-abbrev-table-description", Finsert_abbrev_table_description, - Sinsert_abbrev_table_description, 1, 2, 0, - doc: /* Insert before point a full description of abbrev table named NAME. -NAME is a symbol whose value is an abbrev table. -If optional 2nd arg READABLE is non-nil, a human-readable description -is inserted. Otherwise the description is an expression, -a call to `define-abbrev-table', which would -define the abbrev table NAME exactly as it is currently defined. - -Abbrevs marked as "system abbrevs" are normally omitted. However, if -READABLE is non-nil, they are listed. */) - (name, readable) - Lisp_Object name, readable; -{ - Lisp_Object table; - Lisp_Object symbols; - Lisp_Object stream; - - CHECK_SYMBOL (name); - table = Fsymbol_value (name); - CHECK_VECTOR (table); - - XSETBUFFER (stream, current_buffer); - - symbols = Fcons (Qnil, Qnil); - map_obarray (table, record_symbol, symbols); - symbols = XCDR (symbols); - symbols = Fsort (symbols, Qstring_lessp); - - if (!NILP (readable)) - { - insert_string ("("); - Fprin1 (name, stream); - insert_string (")\n\n"); - while (! NILP (symbols)) - { - describe_abbrev (XCAR (symbols), stream); - symbols = XCDR (symbols); - } - - insert_string ("\n\n"); - } - else - { - insert_string ("(define-abbrev-table '"); - Fprin1 (name, stream); - insert_string (" '(\n"); - while (! NILP (symbols)) - { - write_abbrev (XCAR (symbols), stream); - symbols = XCDR (symbols); - } - insert_string (" ))\n\n"); - } - - return Qnil; -} - -DEFUN ("define-abbrev-table", Fdefine_abbrev_table, Sdefine_abbrev_table, - 2, 2, 0, - doc: /* Define TABLENAME (a symbol) as an abbrev table name. -Define abbrevs in it according to DEFINITIONS, which is a list of elements -of the form (ABBREVNAME EXPANSION HOOK USECOUNT SYSTEMFLAG). -\(If the list is shorter than that, omitted elements default to nil). */) - (tablename, definitions) - Lisp_Object tablename, definitions; -{ - Lisp_Object name, exp, hook, count; - Lisp_Object table, elt, sys; - - CHECK_SYMBOL (tablename); - table = Fboundp (tablename); - if (NILP (table) || (table = Fsymbol_value (tablename), NILP (table))) - { - table = Fmake_abbrev_table (); - Fset (tablename, table); - Vabbrev_table_name_list = Fcons (tablename, Vabbrev_table_name_list); - } - CHECK_VECTOR (table); - - for (; CONSP (definitions); definitions = XCDR (definitions)) - { - elt = XCAR (definitions); - name = Fcar (elt); elt = Fcdr (elt); - exp = Fcar (elt); elt = Fcdr (elt); - hook = Fcar (elt); elt = Fcdr (elt); - count = Fcar (elt); elt = Fcdr (elt); - sys = Fcar (elt); - Fdefine_abbrev (table, name, exp, hook, count, sys); - } - return Qnil; -} - -void -syms_of_abbrev () -{ - Qsystem_type = intern ("system-type"); - staticpro (&Qsystem_type); - - Qcount = intern ("count"); - staticpro (&Qcount); - - Qforce = intern ("force"); - staticpro (&Qforce); - - DEFVAR_LISP ("abbrev-table-name-list", &Vabbrev_table_name_list, - doc: /* List of symbols whose values are abbrev tables. */); - Vabbrev_table_name_list = Fcons (intern ("fundamental-mode-abbrev-table"), - Fcons (intern ("global-abbrev-table"), - Qnil)); - - DEFVAR_LISP ("global-abbrev-table", &Vglobal_abbrev_table, - doc: /* The abbrev table whose abbrevs affect all buffers. -Each buffer may also have a local abbrev table. -If it does, the local table overrides the global one -for any particular abbrev defined in both. */); - Vglobal_abbrev_table = Fmake_abbrev_table (); - - DEFVAR_LISP ("fundamental-mode-abbrev-table", &Vfundamental_mode_abbrev_table, - doc: /* The abbrev table of mode-specific abbrevs for Fundamental Mode. */); - Vfundamental_mode_abbrev_table = Fmake_abbrev_table (); - current_buffer->abbrev_table = Vfundamental_mode_abbrev_table; - buffer_defaults.abbrev_table = Vfundamental_mode_abbrev_table; - - DEFVAR_LISP ("last-abbrev", &Vlast_abbrev, - doc: /* The abbrev-symbol of the last abbrev expanded. See `abbrev-symbol'. */); - - DEFVAR_LISP ("last-abbrev-text", &Vlast_abbrev_text, - doc: /* The exact text of the last abbrev expanded. -A value of nil means the abbrev has already been unexpanded. */); - - DEFVAR_INT ("last-abbrev-location", &last_abbrev_point, - doc: /* The location of the start of the last abbrev expanded. */); - - Vlast_abbrev = Qnil; - Vlast_abbrev_text = Qnil; - last_abbrev_point = 0; - - DEFVAR_LISP ("abbrev-start-location", &Vabbrev_start_location, - doc: /* Buffer position for `expand-abbrev' to use as the start of the abbrev. -When nil, use the word before point as the abbrev. -Calling `expand-abbrev' sets this to nil. */); - Vabbrev_start_location = Qnil; - - DEFVAR_LISP ("abbrev-start-location-buffer", &Vabbrev_start_location_buffer, - doc: /* Buffer that `abbrev-start-location' has been set for. -Trying to expand an abbrev in any other buffer clears `abbrev-start-location'. */); - Vabbrev_start_location_buffer = Qnil; - - DEFVAR_BOOL ("abbrevs-changed", &abbrevs_changed, - doc: /* Set non-nil by defining or altering any word abbrevs. -This causes `save-some-buffers' to offer to save the abbrevs. */); - abbrevs_changed = 0; - - DEFVAR_BOOL ("abbrev-all-caps", &abbrev_all_caps, - doc: /* *Set non-nil means expand multi-word abbrevs all caps if abbrev was so. */); - abbrev_all_caps = 0; - - DEFVAR_LISP ("pre-abbrev-expand-hook", &Vpre_abbrev_expand_hook, - doc: /* Function or functions to be called before abbrev expansion is done. -This is the first thing that `expand-abbrev' does, and so this may change -the current abbrev table before abbrev lookup happens. */); - Vpre_abbrev_expand_hook = Qnil; - Qpre_abbrev_expand_hook = intern ("pre-abbrev-expand-hook"); - staticpro (&Qpre_abbrev_expand_hook); - - defsubr (&Smake_abbrev_table); - defsubr (&Sclear_abbrev_table); - defsubr (&Sdefine_abbrev); - defsubr (&Sdefine_global_abbrev); - defsubr (&Sdefine_mode_abbrev); - defsubr (&Sabbrev_expansion); - defsubr (&Sabbrev_symbol); - defsubr (&Sexpand_abbrev); - defsubr (&Sunexpand_abbrev); - defsubr (&Sinsert_abbrev_table_description); - defsubr (&Sdefine_abbrev_table); -} - -/* arch-tag: b721db69-f633-44a8-a361-c275acbdad7d - (do not change this comment) */
--- a/src/emacs.c Sat Oct 27 22:15:27 2007 +0000 +++ b/src/emacs.c Sun Oct 28 02:41:00 2007 +0000 @@ -1543,7 +1543,6 @@ syms_of_fns (); syms_of_floatfns (); - syms_of_abbrev (); syms_of_buffer (); syms_of_bytecode (); syms_of_callint ();
--- a/src/image.c Sat Oct 27 22:15:27 2007 +0000 +++ b/src/image.c Sun Oct 28 02:41:00 2007 +0000 @@ -733,9 +733,9 @@ /* Keywords. */ extern Lisp_Object QCwidth, QCheight, QCforeground, QCbackground, QCfile; -extern Lisp_Object QCdata, QCtype, Qcount; +extern Lisp_Object QCdata, QCtype; extern Lisp_Object Qcenter; -Lisp_Object QCascent, QCmargin, QCrelief; +Lisp_Object QCascent, QCmargin, QCrelief, Qcount; Lisp_Object QCconversion, QCcolor_symbols, QCheuristic_mask; Lisp_Object QCindex, QCmatrix, QCcolor_adjustment, QCmask; @@ -9089,6 +9089,9 @@ define_image_type (&xbm_type, 1); define_image_type (&pbm_type, 1); + Qcount = intern ("count"); + staticpro (&Qcount); + QCascent = intern (":ascent"); staticpro (&QCascent); QCmargin = intern (":margin");
--- a/src/puresize.h Sat Oct 27 22:15:27 2007 +0000 +++ b/src/puresize.h Sun Oct 28 02:41:00 2007 +0000 @@ -43,7 +43,7 @@ #endif #ifndef BASE_PURESIZE -#define BASE_PURESIZE (1170000 + SYSTEM_PURESIZE_EXTRA + SITELOAD_PURESIZE_EXTRA) +#define BASE_PURESIZE (1180000 + SYSTEM_PURESIZE_EXTRA + SITELOAD_PURESIZE_EXTRA) #endif /* Increase BASE_PURESIZE by a ratio depending on the machine's word size. */