;;; abbrev.el --- abbrev mode commands for Emacs
;; Copyright (C) 1985, 1986, 1987, 1992, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007 Free Software Foundation, Inc.
+;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: abbrev convenience
:group 'abbrev-mode
:group 'convenience)
-(defun abbrev-mode (&optional arg)
+(define-minor-mode abbrev-mode
"Toggle Abbrev mode in the current buffer.
With optional argument ARG, turn abbrev mode on if ARG is
positive, otherwise turn it off. In Abbrev mode, inserting an
-abbreviation causes it to expand and be replaced by its expansion."
- (interactive "P")
- (setq abbrev-mode
- (if (null arg) (not abbrev-mode)
- (> (prefix-numeric-value arg) 0)))
- (force-mode-line-update))
+abbreviation causes it to expand and be replaced by its expansion.")
(defcustom abbrev-mode nil
"Enable or disable Abbrev mode.
to enable or disable Abbrev mode in the current buffer."
:type 'boolean
:group 'abbrev-mode)
-;;;###autoload(put 'abbrev-mode 'safe-local-variable 'booleanp)
+(put 'abbrev-mode 'safe-local-variable 'booleanp)
\f
(defvar edit-abbrevs-map
(defun kill-all-abbrevs ()
"Undefine all defined abbrevs."
(interactive)
- (let ((tables abbrev-table-name-list))
- (while tables
- (clear-abbrev-table (symbol-value (car tables)))
- (setq tables (cdr tables)))))
+ (dolist (tablesym abbrev-table-name-list)
+ (clear-abbrev-table (symbol-value tablesym))))
(defun copy-abbrev-table (table)
"Make a new abbrev-table with the same abbrevs as TABLE."
(interactive)
(push-mark
(save-excursion
- (let ((tables abbrev-table-name-list))
- (while tables
- (insert-abbrev-table-description (car tables) t)
- (setq tables (cdr tables))))
+ (dolist (tablesym abbrev-table-name-list)
+ (insert-abbrev-table-description tablesym t))
(point))))
(defun list-abbrevs (&optional local)
found))
(defun prepare-abbrev-list-buffer (&optional local)
- (save-excursion
- (let ((table local-abbrev-table))
- (set-buffer (get-buffer-create "*Abbrevs*"))
- (erase-buffer)
- (if local
- (insert-abbrev-table-description (abbrev-table-name table) t)
- (dolist (table abbrev-table-name-list)
- (insert-abbrev-table-description table t)))
- (goto-char (point-min))
- (set-buffer-modified-p nil)
- (edit-abbrevs-mode)
- (current-buffer))))
+ (with-current-buffer (get-buffer-create "*Abbrevs*")
+ (erase-buffer)
+ (if local
+ (insert-abbrev-table-description
+ (abbrev-table-name local-abbrev-table) t)
+ (dolist (table abbrev-table-name-list)
+ (insert-abbrev-table-description table t)))
+ (goto-char (point-min))
+ (set-buffer-modified-p nil)
+ (edit-abbrevs-mode)
+ (current-buffer)))
(defun edit-abbrevs-mode ()
"Major mode for editing the list of abbrev definitions.
,(if (symbolp var)
`(if (local-variable-p ',var)
(default-value ',var)))))))
-
+
;;; Code that used to be implemented in src/abbrev.c
(defun make-abbrev-table (&optional props)
"Create a new, empty abbrev table object.
-PROPS is a "
+PROPS is a list of properties."
;; 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
(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)))
+ (let* ((sym (intern-soft "" table)))
+ (dotimes (i (length table))
+ (aset table i 0))
+ ;; Preserve the table's properties.
+ (assert sym)
+ (let ((newsym (intern "" table)))
+ (set newsym nil) ; Make sure it won't be confused for an abbrev.
+ (setplist newsym (symbol-plist sym)))
+ (abbrev-table-put table :abbrev-table-modiff
+ (1+ (abbrev-table-get table :abbrev-table-modiff)))))
(defun define-abbrev (table name expansion &optional hook &rest props)
"Define an abbrev in TABLE named NAME, to expand to EXPANSION and call HOOK.
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).
+- `:count': the value for the abbrev's usage-count, which is incremented each
+ time the abbrev is used (the default is zero).
- `:system': if non-nil, says that this is a \"system\" abbreviation
which should not be saved in the user's abbreviation file.
Unless `:system' 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
+- `:enable-function': a function of no argument which returns non-nil if the
abbrev should be used for a particular call of `expand-abbrev'.
An obsolete but still supported calling form is:
(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.
(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))))
+ (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.
sym)))))))
(if (symbol-value sym)
sym)))
-
+
(defun abbrev-expansion (abbrev &optional table)
"Return the string that ABBREV expands into in the current buffer.
(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))
-
+ (when (> end start)
+ (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)))
(goto-char pos)))
res)))
+(defun abbrev-insert (abbrev &optional name wordstart wordend)
+ "Insert abbrev ABBREV at point.
+If non-nil, NAME is the name by which this abbrev was found.
+If non-nil, WORDSTART is the place where to insert the abbrev.
+If non-nil, WORDEND the abbrev replaces the previous text between
+WORDSTART and WORDEND.
+Return ABBREV if the expansion should be considered as having taken place."
+ (unless name (setq name (symbol-name abbrev)))
+ (unless wordstart (setq wordstart (point)))
+ (unless wordend (setq wordend wordstart))
+ ;; Increment use count.
+ (abbrev-put abbrev :count (1+ (abbrev-get abbrev :count)))
+ (let ((value abbrev))
+ ;; If this abbrev has an expansion, delete the abbrev
+ ;; and insert the expansion.
+ (when (stringp (symbol-value abbrev))
+ (goto-char wordstart)
+ ;; Insert at beginning so that markers at the end (e.g. point)
+ ;; are preserved.
+ (insert (symbol-value abbrev))
+ (delete-char (- wordend wordstart))
+ (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 abbrev)))
+ (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)))
+ (goto-char end))))))
+ ;; Now point is at the end of the expansion and the beginning is
+ ;; in last-abbrev-location.
+ (when (symbol-function abbrev)
+ (let* ((hook (symbol-function abbrev))
+ (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))
+
(defvar abbrev-expand-functions nil
"Wrapper hook around `expand-abbrev'.
The functions on this special hook are called with one argument:
(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)))))
+ (abbrev-insert sym name wordstart wordend))))))
(defun unexpand-abbrev ()
"Undo the expansion of the last abbrev that expanded.
Presumes that `standard-output' points to `current-buffer'."
(unless (or (null (symbol-value sym)) (abbrev-get sym :system))
(insert " (")
- (prin1 name)
+ (prin1 (symbol-name sym))
(insert " ")
(prin1 (symbol-value sym))
(insert " ")
(insert " ))\n\n"))
nil)))
+(put 'define-abbrev-table 'doc-string-elt 3)
(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).
+of the form (ABBREVNAME EXPANSION ...) that are passed to `define-abbrev'.
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
+- `: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'."
+ ;; We used to manually add the docstring, but we also want to record this
+ ;; location as the definition of the variable (in load-history), so we may
+ ;; as well just use `defvar'.
+ (eval `(defvar ,tablename nil ,@(if (stringp docstring) (list docstring))))
(let ((table (if (boundp tablename) (symbol-value tablename))))
(unless table
- (setq table (make-abbrev-table props))
+ (setq table (make-abbrev-table))
(set tablename table)
(push tablename abbrev-table-name-list))
- (when (stringp docstring)
- (put tablename 'variable-documentation docstring))
+ ;; We used to just pass them to `make-abbrev-table', but that fails
+ ;; if the table was pre-existing as is the case if it was created by
+ ;; loading the user's abbrev file.
+ (while (consp props)
+ (abbrev-table-put table (pop props) (pop props)))
(dolist (elt definitions)
(apply 'define-abbrev table elt))))
+(defun abbrev-table-menu (table &optional prompt sortfun)
+ "Return a menu that shows all abbrevs in TABLE.
+Selecting an entry runs `abbrev-insert'.
+PROMPT is the prompt to use for the keymap.
+SORTFUN is passed to `sort' to change the default ordering."
+ (unless sortfun (setq sortfun 'string-lessp))
+ (let ((entries ()))
+ (mapatoms (lambda (abbrev)
+ (when (symbol-value abbrev)
+ (let ((name (symbol-name abbrev)))
+ (push `(,(intern name) menu-item ,name
+ (lambda () (interactive)
+ (abbrev-insert ',abbrev)))
+ entries))))
+ table)
+ (nconc (make-sparse-keymap prompt)
+ (sort entries (lambda (x y)
+ (funcall sortfun (nth 2 x) (nth 2 y)))))))
+
(provide 'abbrev)
;; arch-tag: dbd6f3ae-dfe3-40ba-b00f-f9e3ff960df5