HideIfDef mode bug fixes and enhancements. This is #2 of 3 patches based

[bpt/emacs.git] / lisp / abbrev.el

diff --git a/lisp/abbrev.el b/lisp/abbrev.el
index ade36f2..9e11ada 100644 (file)
--- a/lisp/abbrev.el
+++ b/lisp/abbrev.el
@@ -1,8 +1,9 @@
 ;;; abbrev.el --- abbrev mode commands for Emacs -*- lexical-binding: t -*-
 
 ;;; abbrev.el --- abbrev mode commands for Emacs -*- lexical-binding: t -*-
 

-;; Copyright (C) 1985-1987, 1992, 2001-2012  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
 
 ;; Keywords: abbrev convenience
 ;; Package: emacs
 


@@ -31,7 +32,7 @@
 
 ;;; Code:
 
 
 ;;; Code:
 

-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))

 
 (defgroup abbrev-mode nil
   "Word abbreviations mode."
 
 (defgroup abbrev-mode nil
   "Word abbreviations mode."


@@ -66,13 +67,15 @@ be replaced by its expansion."
 (put 'abbrev-mode 'safe-local-variable 'booleanp)
 
 \f
 (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'.")
   (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."
 
 (defun kill-all-abbrevs ()
   "Undefine all defined abbrevs."


@@ -81,7 +84,8 @@ be replaced by its expansion."
     (clear-abbrev-table (symbol-value tablesym))))
 
 (defun copy-abbrev-table (table)
     (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)
   (let ((new-table (make-abbrev-table)))
     (mapatoms
      (lambda (symbol)


@@ -133,25 +137,19 @@ Otherwise display all abbrevs."
                (push table empty-tables)
              (insert-abbrev-table-description table t)))
          (dolist (table (nreverse empty-tables))
                (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)
       (goto-char (point-min))
       (set-buffer-modified-p nil)

-      (edit-abbrevs-mode)

       (current-buffer))))
 
       (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.
 (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,
 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,


@@ -162,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)
 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."
 
 (defun edit-abbrevs-redefine ()
   "Redefine abbrevs according to current buffer contents."


@@ -191,7 +194,8 @@ the ones defined from the buffer now."
                      (not (eolp)))
          (setq name (read buf) count (read buf))
          (if (equal count '(sys))
                      (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)))
          (setq exp (read buf))
          (skip-chars-backward " \t\n\f")
          (setq hook (if (not (eolp)) (read buf)))


@@ -417,7 +421,7 @@ A prefix argument means don't query; expand all abbrevs."
 \(fn ABBREV PROP)")
 
 (defalias 'abbrev-put 'put
 \(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)")
 See `define-abbrev' for the effect of some special properties.
 
 \(fn ABBREV PROP VAL)")


@@ -446,6 +450,7 @@ PROPS is a list of properties."
     table))
 
 (defun abbrev-table-p (object)
     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))))
 
   (and (vectorp object)
        (numberp (abbrev-table-get object :abbrev-table-modiff))))
 


@@ -471,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);
 (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)))
 
 (defvar fundamental-mode-abbrev-table
   (let ((table (make-abbrev-table)))


@@ -518,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)
 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."
 
 (defun clear-abbrev-table (table)
   "Undefine all abbrevs in abbrev table TABLE, leaving it empty."


@@ -527,7 +533,7 @@ the current abbrev table before abbrev lookup happens."
     (dotimes (i (length table))
       (aset table i 0))
     ;; Preserve the table's properties.
     (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)))
     (let ((newsym (intern "" table)))
       (set newsym nil)      ; Make sure it won't be confused for an abbrev.
       (setplist newsym (symbol-plist sym)))


@@ -547,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.
 
  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).
 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).


@@ -564,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.
 \(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))
   (unless (plist-get props :count)
     (setq props (plist-put props :count 0)))
   (let ((system-flag (plist-get props :system))


@@ -576,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
                  (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)))
                        ;; load-file-name
                        (equal (symbol-value sym) expansion)
                        (equal (symbol-function sym) hook)))


@@ -595,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
   "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)
             ;; ((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)
     (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))
           (setq pos (1+ pos)))
         (error "Some abbrev characters (%s) are not word constituents %s"
                (apply 'string (nreverse badchars))


@@ -649,6 +661,26 @@ either a single abbrev table or a list of abbrev tables."
       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;
 (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;


@@ -658,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)
 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))
         (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)
 
 
 (defun abbrev-expansion (abbrev &optional table)


@@ -728,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))
                            (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))
                        (when abbrev
                          (setq enable-fun (abbrev-get abbrev :enable-function))
                          (and (or (not enable-fun) (funcall enable-fun))


@@ -745,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.
 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))
   (unless name (setq name (symbol-name abbrev)))
   (unless wordstart (setq wordstart (point)))
   (unless wordend (setq wordend wordstart))


@@ -802,26 +824,36 @@ Return ABBREV if the expansion should be considered as having taken place."
     value))
 
 (defvar abbrev-expand-functions nil
     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.
 
 (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)
   (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 ()
   (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
       (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))
             ;; Add an undo boundary, in case we are doing this for
             ;; a self-inserting command which has avoided making one so far.
             (undo-boundary))


@@ -933,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.
   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'."
 - `: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'."


@@ -976,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)))))))
 
            (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
 (provide 'abbrev)
 
 ;;; abbrev.el ends here