* 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".
* 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
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
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
@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
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
@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
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
@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
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
\f
* 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,
+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.
;; 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
(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
: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"
;;; 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
(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")
(if (eq system-type 'vax-vms)
(progn
(load "vmsproc")))
-(load "abbrev")
(load "buff-menu")
(if (fboundp 'x-create-frame)
+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.
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 \
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)
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
+++ /dev/null
-/* 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;
-\f
-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);
-}
-\f
-/* 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;
-}
-\f
-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;
-}
-\f
-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;
-}
-\f
-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) */
syms_of_fns ();
syms_of_floatfns ();
- syms_of_abbrev ();
syms_of_buffer ();
syms_of_bytecode ();
syms_of_callint ();
/* 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;
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");
#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. */
projects / emacs.git / commitdiff