HideIfDef mode bug fixes and enhancements. This is #2 of 3 patches based
[bpt/emacs.git] / lisp / abbrev.el
index 3795dd4..9e11ada 100644 (file)
@@ -1,8 +1,9 @@
 ;;; 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-2014 Free Software Foundation,
+;; Inc.
 
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
 ;; Keywords: abbrev convenience
 ;; Package: emacs
 
@@ -31,7 +32,7 @@
 
 ;;; Code:
 
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
 
 (defgroup abbrev-mode nil
   "Word abbreviations mode."
@@ -54,22 +55,27 @@ 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)
 
 (put 'abbrev-mode 'safe-local-variable 'booleanp)
 
 \f
-(defvar edit-abbrevs-map
+(defvar edit-abbrevs-mode-map
   (let ((map (make-sparse-keymap)))
     (define-key map "\C-x\C-s" 'abbrev-edit-save-buffer)
     (define-key map "\C-x\C-w" 'abbrev-edit-save-to-file)
     (define-key map "\C-c\C-c" 'edit-abbrevs-redefine)
     map)
   "Keymap used in `edit-abbrevs'.")
+(define-obsolete-variable-alias 'edit-abbrevs-map
+  'edit-abbrevs-mode-map "24.4")
 
 (defun kill-all-abbrevs ()
   "Undefine all defined abbrevs."
@@ -78,7 +84,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,25 +137,19 @@ 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 ()
-  "Major mode for editing the list of abbrev definitions.
-\\{edit-abbrevs-map}"
-  (interactive)
-  (kill-all-local-variables)
-  (setq major-mode 'edit-abbrevs-mode)
-  (setq mode-name "Edit-Abbrevs")
-  (use-local-map edit-abbrevs-map)
-  (run-mode-hooks 'edit-abbrevs-mode-hook))
-
 (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-map>\\[edit-abbrevs-redefine] to redefine abbrevs
 according to your editing.
 Buffer contains a header line for each abbrev table,
@@ -159,7 +160,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)
-  (pop-to-buffer-same-window (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 +194,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)))
@@ -414,7 +421,7 @@ A prefix argument means don't query; expand all abbrevs."
 \(fn ABBREV PROP)")
 
 (defalias 'abbrev-put 'put
-  "Set the property PROP of abbrev ABREV to value VAL.
+  "Set the property PROP of abbrev ABBREV to value VAL.
 See `define-abbrev' for the effect of some special properties.
 
 \(fn ABBREV PROP VAL)")
@@ -443,6 +450,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 +476,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 +524,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 +533,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 +553,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 +576,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))
@@ -573,7 +588,7 @@ An obsolete but still supported calling form is:
                  (boundp sym) (symbol-value sym)
                  (not (abbrev-get sym :system)))
       (unless (or system-flag
-                  (and (boundp sym) (fboundp sym)
+                  (and (boundp sym)
                        ;; load-file-name
                        (equal (symbol-value sym) expansion)
                        (equal (symbol-function sym) hook)))
@@ -592,14 +607,14 @@ An obsolete but still supported calling form is:
   "Check if the characters in ABBREV have word syntax in either the
 current (if global is nil) or standard syntax table."
   (with-syntax-table
-      (cond ((null global) (standard-syntax-table))
+      (cond ((null global) (syntax-table))
             ;; ((syntax-table-p global) global)
-            (t (syntax-table)))
+            (t (standard-syntax-table)))
     (when (string-match "\\W" abbrev)
       (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 +661,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 +690,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 +748,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 +765,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,26 +824,36 @@ 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 `abbrev--default-expand'.")
+(make-obsolete-variable 'abbrev-expand-functions 'abbrev-expand-function "24.4")
+
+(defvar abbrev-expand-function #'abbrev--default-expand
+  "Function that `expand-abbrev' uses 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."
+Before doing anything else, runs `pre-abbrev-expand-hook'.
+Calls `abbrev-expand-function' with no argument to do the work,
+and returns whatever it does.  (This should be the abbrev symbol
+if expansion occurred, else nil.)"
   (interactive)
   (run-hooks 'pre-abbrev-expand-hook)
+  (funcall abbrev-expand-function))
+
+(defun abbrev--default-expand ()
+  "Default function to use for `abbrev-expand-function'.
+This respects the wrapper hook `abbrev-expand-functions'.
+Calls `abbrev-insert' to insert any expansion, and returns what it does."
   (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
         (let ((startpos (copy-marker (point) t))
               (endmark (copy-marker wordend t)))
           (unless (or ;; executing-kbd-macro
                    noninteractive
-                   (window-minibuffer-p (selected-window)))
+                   (window-minibuffer-p))
             ;; Add an undo boundary, in case we are doing this for
             ;; a self-inserting command which has avoided making one so far.
             (undo-boundary))
@@ -930,9 +965,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'."
@@ -973,6 +1010,11 @@ SORTFUN is passed to `sort' to change the default ordering."
            (sort entries (lambda (x y)
                 (funcall sortfun (nth 2 x) (nth 2 y)))))))
 
+;; Keep it after define-abbrev-table, since define-derived-mode uses
+;; define-abbrev-table.
+(define-derived-mode edit-abbrevs-mode fundamental-mode "Edit-Abbrevs"
+  "Major mode for editing the list of abbrev definitions.")
+
 (provide 'abbrev)
 
 ;;; abbrev.el ends here