aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2007-10-28 02:41:00 +0000
committerStefan Monnier2007-10-28 02:41:00 +0000
commite047f448837314fb158e0571813e79fbac677cc7 (patch)
treee14390dd2f4cb89d066b1dd1decef1d57cae8942
parenta034393c29917271c100c3d55dff2a23ffcffeb4 (diff)
downloademacs-e047f448837314fb158e0571813e79fbac677cc7.tar.gz
emacs-e047f448837314fb158e0571813e79fbac677cc7.zip
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".
-rw-r--r--doc/lispref/abbrevs.texi206
-rw-r--r--etc/NEWS14
-rw-r--r--lisp/ChangeLog23
-rw-r--r--lisp/abbrev.el534
-rw-r--r--lisp/cus-edit.el5
-rw-r--r--lisp/cus-start.el5
-rw-r--r--lisp/loadup.el2
-rw-r--r--src/ChangeLog11
-rw-r--r--src/Makefile.in6
-rw-r--r--src/abbrev.c803
-rw-r--r--src/emacs.c1
-rw-r--r--src/image.c7
-rw-r--r--src/puresize.h2
13 files changed, 746 insertions, 873 deletions
diff --git a/doc/lispref/abbrevs.texi b/doc/lispref/abbrevs.texi
index a52ba2c6c86..9ccafe2de24 100644
--- a/doc/lispref/abbrevs.texi
+++ b/doc/lispref/abbrevs.texi
@@ -47,6 +47,10 @@ Mode, emacs, The GNU Emacs Manual}.
47* Files: Abbrev Files. Saving abbrevs in files. 47* Files: Abbrev Files. Saving abbrevs in files.
48* Expansion: Abbrev Expansion. Controlling expansion; expansion subroutines. 48* Expansion: Abbrev Expansion. Controlling expansion; expansion subroutines.
49* Standard Abbrev Tables:: Abbrev tables used by various major modes. 49* Standard Abbrev Tables:: Abbrev tables used by various major modes.
50* Abbrev Properties:: How to read and set abbrev properties.
51 Which properties have which effect.
52* Abbrev Table Properties:: How to read and set abbrev table properties.
53 Which properties have which effect.
50@end menu 54@end menu
51 55
52@node Abbrev Mode, Abbrev Tables, Abbrevs, Abbrevs 56@node Abbrev Mode, Abbrev Tables, Abbrevs, Abbrevs
@@ -75,9 +79,14 @@ This is the same as @code{(default-value 'abbrev-mode)}.
75 79
76 This section describes how to create and manipulate abbrev tables. 80 This section describes how to create and manipulate abbrev tables.
77 81
78@defun make-abbrev-table 82@defun make-abbrev-table &rest props
79This function creates and returns a new, empty abbrev table---an obarray 83This function creates and returns a new, empty abbrev table---an obarray
80containing no symbols. It is a vector filled with zeros. 84containing no symbols. It is a vector filled with zeros. @var{props}
85is a property list that is applied to the new table.
86@end defun
87
88@defun abbrev-table-p table
89Return non-@code{nil} is @var{table} is an abbrev table.
81@end defun 90@end defun
82 91
83@defun clear-abbrev-table table 92@defun clear-abbrev-table table
@@ -92,15 +101,18 @@ difference between @var{table} and the returned copy is that this
92function sets the property lists of all copied abbrevs to 0. 101function sets the property lists of all copied abbrevs to 0.
93@end defun 102@end defun
94 103
95@defun define-abbrev-table tabname definitions 104@defun define-abbrev-table tabname definitions &optional docstring &rest props
96This function defines @var{tabname} (a symbol) as an abbrev table 105This function defines @var{tabname} (a symbol) as an abbrev table
97name, i.e., as a variable whose value is an abbrev table. It defines 106name, i.e., as a variable whose value is an abbrev table. It defines
98abbrevs in the table according to @var{definitions}, a list of 107abbrevs in the table according to @var{definitions}, a list of
99elements of the form @code{(@var{abbrevname} @var{expansion} 108elements of the form @code{(@var{abbrevname} @var{expansion}
100@var{hook} @var{usecount} @var{system-flag})}. If an element of 109[@var{hook}] [@var{props}...])}. These elements are passed as
101@var{definitions} has length less than five, omitted elements default 110arguments to @code{define-abbrev}. The return value is always
102to @code{nil}. A value of @code{nil} for @var{usecount} is equivalent 111@code{nil}.
103to zero. The return value is always @code{nil}. 112
113The optional string @var{docstring} is the documentation string of the
114variable @var{tabname}. The property list @var{props} is applied to
115the abbrev table (@pxref{Abbrev Table Properties}).
104 116
105If this function is called more than once for the same @var{tabname}, 117If this function is called more than once for the same @var{tabname},
106subsequent calls add the definitions in @var{definitions} to 118subsequent calls add the definitions in @var{definitions} to
@@ -132,20 +144,17 @@ to add these to @var{name} separately.)
132@section Defining Abbrevs 144@section Defining Abbrevs
133 @code{define-abbrev} is the low-level basic function for defining an 145 @code{define-abbrev} is the low-level basic function for defining an
134abbrev in a specified abbrev table. When major modes predefine standard 146abbrev in a specified abbrev table. When major modes predefine standard
135abbrevs, they should call @code{define-abbrev} and specify @code{t} for 147abbrevs, they should call @code{define-abbrev} and specify a @code{t} for
136@var{system-flag}. Be aware that any saved non-``system'' abbrevs are 148the @code{system-flag} property.
149Be aware that any saved non-``system'' abbrevs are
137restored at startup, i.e. before some major modes are loaded. Major modes 150restored at startup, i.e. before some major modes are loaded. Major modes
138should therefore not assume that when they are first loaded their abbrev 151should therefore not assume that when they are first loaded their abbrev
139tables are empty. 152tables are empty.
140 153
141@defun define-abbrev table name expansion &optional hook count system-flag 154@defun define-abbrev table name expansion &optional hook &rest props
142This function defines an abbrev named @var{name}, in @var{table}, to 155This function defines an abbrev named @var{name}, in @var{table}, to
143expand to @var{expansion} and call @var{hook}. The return value is 156expand to @var{expansion} and call @var{hook}, with properties
144@var{name}. 157@var{props} (@pxref{Abbrev Properties}). The return value is @var{name}.
145
146The value of @var{count}, if specified, initializes the abbrev's
147usage-count. If @var{count} is not specified or @code{nil}, the use
148count is initialized to zero.
149 158
150The argument @var{name} should be a string. The argument 159The argument @var{name} should be a string. The argument
151@var{expansion} is normally the desired expansion (a string), or 160@var{expansion} is normally the desired expansion (a string), or
@@ -167,12 +176,6 @@ inhibits insertion of the character. By contrast, if @var{hook}
167returns @code{nil}, @code{expand-abbrev} also returns @code{nil}, as 176returns @code{nil}, @code{expand-abbrev} also returns @code{nil}, as
168if expansion had not really occurred. 177if expansion had not really occurred.
169 178
170If @var{system-flag} is non-@code{nil}, that marks the abbrev as a
171``system'' abbrev with the @code{system-type} property. Unless
172@var{system-flag} has the value @code{force}, a ``system'' abbrev will
173not overwrite an existing definition for a non-``system'' abbrev of the
174same name.
175
176Normally the function @code{define-abbrev} sets the variable 179Normally the function @code{define-abbrev} sets the variable
177@code{abbrevs-changed} to @code{t}, if it actually changes the abbrev. 180@code{abbrevs-changed} to @code{t}, if it actually changes the abbrev.
178(This is so that some commands will offer to save the abbrevs.) It 181(This is so that some commands will offer to save the abbrevs.) It
@@ -329,20 +332,19 @@ has already been unexpanded. This contains information left by
329@code{expand-abbrev} for the sake of the @code{unexpand-abbrev} command. 332@code{expand-abbrev} for the sake of the @code{unexpand-abbrev} command.
330@end defvar 333@end defvar
331 334
332@c Emacs 19 feature 335@defvar abbrev-expand-functions
333@defvar pre-abbrev-expand-hook 336This is a special hook run @emph{around} the @code{expand-abbrev}
334This is a normal hook whose functions are executed, in sequence, just 337function. Functions on this hook are called with a single argument
335before any expansion of an abbrev. @xref{Hooks}. Since it is a normal 338which is a function that performs the normal abbrev expansion.
336hook, the hook functions receive no arguments. However, they can find 339The hook function can hence do anything it wants before and after
337the abbrev to be expanded by looking in the buffer before point. 340performing the expansion. It can also choose not to call its argument
338Running the hook is the first thing that @code{expand-abbrev} does, and 341and thus override the default behavior, or it may even call it
339so a hook function can be used to change the current abbrev table before 342several times. The function should return the abbrev symbol if
340abbrev lookup happens. (Although you have to do this carefully. See 343expansion took place.
341the example below.)
342@end defvar 344@end defvar
343 345
344 The following sample code shows a simple use of 346 The following sample code shows a simple use of
345@code{pre-abbrev-expand-hook}. It assumes that @code{foo-mode} is a 347@code{abbrev-expand-functions}. It assumes that @code{foo-mode} is a
346mode for editing certain files in which lines that start with @samp{#} 348mode for editing certain files in which lines that start with @samp{#}
347are comments. You want to use Text mode abbrevs for those lines. The 349are comments. You want to use Text mode abbrevs for those lines. The
348regular local abbrev table, @code{foo-mode-abbrev-table} is 350regular local abbrev table, @code{foo-mode-abbrev-table} is
@@ -351,30 +353,22 @@ in your @file{.emacs} file. @xref{Standard Abbrev Tables}, for the
351definitions of @code{local-abbrev-table} and @code{text-mode-abbrev-table}. 353definitions of @code{local-abbrev-table} and @code{text-mode-abbrev-table}.
352 354
353@smallexample 355@smallexample
354(defun foo-mode-pre-abbrev-expand () 356(defun foo-mode-abbrev-expand-function (expand)
355 (when (save-excursion (forward-line 0) (eq (char-after) ?#)) 357 (if (not (save-excursion (forward-line 0) (eq (char-after) ?#)))
356 (let ((local-abbrev-table text-mode-abbrev-table) 358 ;; Performs normal expansion.
357 ;; Avoid infinite loop. 359 (funcall expand)
358 (pre-abbrev-expand-hook nil)) 360 ;; We're inside a comment: use the text-mode abbrevs.
359 (expand-abbrev)) 361 (let ((local-abbrev-table text-mode-abbrev-table))
360 ;; We have already called `expand-abbrev' in this hook. 362 (funcall expand))))
361 ;; Hence we want the "actual" call following this hook to be a no-op.
362 (setq abbrev-start-location (point-max)
363 abbrev-start-location-buffer (current-buffer))))
364 363
365(add-hook 'foo-mode-hook 364(add-hook 'foo-mode-hook
366 #'(lambda () 365 #'(lambda ()
367 (add-hook 'pre-abbrev-expand-hook 366 (add-hook 'abbrev-expand-functions
368 'foo-mode-pre-abbrev-expand 367 'foo-mode-abbrev-expand-function
369 nil t))) 368 nil t)))
370@end smallexample 369@end smallexample
371 370
372Note that @code{foo-mode-pre-abbrev-expand} just returns @code{nil} 371@node Standard Abbrev Tables, Abbrev Properties, Abbrev Expansion, Abbrevs
373without doing anything for lines not starting with @samp{#}. Hence
374abbrevs expand normally using @code{foo-mode-abbrev-table} as local
375abbrev table for such lines.
376
377@node Standard Abbrev Tables, , Abbrev Expansion, Abbrevs
378@comment node-name, next, previous, up 372@comment node-name, next, previous, up
379@section Standard Abbrev Tables 373@section Standard Abbrev Tables
380 374
@@ -390,7 +384,16 @@ global table.
390 384
391@defvar local-abbrev-table 385@defvar local-abbrev-table
392The value of this buffer-local variable is the (mode-specific) 386The value of this buffer-local variable is the (mode-specific)
393abbreviation table of the current buffer. 387abbreviation table of the current buffer. It can also be a list of
388such tables.
389@end defvar
390
391@defvar abbrev-minor-mode-table-alist
392The value of this variable is a list of elements of the form
393@code{(@var{mode} . @var{abbrev-table})} where @var{mode} is the name
394of a variable: if the variable is bound to a non-@code{nil} value,
395then the @var{abbrev-table} is active, otherwise it is ignored.
396@var{abbrev-table} can also be a list of abbrev tables.
394@end defvar 397@end defvar
395 398
396@defvar fundamental-mode-abbrev-table 399@defvar fundamental-mode-abbrev-table
@@ -406,6 +409,105 @@ This is the local abbrev table used in Text mode.
406This is the local abbrev table used in Lisp mode and Emacs Lisp mode. 409This is the local abbrev table used in Lisp mode and Emacs Lisp mode.
407@end defvar 410@end defvar
408 411
412@node Abbrev Properties, Abbrev Table Properties, Standard Abbrev Tables, Abbrevs
413@section Abbrev Properties
414
415Abbrevs have properties, some of which influence the way they work.
416They are usually set by providing the relevant arguments to
417@code{define-abbrev} and can be manipulated with the functions:
418
419@defun abbrev-put abbrev prop val
420Set the property @var{prop} of abbrev @var{abbrev} to value @var{val}.
421@end defun
422
423@defun abbrev-get abbrev prop
424Return the property @var{prop} of abbrev @var{abbrev}, or @code{nil}
425if the abbrev has no such property.
426@end defun
427
428The following properties have special meaning:
429
430@table @code
431@item count
432This property counts the number of times the abbrev has
433been expanded. If not explicitly set, it is initialized to 0 by
434@code{define-abbrev}.
435
436@item system-flag
437If non-@code{nil}, this property marks the abbrev as a ``system''
438abbrev. Such abbrevs will not be saved to @var{abbrev-file-name}.
439Also, unless @code{system-flag} has the value @code{force},
440a ``system'' abbrev will not overwrite an existing definition for
441a non-``system'' abbrev of the same name.
442
443@item :enable-function
444If non-@code{nil}, this property should be set to a function of no
445arguments which returns @code{nil} if the abbrev should not be used
446and @code{t} otherwise.
447
448@item :case-fixed
449If non-@code{nil}, this property indicates that the case of the
450abbrev's name is significant and should only match a text with the
451same capitalization. It also disables the code that modifies the
452capitalization of the expansion.
453
454@end table
455
456@node Abbrev Table Properties, , Abbrev Properties, Abbrevs
457@section Abbrev Table Properties
458
459Like abbrevs, abble tables have properties, some of which influence
460the way they work. They are usually set by providing the relevant
461arguments to @code{define-abbrev-table} and can be manipulated with
462the functions:
463
464@defun abbrev-table-put table prop val
465Set the property @var{prop} of abbrev table @var{table} to value @var{val}.
466@end defun
467
468@defun abbrev-table-get table prop
469Return the property @var{prop} of abbrev table @var{table}, or @code{nil}
470if the abbrev has no such property.
471@end defun
472
473The following properties have special meaning:
474
475@table @code
476@item :enable-function
477If non-@code{nil}, this property should be set to a function of no
478arguments which returns @code{nil} if the abbrev table should not be
479used and @code{t} otherwise. This is like the @code{:enable-function}
480abbrev property except that it applies to all abbrevs in the table and
481is used even before trying to find the abbrev before point.
482
483@item :case-fixed
484If non-@code{nil}, this property indicates that the case of the names
485is significant for all abbrevs in the table and should only match
486a text with the same capitalization. It also disables the code that
487modifies the capitalization of the expansion. This is like the
488@code{:case-fixed} abbrev property except that it applies to all
489abbrevs in the table.
490
491@item :regexp
492If non-@code{nil}, this property is a regular expression that
493indicates how to extract the name of the abbrev before point before
494looking it up in the table. When the regular expression matches
495before point, the abbrev name is expected to be in submatch 1.
496If this property is nil, @code{expand-function} defaults to
497@code{"\\<\\(\\w+\\)\\W"}. This property allows the use of abbrevs
498whose name contains characters of non-word syntax.
499
500@item :parents
501This property holds the list of tables from which to inherit
502other abbrevs.
503
504@item :abbrev-table-modiff
505This property holds a counter incremented each time a new abbrev is
506added to the table.
507
508@end table
509
510
409@ignore 511@ignore
410 arch-tag: 5ffdbe08-2cd4-48ec-a5a8-080f95756eec 512 arch-tag: 5ffdbe08-2cd4-48ec-a5a8-080f95756eec
411@end ignore 513@end ignore
diff --git a/etc/NEWS b/etc/NEWS
index d2298233c83..26a8275104d 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -166,6 +166,20 @@ its usage.
166 166
167* Changes in Specialized Modes and Packages in Emacs 23.1 167* Changes in Specialized Modes and Packages in Emacs 23.1
168 168
169** abbrev was rewritten in Elisp and extended with more flexibility.
170*** New functions: abbrev-get, abbrev-put, abbrev-table-get, abbrev-table-put,
171 abbrev-table-p.
172*** Special hook `abbrev-expand-functions' obsoletes `pre-abbrev-expand-hook'.
173*** `make-abbrev-table', `define-abbrev', `define-abbrev-table' all take
174 extra arguments for arbitrary properties.
175*** New variable `abbrev-minor-mode-table-alist'.
176*** `local-abbrev-table' can hold a list of abbrev-tables.
177*** Abbrevs have now the following special properties:
178 `count', `system-flag', `:enable-function', `:case-fixed'.
179*** Abbrev-tables have now the following special properties:
180 `:parents', `:case-fixed', `:enable-function', `:regexp',
181 `abbrev-table-modiff'.
182
169** isearch can now search through multiple ChangeLog files. 183** isearch can now search through multiple ChangeLog files.
170When running isearch in a ChangeLog file, if the search fails, 184When running isearch in a ChangeLog file, if the search fails,
171then another C-s tries searching the previous ChangeLog, 185then another C-s tries searching the previous ChangeLog,
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 26a5fe4e0c7..f1ad1c7620e 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,26 @@
12007-10-28 Stefan Monnier <monnier@iro.umontreal.ca>
2
3 Rewrite abbrev.c in Elisp.
4 * abbrev.el (abbrev-mode): Move custom group from cus-edit.el.
5 (abbrev-table-get, abbrev-table-put, abbrev-get)
6 (abbrev-put, make-abbrev-table, abbrev-table-p, clear-abbrev-table)
7 (define-abbrev, abbrev--check-chars, define-global-abbrev)
8 (define-mode-abbrev, abbrev--active-tables, abbrev-symbol)
9 (abbrev-expansion, abbrev--before-point, expand-abbrev)
10 (unexpand-abbrev, abbrev--write, abbrev--describe)
11 (insert-abbrev-table-description, define-abbrev-table):
12 New funs, largely transcribed from abbrev.c.
13 (abbrev-with-wrapper-hook): New macro.
14 (abbrev-table-name-list, global-abbrev-table)
15 (abbrev-minor-mode-table-alist, fundamental-mode-abbrev-table)
16 (abbrevs-changed, abbrev-all-caps, abbrev-start-location)
17 (abbrev-start-location-buffer, last-abbrev, last-abbrev-text)
18 (last-abbrev-location, pre-abbrev-expand-hook, abbrev-expand-function):
19 New vars, largely transcribed from abbrev.c.
20 * cus-edit.el (abbrev-mode): Remove. Move to abbrev.el.
21 * cus-start.el: Remove abbrev-all-caps and pre-abbrev-expand-hook.
22 * loadup.el: Load "abbrev.el" before "lisp-mode.el".
23
12007-10-27 Glenn Morris <rgm@gnu.org> 242007-10-27 Glenn Morris <rgm@gnu.org>
2 25
3 * shell.el (shell-dirtrack-verbose, shell-directory-tracker): Doc fix. 26 * shell.el (shell-dirtrack-verbose, shell-directory-tracker): Doc fix.
diff --git a/lisp/abbrev.el b/lisp/abbrev.el
index b2b03fe63bb..b13f0a60725 100644
--- a/lisp/abbrev.el
+++ b/lisp/abbrev.el
@@ -27,8 +27,20 @@
27 27
28;; This facility is documented in the Emacs Manual. 28;; This facility is documented in the Emacs Manual.
29 29
30;; Todo:
31
32;; - Make abbrev-file-name obey user-emacs-directory.
33;; - Cleanup name space.
34
30;;; Code: 35;;; Code:
31 36
37(eval-when-compile (require 'cl))
38
39(defgroup abbrev-mode nil
40 "Word abbreviations mode."
41 :link '(custom-manual "(emacs)Abbrevs")
42 :group 'abbrev)
43
32(defcustom only-global-abbrevs nil 44(defcustom only-global-abbrevs nil
33 "Non-nil means user plans to use global abbrevs only. 45 "Non-nil means user plans to use global abbrevs only.
34This makes the commands that normally define mode-specific abbrevs 46This makes the commands that normally define mode-specific abbrevs
@@ -363,6 +375,528 @@ A prefix argument means don't query; expand all abbrevs."
363 (if (or noquery (y-or-n-p (format "Expand `%s'? " string))) 375 (if (or noquery (y-or-n-p (format "Expand `%s'? " string)))
364 (expand-abbrev))))))) 376 (expand-abbrev)))))))
365 377
378;;; Abbrev properties.
379
380(defun abbrev-table-get (table prop)
381 "Get the PROP property of abbrev table TABLE."
382 (let ((sym (intern-soft "" table)))
383 (if sym (get sym prop))))
384
385(defun abbrev-table-put (table prop val)
386 "Set the PROP property of abbrev table TABLE to VAL."
387 (let ((sym (intern "" table)))
388 (set sym nil) ; Make sure it won't be confused for an abbrev.
389 (put sym prop val)))
390
391(defun abbrev-get (sym prop)
392 "Get the property PROP of abbrev SYM."
393 (let ((plist (symbol-plist sym)))
394 (if (listp plist)
395 (plist-get plist prop)
396 (if (eq 'count prop) plist))))
397
398(defun abbrev-put (sym prop val)
399 "Set the property PROP of abbrev SYM to value VAL.
400See `define-abbrev' for the effect of some special properties."
401 (let ((plist (symbol-plist sym)))
402 (if (consp plist)
403 (put sym prop val)
404 (setplist sym (if (eq 'count prop) val
405 (list 'count plist prop val))))))
406
407(defmacro abbrev-with-wrapper-hook (var &rest body)
408 "Run BODY wrapped with the VAR hook.
409VAR is a special hook: its functions are called with one argument which
410is the \"original\" code (the BODY), so the hook function can wrap the
411original function, can call it several times, or even not call it at all.
412VAR is normally a symbol (a variable) in which case it is treated like a hook,
413with a buffer-local and a global part. But it can also be an arbitrary expression.
414This is similar to an `around' advice."
415 (declare (indent 1) (debug t))
416 ;; We need those two gensyms because CL's lexical scoping is not available
417 ;; for function arguments :-(
418 (let ((funs (make-symbol "funs"))
419 (global (make-symbol "global")))
420 ;; Since the hook is a wrapper, the loop has to be done via
421 ;; recursion: a given hook function will call its parameter in order to
422 ;; continue looping.
423 `(labels ((runrestofhook (,funs ,global)
424 ;; `funs' holds the functions left on the hook and `global'
425 ;; holds the functions left on the global part of the hook
426 ;; (in case the hook is local).
427 (lexical-let ((funs ,funs)
428 (global ,global))
429 (if (consp funs)
430 (if (eq t (car funs))
431 (runrestofhook (append global (cdr funs)) nil)
432 (funcall (car funs)
433 (lambda () (runrestofhook (cdr funs) global))))
434 ;; Once there are no more functions on the hook, run
435 ;; the original body.
436 ,@body))))
437 (runrestofhook ,var
438 ;; The global part of the hook, if any.
439 ,(if (symbolp var)
440 `(if (local-variable-p ',var)
441 (default-value ',var)))))))
442
443
444;;; Code that used to be implemented in src/abbrev.c
445
446(defvar abbrev-table-name-list '(fundamental-mode-abbrev-table
447 global-abbrev-table)
448 "List of symbols whose values are abbrev tables.")
449
450(defun make-abbrev-table (&optional props)
451 "Create a new, empty abbrev table object.
452PROPS is a "
453 ;; The value 59 is an arbitrary prime number.
454 (let ((table (make-vector 59 0)))
455 ;; Each abbrev-table has a `modiff' counter which can be used to detect
456 ;; when an abbreviation was added. An example of use would be to
457 ;; construct :regexp dynamically as the union of all abbrev names, so
458 ;; `modiff' can let us detect that an abbrev was added and hence :regexp
459 ;; needs to be refreshed.
460 ;; The presence of `modiff' entry is also used as a tag indicating this
461 ;; vector is really an abbrev-table.
462 (abbrev-table-put table :abbrev-table-modiff 0)
463 (while (consp props)
464 (abbrev-table-put table (pop props) (pop props)))
465 table))
466
467(defun abbrev-table-p (object)
468 (and (vectorp object)
469 (numberp (abbrev-table-get object :abbrev-table-modiff))))
470
471(defvar global-abbrev-table (make-abbrev-table)
472 "The abbrev table whose abbrevs affect all buffers.
473Each buffer may also have a local abbrev table.
474If it does, the local table overrides the global one
475for any particular abbrev defined in both.")
476
477(defvar abbrev-minor-mode-table-alist nil
478 "Alist of abbrev tables to use for minor modes.
479Each element looks like (VARIABLE . ABBREV-TABLE);
480ABBREV-TABLE is active whenever VARIABLE's value is non-nil.")
481
482(defvar fundamental-mode-abbrev-table
483 (let ((table (make-abbrev-table)))
484 ;; Set local-abbrev-table's default to be fundamental-mode-abbrev-table.
485 (setq-default local-abbrev-table table)
486 table)
487 "The abbrev table of mode-specific abbrevs for Fundamental Mode.")
488
489(defvar abbrevs-changed nil
490 "Set non-nil by defining or altering any word abbrevs.
491This causes `save-some-buffers' to offer to save the abbrevs.")
492
493(defcustom abbrev-all-caps nil
494 "Non-nil means expand multi-word abbrevs all caps if abbrev was so."
495 :type 'boolean
496 :group 'abbrev-mode)
497
498(defvar abbrev-start-location nil
499 "Buffer position for `expand-abbrev' to use as the start of the abbrev.
500When nil, use the word before point as the abbrev.
501Calling `expand-abbrev' sets this to nil.")
502
503(defvar abbrev-start-location-buffer nil
504 "Buffer that `abbrev-start-location' has been set for.
505Trying to expand an abbrev in any other buffer clears `abbrev-start-location'.")
506
507(defvar last-abbrev nil
508 "The abbrev-symbol of the last abbrev expanded. See `abbrev-symbol'.")
509
510(defvar last-abbrev-text nil
511 "The exact text of the last abbrev expanded.
512nil if the abbrev has already been unexpanded.")
513
514(defvar last-abbrev-location 0
515 "The location of the start of the last abbrev expanded.")
516
517;; (defvar local-abbrev-table fundamental-mode-abbrev-table
518;; "Local (mode-specific) abbrev table of current buffer.")
519;; (make-variable-buffer-local 'local-abbrev-table)
520
521(defcustom pre-abbrev-expand-hook nil
522 "Function or functions to be called before abbrev expansion is done.
523This is the first thing that `expand-abbrev' does, and so this may change
524the current abbrev table before abbrev lookup happens."
525 :type 'hook
526 :group 'abbrev-mode)
527(make-obsolete-variable 'pre-abbrev-expand-hook 'abbrev-expand-functions "23.1")
528
529(defun clear-abbrev-table (table)
530 "Undefine all abbrevs in abbrev table TABLE, leaving it empty."
531 (setq abbrevs-changed t)
532 (dotimes (i (length table))
533 (aset table i 0)))
534
535(defun define-abbrev (table name expansion &optional hook &rest props)
536 "Define an abbrev in TABLE named NAME, to expand to EXPANSION and call HOOK.
537NAME must be a string, and should be lower-case.
538EXPANSION should usually be a string.
539To undefine an abbrev, define it with EXPANSION = nil.
540If HOOK is non-nil, it should be a function of no arguments;
541it is called after EXPANSION is inserted.
542If EXPANSION is not a string, the abbrev is a special one,
543 which does not expand in the usual way but only runs HOOK.
544
545PROPS is a property list. The following properties are special:
546- `count': the value for the abbrev's usage-count, which is incremented each time
547 the abbrev is used (the default is zero).
548- `system-flag': if non-nil, says that this is a \"system\" abbreviation
549 which should not be saved in the user's abbreviation file.
550 Unless `system-flag' is `force', a system abbreviation will not
551 overwrite a non-system abbreviation of the same name.
552- `:case-fixed': non-nil means that abbreviations are looked up without
553 case-folding, and the expansion is not capitalized/upcased.
554- `:enable-function': a function of no argument which returns non-nil iff the
555 abbrev should be used for a particular call of `expand-abbrev'.
556
557An obsolete but still supported calling form is:
558
559\(define-abbrev TABLE NAME EXPANSION &optional HOOK COUNT SYSTEM-FLAG)."
560 (when (and (consp props) (or (null (car props)) (numberp (car props))))
561 ;; Old-style calling convention.
562 (setq props (list* 'count (car props)
563 (if (cadr props) (list 'system-flag (cadr props))))))
564 (unless (plist-get props 'count)
565 (setq props (plist-put props 'count 0)))
566 (let ((system-flag (plist-get props 'system-flag))
567 (sym (intern name table)))
568 ;; Don't override a prior user-defined abbrev with a system abbrev,
569 ;; unless system-flag is `force'.
570 (unless (and (not (memq system-flag '(nil force)))
571 (boundp sym) (symbol-value sym)
572 (not (abbrev-get sym 'system-flag)))
573 (unless (or system-flag
574 (and (boundp sym) (fboundp sym)
575 ;; load-file-name
576 (equal (symbol-value sym) expansion)
577 (equal (symbol-function sym) hook)))
578 (setq abbrevs-changed t))
579 (set sym expansion)
580 (fset sym hook)
581 (setplist sym props)
582 (abbrev-table-put table :abbrev-table-modiff
583 (1+ (abbrev-table-get table :abbrev-table-modiff))))
584 name))
585
586(defun abbrev--check-chars (abbrev global)
587 "Check if the characters in ABBREV have word syntax in either the
588current (if global is nil) or standard syntax table."
589 (with-syntax-table
590 (cond ((null global) (standard-syntax-table))
591 ;; ((syntax-table-p global) global)
592 (t (syntax-table)))
593 (when (string-match "\\W" abbrev)
594 (let ((badchars ())
595 (pos 0))
596 (while (string-match "\\W" abbrev pos)
597 (pushnew (aref abbrev (match-beginning 0)) badchars)
598 (setq pos (1+ pos)))
599 (error "Some abbrev characters (%s) are not word constituents %s"
600 (apply 'string (nreverse badchars))
601 (if global "in the standard syntax" "in this mode"))))))
602
603(defun define-global-abbrev (abbrev expansion)
604 "Define ABBREV as a global abbreviation for EXPANSION.
605The characters in ABBREV must all be word constituents in the standard
606syntax table."
607 (interactive "sDefine global abbrev: \nsExpansion for %s: ")
608 (abbrev--check-chars abbrev 'global)
609 (define-abbrev global-abbrev-table (downcase abbrev) expansion))
610
611(defun define-mode-abbrev (abbrev expansion)
612 "Define ABBREV as a mode-specific abbreviation for EXPANSION.
613The characters in ABBREV must all be word-constituents in the current mode."
614 (interactive "sDefine mode abbrev: \nsExpansion for %s: ")
615 (unless local-abbrev-table
616 (error "Major mode has no abbrev table"))
617 (abbrev--check-chars abbrev nil)
618 (define-abbrev local-abbrev-table (downcase abbrev) expansion))
619
620(defun abbrev--active-tables (&optional tables)
621 "Return the list of abbrev tables currently active.
622TABLES if non-nil overrides the usual rules. It can hold
623either a single abbrev table or a list of abbrev tables."
624 ;; We could just remove the `tables' arg and let callers use
625 ;; (or table (abbrev--active-tables)) but then they'd have to be careful
626 ;; to treat the distinction between a single table and a list of tables.
627 (cond
628 ((consp tables) tables)
629 ((vectorp tables) (list tables))
630 (t
631 (let ((tables (if (listp local-abbrev-table)
632 (append local-abbrev-table
633 (list global-abbrev-table))
634 (list local-abbrev-table global-abbrev-table))))
635 ;; Add the minor-mode abbrev tables.
636 (dolist (x abbrev-minor-mode-table-alist)
637 (when (and (symbolp (car x)) (boundp (car x)) (symbol-value (car x)))
638 (setq tables
639 (if (listp (cdr x))
640 (append (cdr x) tables) (cons (cdr x) tables)))))
641 tables))))
642
643
644(defun abbrev-symbol (abbrev &optional table)
645 "Return the symbol representing abbrev named ABBREV.
646This symbol's name is ABBREV, but it is not the canonical symbol of that name;
647it is interned in an abbrev-table rather than the normal obarray.
648The value is nil if that abbrev is not defined.
649Optional second arg TABLE is abbrev table to look it up in.
650The default is to try buffer's mode-specific abbrev table, then global table."
651 (let ((tables (abbrev--active-tables table))
652 sym)
653 (while (and tables (not (symbol-value sym)))
654 (let ((table (pop tables))
655 (case-fold (not (abbrev-table-get table :case-fixed))))
656 (setq tables (append (abbrev-table-get table :parents) tables))
657 ;; In case the table doesn't set :case-fixed but some of the
658 ;; abbrevs do, we have to be careful.
659 (setq sym
660 ;; First try without case-folding.
661 (or (intern-soft abbrev table)
662 (when case-fold
663 ;; We didn't find any abbrev, try case-folding.
664 (let ((sym (intern-soft (downcase abbrev) table)))
665 ;; Only use it if it doesn't require :case-fixed.
666 (and sym (not (abbrev-get sym :case-fixed))
667 sym)))))))
668 (if (symbol-value sym)
669 sym)))
670
671
672(defun abbrev-expansion (abbrev &optional table)
673 "Return the string that ABBREV expands into in the current buffer.
674Optionally specify an abbrev table as second arg;
675then ABBREV is looked up in that table only."
676 (symbol-value (abbrev-symbol abbrev table)))
677
678
679(defun abbrev--before-point ()
680 "Try and find an abbrev before point. Return it if found, nil otherwise."
681 (unless (eq abbrev-start-location-buffer (current-buffer))
682 (setq abbrev-start-location nil))
683
684 (let ((tables (abbrev--active-tables))
685 (pos (point))
686 start end name res)
687
688 (if abbrev-start-location
689 (progn
690 (setq start abbrev-start-location)
691 (setq abbrev-start-location nil)
692 ;; Remove the hyphen inserted by `abbrev-prefix-mark'.
693 (if (and (< start (point-max))
694 (eq (char-after start) ?-))
695 (delete-region start (1+ start)))
696 (skip-syntax-backward " ")
697 (setq end (point))
698 (setq name (buffer-substring start end))
699 (goto-char pos) ; Restore point.
700 (list (abbrev-symbol name tables) name start end))
701
702 (while (and tables (not (car res)))
703 (let* ((table (pop tables))
704 (enable-fun (abbrev-table-get table :enable-function)))
705 (setq tables (append (abbrev-table-get table :parents) tables))
706 (setq res
707 (and (or (not enable-fun) (funcall enable-fun))
708 (looking-back (or (abbrev-table-get table :regexp)
709 "\\<\\(\\w+\\)\\W*")
710 (line-beginning-position))
711 (setq start (match-beginning 1))
712 (setq end (match-end 1))
713 (setq name (buffer-substring start end))
714 ;; This will also look it up in parent tables.
715 ;; This is not on purpose, but it seems harmless.
716 (list (abbrev-symbol name table) name start end)))
717 ;; Restore point.
718 (goto-char pos)))
719 res)))
720
721(defvar abbrev-expand-functions nil
722 "Wrapper hook around `expand-abbrev'.
723The functions on this special hook are called with one argument:
724a function that performs the abbrev expansion. It should return
725the abbrev symbol if expansion took place.")
726
727(defun expand-abbrev ()
728 "Expand the abbrev before point, if there is an abbrev there.
729Effective when explicitly called even when `abbrev-mode' is nil.
730Returns the abbrev symbol, if expansion took place."
731 (interactive)
732 (run-hooks 'pre-abbrev-expand-hook)
733 (abbrev-with-wrapper-hook abbrev-expand-functions
734 (destructuring-bind (&optional sym name wordstart wordend)
735 (abbrev--before-point)
736 (when sym
737 (let ((value sym))
738 (unless (or ;; executing-kbd-macro
739 noninteractive
740 (window-minibuffer-p (selected-window)))
741 ;; Add an undo boundary, in case we are doing this for
742 ;; a self-inserting command which has avoided making one so far.
743 (undo-boundary))
744 ;; Now sym is the abbrev symbol.
745 (setq last-abbrev-text name)
746 (setq last-abbrev sym)
747 (setq last-abbrev-location wordstart)
748 ;; Increment use count.
749 (abbrev-put sym 'count (1+ (abbrev-get sym 'count)))
750 ;; If this abbrev has an expansion, delete the abbrev
751 ;; and insert the expansion.
752 (when (stringp (symbol-value sym))
753 (goto-char wordend)
754 (insert (symbol-value sym))
755 (delete-region wordstart wordend)
756 (let ((case-fold-search nil))
757 ;; If the abbrev's name is different from the buffer text (the
758 ;; only difference should be capitalization), then we may want
759 ;; to adjust the capitalization of the expansion.
760 (when (and (not (equal name (symbol-name sym)))
761 (string-match "[[:upper:]]" name))
762 (if (not (string-match "[[:lower:]]" name))
763 ;; Abbrev was all caps. If expansion is multiple words,
764 ;; normally capitalize each word.
765 (if (and (not abbrev-all-caps)
766 (save-excursion
767 (> (progn (backward-word 1) (point))
768 (progn (goto-char wordstart)
769 (forward-word 1) (point)))))
770 (upcase-initials-region wordstart (point))
771 (upcase-region wordstart (point)))
772 ;; Abbrev included some caps. Cap first initial of expansion.
773 (let ((end (point)))
774 ;; Find the initial.
775 (goto-char wordstart)
776 (skip-syntax-forward "^w" (1- end))
777 ;; Change just that.
778 (upcase-initials-region (point) (1+ (point))))))))
779 (when (symbol-function sym)
780 (let* ((hook (symbol-function sym))
781 (expanded
782 ;; If the abbrev has a hook function, run it.
783 (funcall hook)))
784 ;; In addition, if the hook function is a symbol with
785 ;; a non-nil `no-self-insert' property, let the value it
786 ;; returned specify whether we consider that an expansion took
787 ;; place. If it returns nil, no expansion has been done.
788 (if (and (symbolp hook)
789 (null expanded)
790 (get hook 'no-self-insert))
791 (setq value nil))))
792 value)))))
793
794(defun unexpand-abbrev ()
795 "Undo the expansion of the last abbrev that expanded.
796This differs from ordinary undo in that other editing done since then
797is not undone."
798 (interactive)
799 (save-excursion
800 (unless (or (< last-abbrev-location (point-min))
801 (> last-abbrev-location (point-max)))
802 (goto-char last-abbrev-location)
803 (when (stringp last-abbrev-text)
804 ;; This isn't correct if last-abbrev's hook was used
805 ;; to do the expansion.
806 (let ((val (symbol-value last-abbrev)))
807 (unless (stringp val)
808 (error "value of abbrev-symbol must be a string"))
809 (delete-region (point) (+ (point) (length val)))
810 ;; Don't inherit properties here; just copy from old contents.
811 (insert last-abbrev-text)
812 (setq last-abbrev-text nil))))))
813
814(defun abbrev--write (sym)
815 "Write the abbrev in a `read'able form.
816Only writes the non-system abbrevs.
817Presumes that `standard-output' points to `current-buffer'."
818 (unless (or (null (symbol-value sym)) (abbrev-get sym 'system-flag))
819 (insert " (")
820 (prin1 name)
821 (insert " ")
822 (prin1 (symbol-value sym))
823 (insert " ")
824 (prin1 (symbol-function sym))
825 (insert " ")
826 (prin1 (abbrev-get sym 'count))
827 (insert ")\n")))
828
829(defun abbrev--describe (sym)
830 (when (symbol-value sym)
831 (prin1 (symbol-name sym))
832 (if (null (abbrev-get sym 'system-flag))
833 (indent-to 15 1)
834 (insert " (sys)")
835 (indent-to 20 1))
836 (prin1 (abbrev-get sym 'count))
837 (indent-to 20 1)
838 (prin1 (symbol-value sym))
839 (when (symbol-function sym)
840 (indent-to 45 1)
841 (prin1 (symbol-function sym)))
842 (terpri)))
843
844(defun insert-abbrev-table-description (name &optional readable)
845 "Insert before point a full description of abbrev table named NAME.
846NAME is a symbol whose value is an abbrev table.
847If optional 2nd arg READABLE is non-nil, a human-readable description
848is inserted. Otherwise the description is an expression,
849a call to `define-abbrev-table', which would
850define the abbrev table NAME exactly as it is currently defined.
851
852Abbrevs marked as \"system abbrevs\" are omitted."
853 (let ((table (symbol-value name))
854 (symbols ()))
855 (mapatoms (lambda (sym) (if (symbol-value sym) (push sym symbols))) table)
856 (setq symbols (sort symbols 'string-lessp))
857 (let ((standard-output (current-buffer)))
858 (if readable
859 (progn
860 (insert "(")
861 (prin1 name)
862 (insert ")\n\n")
863 (mapc 'abbrev--describe symbols)
864 (insert "\n\n"))
865 (insert "(define-abbrev-table '")
866 (prin1 name)
867 (insert " '(")
868 (mapc 'abbrev--write symbols)
869 (insert " ))\n\n"))
870 nil)))
871
872(defun define-abbrev-table (tablename definitions
873 &optional docstring &rest props)
874 "Define TABLENAME (a symbol) as an abbrev table name.
875Define abbrevs in it according to DEFINITIONS, which is a list of elements
876of the form (ABBREVNAME EXPANSION HOOK USECOUNT SYSTEMFLAG).
877\(If the list is shorter than that, omitted elements default to nil).
878PROPS is a property list to apply to the table.
879Properties with special meaning:
880- `:parents' contains a list of abbrev tables from which this table inherits
881 abbreviations.
882- `:case-fixed' non-nil means that abbreviations are looked up without
883 case-folding, and the expansion is not capitalized/upcased.
884- `:regexp' describes the form of abbrevs. It defaults to \\<\\(\\w+\\)\\W* which
885 means that an abbrev can only be a single word. The submatch 1 is treated
886 as the potential name of an abbrev.
887- `:enable-function' can be set to a function of no argument which returns
888 non-nil iff the abbrevs in this table should be used for this instance
889 of `expand-abbrev'."
890 (let ((table (if (boundp tablename) (symbol-value tablename))))
891 (unless table
892 (setq table (make-abbrev-table props))
893 (set tablename table)
894 (push tablename abbrev-table-name-list))
895 (when (stringp docstring)
896 (put tablename 'variable-documentation docstring))
897 (dolist (elt definitions)
898 (apply 'define-abbrev table elt))))
899
366(provide 'abbrev) 900(provide 'abbrev)
367 901
368;; arch-tag: dbd6f3ae-dfe3-40ba-b00f-f9e3ff960df5 902;; arch-tag: dbd6f3ae-dfe3-40ba-b00f-f9e3ff960df5
diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el
index 63753af76df..19098367d8f 100644
--- a/lisp/cus-edit.el
+++ b/lisp/cus-edit.el
@@ -374,11 +374,6 @@
374 :prefix "custom-" 374 :prefix "custom-"
375 :group 'customize) 375 :group 'customize)
376 376
377(defgroup abbrev-mode nil
378 "Word abbreviations mode."
379 :link '(custom-manual "(emacs)Abbrevs")
380 :group 'abbrev)
381
382(defgroup alloc nil 377(defgroup alloc nil
383 "Storage allocation and gc for GNU Emacs Lisp interpreter." 378 "Storage allocation and gc for GNU Emacs Lisp interpreter."
384 :tag "Storage Allocation" 379 :tag "Storage Allocation"
diff --git a/lisp/cus-start.el b/lisp/cus-start.el
index 6a66d8caa75..fd5a62f0c1b 100644
--- a/lisp/cus-start.el
+++ b/lisp/cus-start.el
@@ -35,10 +35,7 @@
35 35
36;;; Code: 36;;; Code:
37 37
38(let ((all '(;; abbrev.c 38(let ((all '(;; alloc.c
39 (abbrev-all-caps abbrev-mode boolean)
40 (pre-abbrev-expand-hook abbrev-mode hook)
41 ;; alloc.c
42 (gc-cons-threshold alloc integer) 39 (gc-cons-threshold alloc integer)
43 (garbage-collection-messages alloc boolean) 40 (garbage-collection-messages alloc boolean)
44 ;; buffer.c 41 ;; buffer.c
diff --git a/lisp/loadup.el b/lisp/loadup.el
index 3bf021b017f..43e7beff8d6 100644
--- a/lisp/loadup.el
+++ b/lisp/loadup.el
@@ -160,6 +160,7 @@
160(load "textmodes/page") 160(load "textmodes/page")
161(load "register") 161(load "register")
162(load "textmodes/paragraphs") 162(load "textmodes/paragraphs")
163(load "abbrev") ;lisp-mode.el uses define-abbrev-table.
163(load "emacs-lisp/lisp-mode") 164(load "emacs-lisp/lisp-mode")
164(load "textmodes/text-mode") 165(load "textmodes/text-mode")
165(load "textmodes/fill") 166(load "textmodes/fill")
@@ -169,7 +170,6 @@
169(if (eq system-type 'vax-vms) 170(if (eq system-type 'vax-vms)
170 (progn 171 (progn
171 (load "vmsproc"))) 172 (load "vmsproc")))
172(load "abbrev")
173(load "buff-menu") 173(load "buff-menu")
174 174
175(if (fboundp 'x-create-frame) 175(if (fboundp 'x-create-frame)
diff --git a/src/ChangeLog b/src/ChangeLog
index 36e6ca3b00d..d4f70731562 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,14 @@
12007-10-28 Stefan Monnier <monnier@iro.umontreal.ca>
2
3 Rewrite abbrev.c in Elisp.
4 * image.c (Qcount): Don't declare as extern.
5 (syms_of_image): Initialize and staticpro `Qcount'.
6 * puresize.h (BASE_PURESIZE): Increase for the new abbrev.el functions.
7 * emacs.c (main): Don't call syms_of_abbrev.
8 * Makefile.in (obj): Remove abbrev.o.
9 (abbrev.o): Remove.
10 * abbrev.c: Remove.
11
12007-10-26 Martin Rudalics <rudalics@gmx.at> 122007-10-26 Martin Rudalics <rudalics@gmx.at>
2 13
3 * window.c (window_min_size_2): Don't count header-line. 14 * window.c (window_min_size_2): Don't count header-line.
diff --git a/src/Makefile.in b/src/Makefile.in
index 7119f94c8d2..56e8a7c49a5 100644
--- a/src/Makefile.in
+++ b/src/Makefile.in
@@ -603,7 +603,7 @@ obj= dispnew.o frame.o scroll.o xdisp.o $(XMENU_OBJ) window.o \
603 cmds.o casetab.o casefiddle.o indent.o search.o regex.o undo.o \ 603 cmds.o casetab.o casefiddle.o indent.o search.o regex.o undo.o \
604 alloc.o data.o doc.o editfns.o callint.o \ 604 alloc.o data.o doc.o editfns.o callint.o \
605 eval.o floatfns.o fns.o print.o lread.o \ 605 eval.o floatfns.o fns.o print.o lread.o \
606 abbrev.o syntax.o UNEXEC bytecode.o \ 606 syntax.o UNEXEC bytecode.o \
607 process.o callproc.o \ 607 process.o callproc.o \
608 region-cache.o sound.o atimer.o \ 608 region-cache.o sound.o atimer.o \
609 doprnt.o strftime.o intervals.o textprop.o composite.o md5.o \ 609 doprnt.o strftime.o intervals.o textprop.o composite.o md5.o \
@@ -1094,8 +1094,6 @@ stamp-oldxmenu:
1094 it is so often changed in ways that do not require any recompilation 1094 it is so often changed in ways that do not require any recompilation
1095 and so rarely changed in ways that do require any. */ 1095 and so rarely changed in ways that do require any. */
1096 1096
1097abbrev.o: abbrev.c buffer.h window.h dispextern.h commands.h charset.h \
1098 syntax.h $(config_h)
1099buffer.o: buffer.c buffer.h region-cache.h commands.h window.h \ 1097buffer.o: buffer.c buffer.h region-cache.h commands.h window.h \
1100 dispextern.h $(INTERVAL_SRC) blockinput.h atimer.h systime.h charset.h \ 1098 dispextern.h $(INTERVAL_SRC) blockinput.h atimer.h systime.h charset.h \
1101 $(config_h) 1099 $(config_h)
@@ -1279,7 +1277,7 @@ composite.o: composite.c buffer.h charset.h $(INTERVAL_SRC) $(config_h)
1279sunfns.o: sunfns.c buffer.h window.h dispextern.h termhooks.h $(config_h) 1277sunfns.o: sunfns.c buffer.h window.h dispextern.h termhooks.h $(config_h)
1280 1278
1281#ifdef HAVE_CARBON 1279#ifdef HAVE_CARBON
1282abbrev.o buffer.o callint.o cmds.o dispnew.o editfns.o fileio.o frame.o \ 1280buffer.o callint.o cmds.o dispnew.o editfns.o fileio.o frame.o \
1283 fontset.o indent.o insdel.o keyboard.o macros.o minibuf.o msdos.o process.o \ 1281 fontset.o indent.o insdel.o keyboard.o macros.o minibuf.o msdos.o process.o \
1284 scroll.o sysdep.o term.o terminal.o widget.o window.o xdisp.o xfaces.o xfns.o xmenu.o \ 1282 scroll.o sysdep.o term.o terminal.o widget.o window.o xdisp.o xfaces.o xfns.o xmenu.o \
1285 xterm.o xselect.o sound.o: macgui.h 1283 xterm.o xselect.o sound.o: macgui.h
diff --git a/src/abbrev.c b/src/abbrev.c
deleted file mode 100644
index 403afdb99a7..00000000000
--- a/src/abbrev.c
+++ /dev/null
@@ -1,803 +0,0 @@
1/* Primitives for word-abbrev mode.
2 Copyright (C) 1985, 1986, 1993, 1996, 1998, 2001, 2002, 2003, 2004,
3 2005, 2006, 2007 Free Software Foundation, Inc.
4
5This file is part of GNU Emacs.
6
7GNU Emacs is free software; you can redistribute it and/or modify
8it under the terms of the GNU General Public License as published by
9the Free Software Foundation; either version 3, or (at your option)
10any later version.
11
12GNU Emacs is distributed in the hope that it will be useful,
13but WITHOUT ANY WARRANTY; without even the implied warranty of
14MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15GNU General Public License for more details.
16
17You should have received a copy of the GNU General Public License
18along with GNU Emacs; see the file COPYING. If not, write to
19the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
20Boston, MA 02110-1301, USA. */
21
22
23#include <config.h>
24#include <stdio.h>
25
26#include "lisp.h"
27#include "commands.h"
28#include "buffer.h"
29#include "window.h"
30#include "charset.h"
31#include "syntax.h"
32
33/* An abbrev table is an obarray.
34 Each defined abbrev is represented by a symbol in that obarray
35 whose print name is the abbreviation.
36 The symbol's value is a string which is the expansion.
37 If its function definition is non-nil, it is called
38 after the expansion is done.
39 The plist slot of the abbrev symbol is its usage count. */
40
41/* List of all abbrev-table name symbols:
42 symbols whose values are abbrev tables. */
43
44Lisp_Object Vabbrev_table_name_list;
45
46/* The table of global abbrevs. These are in effect
47 in any buffer in which abbrev mode is turned on. */
48
49Lisp_Object Vglobal_abbrev_table;
50
51/* The local abbrev table used by default (in Fundamental Mode buffers) */
52
53Lisp_Object Vfundamental_mode_abbrev_table;
54
55/* Set nonzero when an abbrev definition is changed */
56
57int abbrevs_changed;
58
59int abbrev_all_caps;
60
61/* Non-nil => use this location as the start of abbrev to expand
62 (rather than taking the word before point as the abbrev) */
63
64Lisp_Object Vabbrev_start_location;
65
66/* Buffer that Vabbrev_start_location applies to */
67Lisp_Object Vabbrev_start_location_buffer;
68
69/* The symbol representing the abbrev most recently expanded */
70
71Lisp_Object Vlast_abbrev;
72
73/* A string for the actual text of the abbrev most recently expanded.
74 This has more info than Vlast_abbrev since case is significant. */
75
76Lisp_Object Vlast_abbrev_text;
77
78/* Character address of start of last abbrev expanded */
79
80EMACS_INT last_abbrev_point;
81
82/* Hook to run before expanding any abbrev. */
83
84Lisp_Object Vpre_abbrev_expand_hook, Qpre_abbrev_expand_hook;
85
86Lisp_Object Qsystem_type, Qcount, Qforce;
87
88DEFUN ("make-abbrev-table", Fmake_abbrev_table, Smake_abbrev_table, 0, 0, 0,
89 doc: /* Create a new, empty abbrev table object. */)
90 ()
91{
92 /* The value 59 is arbitrary chosen prime number. */
93 return Fmake_vector (make_number (59), make_number (0));
94}
95
96DEFUN ("clear-abbrev-table", Fclear_abbrev_table, Sclear_abbrev_table, 1, 1, 0,
97 doc: /* Undefine all abbrevs in abbrev table TABLE, leaving it empty. */)
98 (table)
99 Lisp_Object table;
100{
101 int i, size;
102
103 CHECK_VECTOR (table);
104 size = XVECTOR (table)->size;
105 abbrevs_changed = 1;
106 for (i = 0; i < size; i++)
107 XVECTOR (table)->contents[i] = make_number (0);
108 return Qnil;
109}
110
111DEFUN ("define-abbrev", Fdefine_abbrev, Sdefine_abbrev, 3, 6, 0,
112 doc: /* Define an abbrev in TABLE named NAME, to expand to EXPANSION and call HOOK.
113NAME must be a string, and should be lower-case.
114EXPANSION should usually be a string.
115To undefine an abbrev, define it with EXPANSION = nil.
116If HOOK is non-nil, it should be a function of no arguments;
117it is called after EXPANSION is inserted.
118If EXPANSION is not a string, the abbrev is a special one,
119 which does not expand in the usual way but only runs HOOK.
120
121COUNT, if specified, gives the initial value for the abbrev's
122usage-count, which is incremented each time the abbrev is used.
123\(The default is zero.)
124
125SYSTEM-FLAG, if non-nil, says that this is a "system" abbreviation
126which should not be saved in the user's abbreviation file.
127Unless SYSTEM-FLAG is `force', a system abbreviation will not
128overwrite a non-system abbreviation of the same name. */)
129 (table, name, expansion, hook, count, system_flag)
130 Lisp_Object table, name, expansion, hook, count, system_flag;
131{
132 Lisp_Object sym, oexp, ohook, tem;
133 CHECK_VECTOR (table);
134 CHECK_STRING (name);
135
136 /* If defining a system abbrev, do not overwrite a non-system abbrev
137 of the same name, unless 'force is used. */
138 if (!NILP (system_flag) && !EQ (system_flag, Qforce))
139 {
140 sym = Fintern_soft (name, table);
141
142 if (!NILP (SYMBOL_VALUE (sym)) &&
143 NILP (Fplist_get (XSYMBOL (sym)->plist, Qsystem_type))) return Qnil;
144 }
145
146 if (NILP (count))
147 count = make_number (0);
148 else
149 CHECK_NUMBER (count);
150
151 sym = Fintern (name, table);
152
153 oexp = SYMBOL_VALUE (sym);
154 ohook = XSYMBOL (sym)->function;
155 if (!((EQ (oexp, expansion)
156 || (STRINGP (oexp) && STRINGP (expansion)
157 && (tem = Fstring_equal (oexp, expansion), !NILP (tem))))
158 &&
159 (EQ (ohook, hook)
160 || (tem = Fequal (ohook, hook), !NILP (tem))))
161 && NILP (system_flag))
162 abbrevs_changed = 1;
163
164 Fset (sym, expansion);
165 Ffset (sym, hook);
166
167 if (! NILP (system_flag))
168 Fsetplist (sym, list4 (Qcount, count, Qsystem_type, system_flag));
169 else
170 Fsetplist (sym, count);
171
172 return name;
173}
174
175/* Check if the characters in ABBREV have word syntax in either the
176 * current (if global == 0) or standard syntax table. */
177static void
178abbrev_check_chars (abbrev, global)
179 Lisp_Object abbrev;
180 int global;
181{
182 int i, i_byte, len, nbad = 0;
183 int j, found, nuniq = 0;
184 char *badchars, *baduniq;
185
186 CHECK_STRING (abbrev);
187 len = SCHARS (abbrev);
188
189 badchars = (char *) alloca (len + 1);
190
191 for (i = 0, i_byte = 0; i < len; )
192 {
193 int c;
194
195 FETCH_STRING_CHAR_ADVANCE (c, abbrev, i, i_byte);
196
197 if (global)
198 {
199 /* Copied from SYNTAX in syntax.h, except using FOLLOW_PARENT. */
200 Lisp_Object syntax_temp
201 = SYNTAX_ENTRY_FOLLOW_PARENT (Vstandard_syntax_table, c);
202 if ( (CONSP (syntax_temp)
203 ? (enum syntaxcode) (XINT (XCAR (syntax_temp)) & 0xff)
204 : Swhitespace) != Sword ) badchars[nbad++] = c;
205 }
206 else if (SYNTAX (c) != Sword)
207 badchars[nbad++] = c;
208 }
209
210 if (nbad == 0) return;
211
212 baduniq = (char *) alloca (nbad + 1);
213
214 for (i = 0; i < nbad; i++)
215 {
216 found = 0;
217
218 for (j = 0; j < nuniq; j++)
219 {
220 if (badchars[i] == baduniq[j])
221 {
222 found = 1;
223 break;
224 }
225 }
226
227 if (found) continue ;
228
229 baduniq[nuniq++] = badchars[i];
230 }
231
232 baduniq[nuniq] = '\0';
233
234 error ("Some abbrev characters (%s) are not word constituents %s",
235 baduniq, global ? "in the standard syntax" : "in this mode" );
236}
237
238DEFUN ("define-global-abbrev", Fdefine_global_abbrev, Sdefine_global_abbrev, 2, 2,
239 "sDefine global abbrev: \nsExpansion for %s: ",
240 doc: /* Define ABBREV as a global abbreviation for EXPANSION.
241The characters in ABBREV must all be word constituents in the standard
242syntax table. */)
243 (abbrev, expansion)
244 Lisp_Object abbrev, expansion;
245{
246 abbrev_check_chars (abbrev, 1);
247
248 Fdefine_abbrev (Vglobal_abbrev_table, Fdowncase (abbrev),
249 expansion, Qnil, make_number (0), Qnil);
250 return abbrev;
251}
252
253DEFUN ("define-mode-abbrev", Fdefine_mode_abbrev, Sdefine_mode_abbrev, 2, 2,
254 "sDefine mode abbrev: \nsExpansion for %s: ",
255 doc: /* Define ABBREV as a mode-specific abbreviation for EXPANSION.
256The characters in ABBREV must all be word-constituents in the current mode. */)
257 (abbrev, expansion)
258 Lisp_Object abbrev, expansion;
259{
260 if (NILP (current_buffer->abbrev_table))
261 error ("Major mode has no abbrev table");
262
263 abbrev_check_chars (abbrev, 0);
264
265 Fdefine_abbrev (current_buffer->abbrev_table, Fdowncase (abbrev),
266 expansion, Qnil, make_number (0), Qnil);
267 return abbrev;
268}
269
270DEFUN ("abbrev-symbol", Fabbrev_symbol, Sabbrev_symbol, 1, 2, 0,
271 doc: /* Return the symbol representing abbrev named ABBREV.
272This symbol's name is ABBREV, but it is not the canonical symbol of that name;
273it is interned in an abbrev-table rather than the normal obarray.
274The value is nil if that abbrev is not defined.
275Optional second arg TABLE is abbrev table to look it up in.
276The default is to try buffer's mode-specific abbrev table, then global table. */)
277 (abbrev, table)
278 Lisp_Object abbrev, table;
279{
280 Lisp_Object sym;
281 CHECK_STRING (abbrev);
282 if (!NILP (table))
283 sym = Fintern_soft (abbrev, table);
284 else
285 {
286 sym = Qnil;
287 if (!NILP (current_buffer->abbrev_table))
288 sym = Fintern_soft (abbrev, current_buffer->abbrev_table);
289 if (NILP (SYMBOL_VALUE (sym)))
290 sym = Qnil;
291 if (NILP (sym))
292 sym = Fintern_soft (abbrev, Vglobal_abbrev_table);
293 }
294 if (NILP (SYMBOL_VALUE (sym)))
295 return Qnil;
296 return sym;
297}
298
299DEFUN ("abbrev-expansion", Fabbrev_expansion, Sabbrev_expansion, 1, 2, 0,
300 doc: /* Return the string that ABBREV expands into in the current buffer.
301Optionally specify an abbrev table as second arg;
302then ABBREV is looked up in that table only. */)
303 (abbrev, table)
304 Lisp_Object abbrev, table;
305{
306 Lisp_Object sym;
307 sym = Fabbrev_symbol (abbrev, table);
308 if (NILP (sym)) return sym;
309 return Fsymbol_value (sym);
310}
311
312/* Expand the word before point, if it is an abbrev.
313 Returns 1 if an expansion is done. */
314
315DEFUN ("expand-abbrev", Fexpand_abbrev, Sexpand_abbrev, 0, 0, "",
316 doc: /* Expand the abbrev before point, if there is an abbrev there.
317Effective when explicitly called even when `abbrev-mode' is nil.
318Returns the abbrev symbol, if expansion took place. */)
319 ()
320{
321 register char *buffer, *p;
322 int wordstart, wordend;
323 register int wordstart_byte, wordend_byte, idx, idx_byte;
324 int whitecnt;
325 int uccount = 0, lccount = 0;
326 register Lisp_Object sym;
327 Lisp_Object expansion, hook, tem;
328 Lisp_Object value;
329 int multibyte = ! NILP (current_buffer->enable_multibyte_characters);
330
331 value = Qnil;
332
333 Frun_hooks (1, &Qpre_abbrev_expand_hook);
334
335 wordstart = 0;
336 if (!(BUFFERP (Vabbrev_start_location_buffer)
337 && XBUFFER (Vabbrev_start_location_buffer) == current_buffer))
338 Vabbrev_start_location = Qnil;
339 if (!NILP (Vabbrev_start_location))
340 {
341 tem = Vabbrev_start_location;
342 CHECK_NUMBER_COERCE_MARKER (tem);
343 wordstart = XINT (tem);
344 Vabbrev_start_location = Qnil;
345 if (wordstart < BEGV || wordstart > ZV)
346 wordstart = 0;
347 if (wordstart && wordstart != ZV)
348 {
349 wordstart_byte = CHAR_TO_BYTE (wordstart);
350 if (FETCH_BYTE (wordstart_byte) == '-')
351 del_range (wordstart, wordstart + 1);
352 }
353 }
354 if (!wordstart)
355 wordstart = scan_words (PT, -1);
356
357 if (!wordstart)
358 return value;
359
360 wordstart_byte = CHAR_TO_BYTE (wordstart);
361 wordend = scan_words (wordstart, 1);
362 if (!wordend)
363 return value;
364
365 if (wordend > PT)
366 wordend = PT;
367
368 wordend_byte = CHAR_TO_BYTE (wordend);
369 whitecnt = PT - wordend;
370 if (wordend <= wordstart)
371 return value;
372
373 p = buffer = (char *) alloca (wordend_byte - wordstart_byte);
374
375 for (idx = wordstart, idx_byte = wordstart_byte; idx < wordend; )
376 {
377 register int c;
378
379 if (multibyte)
380 {
381 FETCH_CHAR_ADVANCE (c, idx, idx_byte);
382 }
383 else
384 {
385 c = FETCH_BYTE (idx_byte);
386 idx++, idx_byte++;
387 }
388
389 if (UPPERCASEP (c))
390 c = DOWNCASE (c), uccount++;
391 else if (! NOCASEP (c))
392 lccount++;
393 if (multibyte)
394 p += CHAR_STRING (c, p);
395 else
396 *p++ = c;
397 }
398
399 if (VECTORP (current_buffer->abbrev_table))
400 sym = oblookup (current_buffer->abbrev_table, buffer,
401 wordend - wordstart, p - buffer);
402 else
403 XSETFASTINT (sym, 0);
404
405 if (INTEGERP (sym) || NILP (SYMBOL_VALUE (sym)))
406 sym = oblookup (Vglobal_abbrev_table, buffer,
407 wordend - wordstart, p - buffer);
408 if (INTEGERP (sym) || NILP (SYMBOL_VALUE (sym)))
409 return value;
410
411 if (INTERACTIVE && !EQ (minibuf_window, selected_window))
412 {
413 /* Add an undo boundary, in case we are doing this for
414 a self-inserting command which has avoided making one so far. */
415 SET_PT (wordend);
416 Fundo_boundary ();
417 }
418
419 Vlast_abbrev_text
420 = Fbuffer_substring (make_number (wordstart), make_number (wordend));
421
422 /* Now sym is the abbrev symbol. */
423 Vlast_abbrev = sym;
424 value = sym;
425 last_abbrev_point = wordstart;
426
427 /* Increment use count. */
428 if (INTEGERP (XSYMBOL (sym)->plist))
429 XSETINT (XSYMBOL (sym)->plist,
430 XINT (XSYMBOL (sym)->plist) + 1);
431 else if (INTEGERP (tem = Fget (sym, Qcount)))
432 Fput (sym, Qcount, make_number (XINT (tem) + 1));
433
434 /* If this abbrev has an expansion, delete the abbrev
435 and insert the expansion. */
436 expansion = SYMBOL_VALUE (sym);
437 if (STRINGP (expansion))
438 {
439 SET_PT (wordstart);
440
441 insert_from_string (expansion, 0, 0, SCHARS (expansion),
442 SBYTES (expansion), 1);
443 del_range_both (PT, PT_BYTE,
444 wordend + (PT - wordstart),
445 wordend_byte + (PT_BYTE - wordstart_byte),
446 1);
447
448 SET_PT (PT + whitecnt);
449
450 if (uccount && !lccount)
451 {
452 /* Abbrev was all caps */
453 /* If expansion is multiple words, normally capitalize each word */
454 /* This used to be if (!... && ... >= ...) Fcapitalize; else Fupcase
455 but Megatest 68000 compiler can't handle that */
456 if (!abbrev_all_caps)
457 if (scan_words (PT, -1) > scan_words (wordstart, 1))
458 {
459 Fupcase_initials_region (make_number (wordstart),
460 make_number (PT));
461 goto caped;
462 }
463 /* If expansion is one word, or if user says so, upcase it all. */
464 Fupcase_region (make_number (wordstart), make_number (PT));
465 caped: ;
466 }
467 else if (uccount)
468 {
469 /* Abbrev included some caps. Cap first initial of expansion */
470 int pos = wordstart_byte;
471
472 /* Find the initial. */
473 while (pos < PT_BYTE
474 && SYNTAX (*BUF_BYTE_ADDRESS (current_buffer, pos)) != Sword)
475 pos++;
476
477 /* Change just that. */
478 pos = BYTE_TO_CHAR (pos);
479 Fupcase_initials_region (make_number (pos), make_number (pos + 1));
480 }
481 }
482
483 hook = XSYMBOL (sym)->function;
484 if (!NILP (hook))
485 {
486 Lisp_Object expanded, prop;
487
488 /* If the abbrev has a hook function, run it. */
489 expanded = call0 (hook);
490
491 /* In addition, if the hook function is a symbol with
492 a non-nil `no-self-insert' property, let the value it returned
493 specify whether we consider that an expansion took place. If
494 it returns nil, no expansion has been done. */
495
496 if (SYMBOLP (hook)
497 && NILP (expanded)
498 && (prop = Fget (hook, intern ("no-self-insert")),
499 !NILP (prop)))
500 value = Qnil;
501 }
502
503 return value;
504}
505
506DEFUN ("unexpand-abbrev", Funexpand_abbrev, Sunexpand_abbrev, 0, 0, "",
507 doc: /* Undo the expansion of the last abbrev that expanded.
508This differs from ordinary undo in that other editing done since then
509is not undone. */)
510 ()
511{
512 int opoint = PT;
513 int adjust = 0;
514 if (last_abbrev_point < BEGV
515 || last_abbrev_point > ZV)
516 return Qnil;
517 SET_PT (last_abbrev_point);
518 if (STRINGP (Vlast_abbrev_text))
519 {
520 /* This isn't correct if Vlast_abbrev->function was used
521 to do the expansion */
522 Lisp_Object val;
523 int zv_before;
524
525 val = SYMBOL_VALUE (Vlast_abbrev);
526 if (!STRINGP (val))
527 error ("Value of `abbrev-symbol' must be a string");
528 zv_before = ZV;
529 del_range_byte (PT_BYTE, PT_BYTE + SBYTES (val), 1);
530 /* Don't inherit properties here; just copy from old contents. */
531 insert_from_string (Vlast_abbrev_text, 0, 0,
532 SCHARS (Vlast_abbrev_text),
533 SBYTES (Vlast_abbrev_text), 0);
534 Vlast_abbrev_text = Qnil;
535 /* Total number of characters deleted. */
536 adjust = ZV - zv_before;
537 }
538 SET_PT (last_abbrev_point < opoint ? opoint + adjust : opoint);
539 return Qnil;
540}
541
542static void
543write_abbrev (sym, stream)
544 Lisp_Object sym, stream;
545{
546 Lisp_Object name, count, system_flag;
547
548 if (INTEGERP (XSYMBOL (sym)->plist))
549 {
550 count = XSYMBOL (sym)->plist;
551 system_flag = Qnil;
552 }
553 else
554 {
555 count = Fget (sym, Qcount);
556 system_flag = Fget (sym, Qsystem_type);
557 }
558
559 if (NILP (SYMBOL_VALUE (sym)) || ! NILP (system_flag))
560 return;
561
562 insert (" (", 5);
563 name = SYMBOL_NAME (sym);
564 Fprin1 (name, stream);
565 insert (" ", 1);
566 Fprin1 (SYMBOL_VALUE (sym), stream);
567 insert (" ", 1);
568 Fprin1 (XSYMBOL (sym)->function, stream);
569 insert (" ", 1);
570 Fprin1 (count, stream);
571 insert (")\n", 2);
572}
573
574static void
575describe_abbrev (sym, stream)
576 Lisp_Object sym, stream;
577{
578 Lisp_Object one, count, system_flag;
579
580 if (INTEGERP (XSYMBOL (sym)->plist))
581 {
582 count = XSYMBOL (sym)->plist;
583 system_flag = Qnil;
584 }
585 else
586 {
587 count = Fget (sym, Qcount);
588 system_flag = Fget (sym, Qsystem_type);
589 }
590
591 if (NILP (SYMBOL_VALUE (sym)))
592 return;
593
594 one = make_number (1);
595 Fprin1 (Fsymbol_name (sym), stream);
596
597 if (!NILP (system_flag))
598 {
599 insert_string (" (sys)");
600 Findent_to (make_number (20), one);
601 }
602 else
603 Findent_to (make_number (15), one);
604
605 Fprin1 (count, stream);
606 Findent_to (make_number (20), one);
607 Fprin1 (SYMBOL_VALUE (sym), stream);
608 if (!NILP (XSYMBOL (sym)->function))
609 {
610 Findent_to (make_number (45), one);
611 Fprin1 (XSYMBOL (sym)->function, stream);
612 }
613 Fterpri (stream);
614}
615
616static void
617record_symbol (sym, list)
618 Lisp_Object sym, list;
619{
620 XSETCDR (list, Fcons (sym, XCDR (list)));
621}
622
623DEFUN ("insert-abbrev-table-description", Finsert_abbrev_table_description,
624 Sinsert_abbrev_table_description, 1, 2, 0,
625 doc: /* Insert before point a full description of abbrev table named NAME.
626NAME is a symbol whose value is an abbrev table.
627If optional 2nd arg READABLE is non-nil, a human-readable description
628is inserted. Otherwise the description is an expression,
629a call to `define-abbrev-table', which would
630define the abbrev table NAME exactly as it is currently defined.
631
632Abbrevs marked as "system abbrevs" are normally omitted. However, if
633READABLE is non-nil, they are listed. */)
634 (name, readable)
635 Lisp_Object name, readable;
636{
637 Lisp_Object table;
638 Lisp_Object symbols;
639 Lisp_Object stream;
640
641 CHECK_SYMBOL (name);
642 table = Fsymbol_value (name);
643 CHECK_VECTOR (table);
644
645 XSETBUFFER (stream, current_buffer);
646
647 symbols = Fcons (Qnil, Qnil);
648 map_obarray (table, record_symbol, symbols);
649 symbols = XCDR (symbols);
650 symbols = Fsort (symbols, Qstring_lessp);
651
652 if (!NILP (readable))
653 {
654 insert_string ("(");
655 Fprin1 (name, stream);
656 insert_string (")\n\n");
657 while (! NILP (symbols))
658 {
659 describe_abbrev (XCAR (symbols), stream);
660 symbols = XCDR (symbols);
661 }
662
663 insert_string ("\n\n");
664 }
665 else
666 {
667 insert_string ("(define-abbrev-table '");
668 Fprin1 (name, stream);
669 insert_string (" '(\n");
670 while (! NILP (symbols))
671 {
672 write_abbrev (XCAR (symbols), stream);
673 symbols = XCDR (symbols);
674 }
675 insert_string (" ))\n\n");
676 }
677
678 return Qnil;
679}
680
681DEFUN ("define-abbrev-table", Fdefine_abbrev_table, Sdefine_abbrev_table,
682 2, 2, 0,
683 doc: /* Define TABLENAME (a symbol) as an abbrev table name.
684Define abbrevs in it according to DEFINITIONS, which is a list of elements
685of the form (ABBREVNAME EXPANSION HOOK USECOUNT SYSTEMFLAG).
686\(If the list is shorter than that, omitted elements default to nil). */)
687 (tablename, definitions)
688 Lisp_Object tablename, definitions;
689{
690 Lisp_Object name, exp, hook, count;
691 Lisp_Object table, elt, sys;
692
693 CHECK_SYMBOL (tablename);
694 table = Fboundp (tablename);
695 if (NILP (table) || (table = Fsymbol_value (tablename), NILP (table)))
696 {
697 table = Fmake_abbrev_table ();
698 Fset (tablename, table);
699 Vabbrev_table_name_list = Fcons (tablename, Vabbrev_table_name_list);
700 }
701 CHECK_VECTOR (table);
702
703 for (; CONSP (definitions); definitions = XCDR (definitions))
704 {
705 elt = XCAR (definitions);
706 name = Fcar (elt); elt = Fcdr (elt);
707 exp = Fcar (elt); elt = Fcdr (elt);
708 hook = Fcar (elt); elt = Fcdr (elt);
709 count = Fcar (elt); elt = Fcdr (elt);
710 sys = Fcar (elt);
711 Fdefine_abbrev (table, name, exp, hook, count, sys);
712 }
713 return Qnil;
714}
715
716void
717syms_of_abbrev ()
718{
719 Qsystem_type = intern ("system-type");
720 staticpro (&Qsystem_type);
721
722 Qcount = intern ("count");
723 staticpro (&Qcount);
724
725 Qforce = intern ("force");
726 staticpro (&Qforce);
727
728 DEFVAR_LISP ("abbrev-table-name-list", &Vabbrev_table_name_list,
729 doc: /* List of symbols whose values are abbrev tables. */);
730 Vabbrev_table_name_list = Fcons (intern ("fundamental-mode-abbrev-table"),
731 Fcons (intern ("global-abbrev-table"),
732 Qnil));
733
734 DEFVAR_LISP ("global-abbrev-table", &Vglobal_abbrev_table,
735 doc: /* The abbrev table whose abbrevs affect all buffers.
736Each buffer may also have a local abbrev table.
737If it does, the local table overrides the global one
738for any particular abbrev defined in both. */);
739 Vglobal_abbrev_table = Fmake_abbrev_table ();
740
741 DEFVAR_LISP ("fundamental-mode-abbrev-table", &Vfundamental_mode_abbrev_table,
742 doc: /* The abbrev table of mode-specific abbrevs for Fundamental Mode. */);
743 Vfundamental_mode_abbrev_table = Fmake_abbrev_table ();
744 current_buffer->abbrev_table = Vfundamental_mode_abbrev_table;
745 buffer_defaults.abbrev_table = Vfundamental_mode_abbrev_table;
746
747 DEFVAR_LISP ("last-abbrev", &Vlast_abbrev,
748 doc: /* The abbrev-symbol of the last abbrev expanded. See `abbrev-symbol'. */);
749
750 DEFVAR_LISP ("last-abbrev-text", &Vlast_abbrev_text,
751 doc: /* The exact text of the last abbrev expanded.
752A value of nil means the abbrev has already been unexpanded. */);
753
754 DEFVAR_INT ("last-abbrev-location", &last_abbrev_point,
755 doc: /* The location of the start of the last abbrev expanded. */);
756
757 Vlast_abbrev = Qnil;
758 Vlast_abbrev_text = Qnil;
759 last_abbrev_point = 0;
760
761 DEFVAR_LISP ("abbrev-start-location", &Vabbrev_start_location,
762 doc: /* Buffer position for `expand-abbrev' to use as the start of the abbrev.
763When nil, use the word before point as the abbrev.
764Calling `expand-abbrev' sets this to nil. */);
765 Vabbrev_start_location = Qnil;
766
767 DEFVAR_LISP ("abbrev-start-location-buffer", &Vabbrev_start_location_buffer,
768 doc: /* Buffer that `abbrev-start-location' has been set for.
769Trying to expand an abbrev in any other buffer clears `abbrev-start-location'. */);
770 Vabbrev_start_location_buffer = Qnil;
771
772 DEFVAR_BOOL ("abbrevs-changed", &abbrevs_changed,
773 doc: /* Set non-nil by defining or altering any word abbrevs.
774This causes `save-some-buffers' to offer to save the abbrevs. */);
775 abbrevs_changed = 0;
776
777 DEFVAR_BOOL ("abbrev-all-caps", &abbrev_all_caps,
778 doc: /* *Set non-nil means expand multi-word abbrevs all caps if abbrev was so. */);
779 abbrev_all_caps = 0;
780
781 DEFVAR_LISP ("pre-abbrev-expand-hook", &Vpre_abbrev_expand_hook,
782 doc: /* Function or functions to be called before abbrev expansion is done.
783This is the first thing that `expand-abbrev' does, and so this may change
784the current abbrev table before abbrev lookup happens. */);
785 Vpre_abbrev_expand_hook = Qnil;
786 Qpre_abbrev_expand_hook = intern ("pre-abbrev-expand-hook");
787 staticpro (&Qpre_abbrev_expand_hook);
788
789 defsubr (&Smake_abbrev_table);
790 defsubr (&Sclear_abbrev_table);
791 defsubr (&Sdefine_abbrev);
792 defsubr (&Sdefine_global_abbrev);
793 defsubr (&Sdefine_mode_abbrev);
794 defsubr (&Sabbrev_expansion);
795 defsubr (&Sabbrev_symbol);
796 defsubr (&Sexpand_abbrev);
797 defsubr (&Sunexpand_abbrev);
798 defsubr (&Sinsert_abbrev_table_description);
799 defsubr (&Sdefine_abbrev_table);
800}
801
802/* arch-tag: b721db69-f633-44a8-a361-c275acbdad7d
803 (do not change this comment) */
diff --git a/src/emacs.c b/src/emacs.c
index 9fbb0b32707..2d47114e16d 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -1543,7 +1543,6 @@ main (argc, argv
1543 syms_of_fns (); 1543 syms_of_fns ();
1544 syms_of_floatfns (); 1544 syms_of_floatfns ();
1545 1545
1546 syms_of_abbrev ();
1547 syms_of_buffer (); 1546 syms_of_buffer ();
1548 syms_of_bytecode (); 1547 syms_of_bytecode ();
1549 syms_of_callint (); 1548 syms_of_callint ();
diff --git a/src/image.c b/src/image.c
index 33d5e1a9b2d..91be3f4b57e 100644
--- a/src/image.c
+++ b/src/image.c
@@ -733,9 +733,9 @@ Lisp_Object Qxbm;
733/* Keywords. */ 733/* Keywords. */
734 734
735extern Lisp_Object QCwidth, QCheight, QCforeground, QCbackground, QCfile; 735extern Lisp_Object QCwidth, QCheight, QCforeground, QCbackground, QCfile;
736extern Lisp_Object QCdata, QCtype, Qcount; 736extern Lisp_Object QCdata, QCtype;
737extern Lisp_Object Qcenter; 737extern Lisp_Object Qcenter;
738Lisp_Object QCascent, QCmargin, QCrelief; 738Lisp_Object QCascent, QCmargin, QCrelief, Qcount;
739Lisp_Object QCconversion, QCcolor_symbols, QCheuristic_mask; 739Lisp_Object QCconversion, QCcolor_symbols, QCheuristic_mask;
740Lisp_Object QCindex, QCmatrix, QCcolor_adjustment, QCmask; 740Lisp_Object QCindex, QCmatrix, QCcolor_adjustment, QCmask;
741 741
@@ -9089,6 +9089,9 @@ non-numeric, there is no explicit limit on the size of images. */);
9089 define_image_type (&xbm_type, 1); 9089 define_image_type (&xbm_type, 1);
9090 define_image_type (&pbm_type, 1); 9090 define_image_type (&pbm_type, 1);
9091 9091
9092 Qcount = intern ("count");
9093 staticpro (&Qcount);
9094
9092 QCascent = intern (":ascent"); 9095 QCascent = intern (":ascent");
9093 staticpro (&QCascent); 9096 staticpro (&QCascent);
9094 QCmargin = intern (":margin"); 9097 QCmargin = intern (":margin");
diff --git a/src/puresize.h b/src/puresize.h
index f5b675055b8..bf4971a0b5f 100644
--- a/src/puresize.h
+++ b/src/puresize.h
@@ -43,7 +43,7 @@ Boston, MA 02110-1301, USA. */
43#endif 43#endif
44 44
45#ifndef BASE_PURESIZE 45#ifndef BASE_PURESIZE
46#define BASE_PURESIZE (1170000 + SYSTEM_PURESIZE_EXTRA + SITELOAD_PURESIZE_EXTRA) 46#define BASE_PURESIZE (1180000 + SYSTEM_PURESIZE_EXTRA + SITELOAD_PURESIZE_EXTRA)
47#endif 47#endif
48 48
49/* Increase BASE_PURESIZE by a ratio depending on the machine's word size. */ 49/* Increase BASE_PURESIZE by a ratio depending on the machine's word size. */