X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/a457417ee5ba797ab1c91d35ee957bb7a7f8d4b6..b1bad9f3d6bcc725d9727c2dc4282c6080447cbf:/lisp/abbrev.el diff --git a/lisp/abbrev.el b/lisp/abbrev.el index 0c140a8415..e8e89e92f4 100644 --- a/lisp/abbrev.el +++ b/lisp/abbrev.el @@ -1,17 +1,17 @@ ;;; 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 ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; 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. +;; the Free Software Foundation, either version 3 of the License, 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 @@ -19,9 +19,7 @@ ;; 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. +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -49,16 +47,11 @@ define global abbrevs instead." :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. @@ -70,7 +63,7 @@ Interactively, use the command `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) (defvar edit-abbrevs-map @@ -83,10 +76,8 @@ to enable or disable Abbrev mode in the current buffer." (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." @@ -106,10 +97,8 @@ Mark is set after the inserted text." (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) @@ -131,18 +120,17 @@ Otherwise display all abbrevs." 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. @@ -444,7 +432,7 @@ This is similar to an `around' advice." (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 @@ -524,8 +512,16 @@ the current abbrev table before abbrev lookup happens." (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. @@ -538,15 +534,15 @@ 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). +- `: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: @@ -721,6 +717,68 @@ then ABBREV is looked up in that table only." (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: @@ -748,56 +806,9 @@ Returns the abbrev symbol, if expansion took place." (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 wordstart) - ;; Insert at beginning so that markers at the end (e.g. point) - ;; are preserved. - (insert (symbol-value sym)) - (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 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))) - (goto-char end)))))) - ;; Now point is at the end of the expansion and the beginning is - ;; in last-abbrev-location. - (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. @@ -813,10 +824,11 @@ is not undone." ;; 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))) + (error "Value of abbrev-symbol must be a string")) ;; Don't inherit properties here; just copy from old contents. (insert last-abbrev-text) + ;; Delete after inserting, to better preserve markers. + (delete-region (point) (+ (point) (length val))) (setq last-abbrev-text nil)))))) (defun abbrev--write (sym) @@ -825,7 +837,7 @@ Only writes the non-system abbrevs. Presumes that `standard-output' points to `current-buffer'." (unless (or (null (symbol-value sym)) (abbrev-get sym :system)) (insert " (") - (prin1 sym) + (prin1 (symbol-name sym)) (insert " ") (prin1 (symbol-value sym)) (insert " ") @@ -877,12 +889,12 @@ Abbrevs marked as \"system abbrevs\" are omitted." (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 @@ -893,20 +905,44 @@ Properties with special meaning: 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'." + non-nil if and only if 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)) + ;; 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