X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/94cc397c541f50af6b049af6c42806daa2be2709..398a825b8d994882672906103f330ad8662d1ed6:/lisp/abbrev.el diff --git a/lisp/abbrev.el b/lisp/abbrev.el index 5cdd2d0aa8..b72bdbb812 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, 2008 Free Software Foundation, Inc. +;; 2005, 2006, 2007, 2008, 2009, 2010 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: @@ -29,7 +27,6 @@ ;; Todo: -;; - Make abbrev-file-name obey user-emacs-directory. ;; - Cleanup name space. ;;; Code: @@ -41,6 +38,12 @@ :link '(custom-manual "(emacs)Abbrevs") :group 'abbrev) +(defcustom abbrev-file-name + (locate-user-emacs-file "abbrev_defs" ".abbrev_defs") + "Default name of file from which to read abbrevs." + :initialize 'custom-initialize-delay + :type 'file) + (defcustom only-global-abbrevs nil "Non-nil means user plans to use global abbrevs only. This makes the commands that normally define mode-specific abbrevs @@ -49,16 +52,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 +68,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 @@ -394,43 +392,6 @@ See `define-abbrev' for the effect of some special properties. \(fn ABBREV PROP VAL)") -(defmacro abbrev-with-wrapper-hook (var &rest body) - "Run BODY wrapped with the VAR hook. -VAR is a special hook: its functions are called with one argument which -is the \"original\" code (the BODY), so the hook function can wrap the -original function, can call it several times, or even not call it at all. -VAR is normally a symbol (a variable) in which case it is treated like a hook, -with a buffer-local and a global part. But it can also be an arbitrary expression. -This is similar to an `around' advice." - (declare (indent 1) (debug t)) - ;; We need those two gensyms because CL's lexical scoping is not available - ;; for function arguments :-( - (let ((funs (make-symbol "funs")) - (global (make-symbol "global"))) - ;; Since the hook is a wrapper, the loop has to be done via - ;; recursion: a given hook function will call its parameter in order to - ;; continue looping. - `(labels ((runrestofhook (,funs ,global) - ;; `funs' holds the functions left on the hook and `global' - ;; holds the functions left on the global part of the hook - ;; (in case the hook is local). - (lexical-let ((funs ,funs) - (global ,global)) - (if (consp funs) - (if (eq t (car funs)) - (runrestofhook (append global (cdr funs)) nil) - (funcall (car funs) - (lambda () (runrestofhook (cdr funs) global)))) - ;; Once there are no more functions on the hook, run - ;; the original body. - ,@body)))) - (runrestofhook ,var - ;; The global part of the hook, if any. - ,(if (symbolp var) - `(if (local-variable-p ',var) - (default-value ',var))))))) - - ;;; Code that used to be implemented in src/abbrev.c (defvar abbrev-table-name-list '(fundamental-mode-abbrev-table @@ -439,7 +400,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 @@ -528,7 +489,9 @@ the current abbrev table before abbrev lookup happens." (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))))) + (1+ (abbrev-table-get table :abbrev-table-modiff)))) + ;; For backward compatibility, always return nil. + nil) (defun define-abbrev (table name expansion &optional hook &rest props) "Define an abbrev in TABLE named NAME, to expand to EXPANSION and call HOOK. @@ -537,19 +500,20 @@ EXPANSION should usually be a string. To undefine an abbrev, define it with EXPANSION = nil. If HOOK is non-nil, it should be a function of no arguments; it is called after EXPANSION is inserted. -If EXPANSION is not a string, the abbrev is a special one, - which does not expand in the usual way but only runs HOOK. +If EXPANSION is not a string (and not nil), 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: @@ -707,11 +671,19 @@ then ABBREV is looked up in that table only." (setq tables (append (abbrev-table-get table :parents) tables)) (setq res (and (or (not enable-fun) (funcall enable-fun)) - (looking-back (or (abbrev-table-get table :regexp) - "\\<\\(\\w+\\)\\W*") - (line-beginning-position)) - (setq start (match-beginning 1)) - (setq end (match-end 1)) + (let ((re (abbrev-table-get table :regexp))) + (if (null re) + ;; We used to default `re' to "\\<\\(\\w+\\)\\W*" + ;; but when words-include-escapes is set, that + ;; is not right and fixing it is boring. + (let ((lim (point))) + (backward-word 1) + (setq start (point)) + (forward-word 1) + (setq end (min (point) lim))) + (when (looking-back re (line-beginning-position)) + (setq start (match-beginning 1)) + (setq end (match-end 1))))) (setq name (buffer-substring start end)) (let ((abbrev (abbrev-symbol name table))) (when abbrev @@ -724,6 +696,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 WORDEND is non-nil, 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: @@ -736,7 +770,7 @@ Effective when explicitly called even when `abbrev-mode' is nil. Returns the abbrev symbol, if expansion took place." (interactive) (run-hooks 'pre-abbrev-expand-hook) - (abbrev-with-wrapper-hook abbrev-expand-functions + (with-wrapper-hook abbrev-expand-functions () (destructuring-bind (&optional sym name wordstart wordend) (abbrev--before-point) (when sym @@ -751,56 +785,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. @@ -816,10 +803,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) @@ -875,17 +863,19 @@ Abbrevs marked as \"system abbrevs\" are omitted." (insert "\n\n")) (insert "(define-abbrev-table '") (prin1 name) - (insert " '(") - (mapc 'abbrev--write symbols) - (insert " ))\n\n")) + (if (null symbols) + (insert " '())\n\n") + (insert "\n '(\n") + (mapc 'abbrev--write symbols) + (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 @@ -896,20 +886,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