X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/99a33b77e15b9a075024701d060d912b2fd87caf..368a85a4dbc324c90b2f3338fc97cc73b4c53222:/lisp/abbrev.el diff --git a/lisp/abbrev.el b/lisp/abbrev.el index b2cd2064da..27cd7089a0 100644 --- a/lisp/abbrev.el +++ b/lisp/abbrev.el @@ -1,6 +1,7 @@ ;;; abbrev.el --- abbrev mode commands for Emacs -*- lexical-binding: t -*- -;; Copyright (C) 1985-1987, 1992, 2001-2011 Free Software Foundation, Inc. +;; Copyright (C) 1985-1987, 1992, 2001-2013 Free Software Foundation, +;; Inc. ;; Maintainer: FSF ;; Keywords: abbrev convenience @@ -31,7 +32,7 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (defgroup abbrev-mode nil "Word abbreviations mode." @@ -54,9 +55,12 @@ define global abbrevs instead." (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." +With a prefix argument ARG, enable Abbrev mode if ARG is +positive, and disable it otherwise. If called from Lisp, enable +Abbrev mode if ARG is omitted or nil. + +In Abbrev mode, inserting an abbreviation causes it to expand and +be replaced by its expansion." ;; It's defined in C, this stops the d-m-m macro defining it again. :variable abbrev-mode) @@ -78,7 +82,8 @@ abbreviation causes it to expand and be replaced by its expansion." (clear-abbrev-table (symbol-value tablesym)))) (defun copy-abbrev-table (table) - "Make a new abbrev-table with the same abbrevs as TABLE." + "Make a new abbrev-table with the same abbrevs as TABLE. +Does not copy property lists." (let ((new-table (make-abbrev-table))) (mapatoms (lambda (symbol) @@ -130,10 +135,13 @@ Otherwise display all abbrevs." (push table empty-tables) (insert-abbrev-table-description table t))) (dolist (table (nreverse empty-tables)) - (insert-abbrev-table-description table t)))) + (insert-abbrev-table-description table t))) + ;; Note: `list-abbrevs' can display only local abbrevs, in + ;; which case editing could lose abbrevs of other tables. Thus + ;; enter `edit-abbrevs-mode' only if LOCAL is nil. + (edit-abbrevs-mode)) (goto-char (point-min)) (set-buffer-modified-p nil) - (edit-abbrevs-mode) (current-buffer)))) (defun edit-abbrevs-mode () @@ -148,7 +156,8 @@ Otherwise display all abbrevs." (defun edit-abbrevs () "Alter abbrev definitions by editing a list of them. -Selects a buffer containing a list of abbrev definitions. +Selects a buffer containing a list of abbrev definitions with +point located in the abbrev table of current buffer. You can edit them and type \\\\[edit-abbrevs-redefine] to redefine abbrevs according to your editing. Buffer contains a header line for each abbrev table, @@ -159,7 +168,12 @@ where NAME and EXPANSION are strings with quotes, USECOUNT is an integer, and HOOK is any valid function or may be omitted (it is usually omitted)." (interactive) - (switch-to-buffer (prepare-abbrev-list-buffer))) + (let ((table-name (abbrev-table-name local-abbrev-table))) + (switch-to-buffer (prepare-abbrev-list-buffer)) + (when (and table-name + (search-forward + (concat "(" (symbol-name table-name) ")\n\n") nil t)) + (goto-char (match-end 0))))) (defun edit-abbrevs-redefine () "Redefine abbrevs according to current buffer contents." @@ -188,7 +202,8 @@ the ones defined from the buffer now." (not (eolp))) (setq name (read buf) count (read buf)) (if (equal count '(sys)) - (setq sys t count (read buf))) + (setq sys t count (read buf)) + (setq sys nil)) (setq exp (read buf)) (skip-chars-backward " \t\n\f") (setq hook (if (not (eolp)) (read buf))) @@ -443,6 +458,7 @@ PROPS is a list of properties." table)) (defun abbrev-table-p (object) + "Return non-nil if OBJECT is an abbrev table." (and (vectorp object) (numberp (abbrev-table-get object :abbrev-table-modiff)))) @@ -468,7 +484,8 @@ for any particular abbrev defined in both.") (defvar abbrev-minor-mode-table-alist nil "Alist of abbrev tables to use for minor modes. Each element looks like (VARIABLE . ABBREV-TABLE); -ABBREV-TABLE is active whenever VARIABLE's value is non-nil.") +ABBREV-TABLE is active whenever VARIABLE's value is non-nil. +ABBREV-TABLE can also be a list of abbrev tables.") (defvar fundamental-mode-abbrev-table (let ((table (make-abbrev-table))) @@ -515,7 +532,7 @@ This is the first thing that `expand-abbrev' does, and so this may change the current abbrev table before abbrev lookup happens." :type 'hook :group 'abbrev-mode) -(make-obsolete-variable 'pre-abbrev-expand-hook 'abbrev-expand-functions "23.1") +(make-obsolete-variable 'pre-abbrev-expand-hook 'abbrev-expand-function "23.1") (defun clear-abbrev-table (table) "Undefine all abbrevs in abbrev table TABLE, leaving it empty." @@ -524,7 +541,7 @@ the current abbrev table before abbrev lookup happens." (dotimes (i (length table)) (aset table i 0)) ;; Preserve the table's properties. - (assert sym) + (cl-assert sym) (let ((newsym (intern "" table))) (set newsym nil) ; Make sure it won't be confused for an abbrev. (setplist newsym (symbol-plist sym))) @@ -544,6 +561,12 @@ 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. +If HOOK is a non-nil symbol with a non-nil `no-self-insert' property, +it can control whether the character that triggered abbrev expansion +is inserted. If such a HOOK returns non-nil, the character is not +inserted. If such a HOOK returns nil, then so does `abbrev-insert' +\(and `expand-abbrev'), as if no abbrev expansion had taken place. + 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). @@ -561,8 +584,8 @@ An obsolete but still supported calling form is: \(define-abbrev TABLE NAME EXPANSION &optional HOOK COUNT SYSTEM)." (when (and (consp props) (or (null (car props)) (numberp (car props)))) ;; Old-style calling convention. - (setq props (list* :count (car props) - (if (cadr props) (list :system (cadr props)))))) + (setq props `(:count ,(car props) + ,@(if (cadr props) (list :system (cadr props)))))) (unless (plist-get props :count) (setq props (plist-put props :count 0))) (let ((system-flag (plist-get props :system)) @@ -599,7 +622,7 @@ current (if global is nil) or standard syntax table." (let ((badchars ()) (pos 0)) (while (string-match "\\W" abbrev pos) - (pushnew (aref abbrev (match-beginning 0)) badchars) + (cl-pushnew (aref abbrev (match-beginning 0)) badchars) (setq pos (1+ pos))) (error "Some abbrev characters (%s) are not word constituents %s" (apply 'string (nreverse badchars)) @@ -646,6 +669,26 @@ either a single abbrev table or a list of abbrev tables." tables)))) +(defun abbrev--symbol (abbrev table) + "Return the symbol representing abbrev named ABBREV in TABLE. +This symbol's name is ABBREV, but it is not the canonical symbol of that name; +it is interned in the abbrev-table TABLE rather than the normal obarray. +The value is nil if that abbrev is not defined." + (let* ((case-fold (not (abbrev-table-get table :case-fixed))) + ;; In case the table doesn't set :case-fixed but some of the + ;; abbrevs do, we have to be careful. + (sym + ;; First try without case-folding. + (or (intern-soft abbrev table) + (when case-fold + ;; We didn't find any abbrev, try case-folding. + (let ((sym (intern-soft (downcase abbrev) table))) + ;; Only use it if it doesn't require :case-fixed. + (and sym (not (abbrev-get sym :case-fixed)) + sym)))))) + (if (symbol-value sym) + sym))) + (defun abbrev-symbol (abbrev &optional table) "Return the symbol representing abbrev named ABBREV. This symbol's name is ABBREV, but it is not the canonical symbol of that name; @@ -655,23 +698,11 @@ Optional second arg TABLE is abbrev table to look it up in. The default is to try buffer's mode-specific abbrev table, then global table." (let ((tables (abbrev--active-tables table)) sym) - (while (and tables (not (symbol-value sym))) - (let* ((table (pop tables)) - (case-fold (not (abbrev-table-get table :case-fixed)))) + (while (and tables (not sym)) + (let* ((table (pop tables))) (setq tables (append (abbrev-table-get table :parents) tables)) - ;; In case the table doesn't set :case-fixed but some of the - ;; abbrevs do, we have to be careful. - (setq sym - ;; First try without case-folding. - (or (intern-soft abbrev table) - (when case-fold - ;; We didn't find any abbrev, try case-folding. - (let ((sym (intern-soft (downcase abbrev) table))) - ;; Only use it if it doesn't require :case-fixed. - (and sym (not (abbrev-get sym :case-fixed)) - sym))))))) - (if (symbol-value sym) - sym))) + (setq sym (abbrev--symbol abbrev table)))) + sym)) (defun abbrev-expansion (abbrev &optional table) @@ -725,7 +756,7 @@ then ABBREV is looked up in that table only." (setq start (match-beginning 1)) (setq end (match-end 1))))) (setq name (buffer-substring start end)) - (let ((abbrev (abbrev-symbol name table))) + (let ((abbrev (abbrev--symbol name table))) (when abbrev (setq enable-fun (abbrev-get abbrev :enable-function)) (and (or (not enable-fun) (funcall enable-fun)) @@ -742,7 +773,9 @@ 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." +Return ABBREV if the expansion should be considered as having taken place. +The return value can be influenced by a `no-self-insert' property; +see `define-abbrev' for details." (unless name (setq name (symbol-name abbrev))) (unless wordstart (setq wordstart (point))) (unless wordend (setq wordend wordstart)) @@ -799,34 +832,48 @@ Return ABBREV if the expansion should be considered as having taken place." value)) (defvar abbrev-expand-functions nil - "Wrapper hook around `expand-abbrev'. -The functions on this special hook are called with one argument: -a function that performs the abbrev expansion. It should return -the abbrev symbol if expansion took place.") + "Wrapper hook around `expand-abbrev'.") +(make-obsolete-variable 'abbrev-expand-functions 'abbrev-expand-function "24.4") + +(defvar abbrev-expand-function #'abbrev--default-expand + "Function to perform abbrev expansion. +Takes no argument and should return the abbrev symbol if expansion took place.") (defun expand-abbrev () "Expand the abbrev before point, if there is an abbrev there. Effective when explicitly called even when `abbrev-mode' is nil. -Returns the abbrev symbol, if expansion took place." +Returns the abbrev symbol, if expansion took place. (The actual +return value is that of `abbrev-insert'.)" (interactive) (run-hooks 'pre-abbrev-expand-hook) + (funcall abbrev-expand-function)) + +(defun abbrev--default-expand () (with-wrapper-hook abbrev-expand-functions () - (destructuring-bind (&optional sym name wordstart wordend) - (abbrev--before-point) + (pcase-let ((`(,sym ,name ,wordstart ,wordend) (abbrev--before-point))) (when sym - (unless (or ;; executing-kbd-macro - noninteractive - (window-minibuffer-p (selected-window))) - ;; Add an undo boundary, in case we are doing this for - ;; a self-inserting command which has avoided making one so far. - (undo-boundary)) - ;; Now sym is the abbrev symbol. - (setq last-abbrev-text name) - (setq last-abbrev sym) - (setq last-abbrev-location wordstart) - ;; If this abbrev has an expansion, delete the abbrev - ;; and insert the expansion. - (abbrev-insert sym name wordstart wordend))))) + (let ((startpos (copy-marker (point) t)) + (endmark (copy-marker wordend t))) + (unless (or ;; executing-kbd-macro + noninteractive + (window-minibuffer-p (selected-window))) + ;; Add an undo boundary, in case we are doing this for + ;; a self-inserting command which has avoided making one so far. + (undo-boundary)) + ;; Now sym is the abbrev symbol. + (setq last-abbrev-text name) + (setq last-abbrev sym) + (setq last-abbrev-location wordstart) + ;; If this abbrev has an expansion, delete the abbrev + ;; and insert the expansion. + (prog1 + (abbrev-insert sym name wordstart wordend) + ;; Yuck!! If expand-abbrev is called with point slightly + ;; further than the end of the abbrev, move point back to + ;; where it started. + (if (and (> startpos endmark) + (= (point) endmark)) ;Obey skeletons that move point. + (goto-char startpos)))))))) (defun unexpand-abbrev () "Undo the expansion of the last abbrev that expanded. @@ -921,9 +968,11 @@ Properties with special meaning: abbreviations. - `:case-fixed' non-nil means that abbreviations are looked up without case-folding, and the expansion is not capitalized/upcased. -- `:regexp' describes the form of abbrevs. It defaults to \\=\\<\\(\\w+\\)\\W* which - means that an abbrev can only be a single word. The submatch 1 is treated - as the potential name of an abbrev. +- `:regexp' is a regular expression that specifies how to extract the + name of the abbrev before point. The submatch 1 is treated + as the potential name of an abbrev. If :regexp is nil, the default + behavior uses `backward-word' and `forward-word' to extract the name + of the abbrev, which can therefore only be a single word. - `:enable-function' can be set to a function of no argument which returns non-nil if and only if the abbrevs in this table should be used for this instance of `expand-abbrev'." @@ -935,7 +984,8 @@ Properties with special meaning: (unless table (setq table (make-abbrev-table)) (set tablename table) - (push tablename abbrev-table-name-list)) + (unless (memq tablename abbrev-table-name-list) + (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.