Add an :exit-function for completion-at-point.

* lisp/minibuffer.el (completion--done): New fun.
(completion--do-completion): Use it.  New arg `expect-exact'.
(minibuffer-complete, minibuffer-complete-word): Don't output message,
since completion--do-completion does it for us now.
(minibuffer-force-complete): Use completion--done and
completion--replace.  Handle sole-completion case with more care.
(minibuffer-complete-and-exit): Use new `expect-exact' arg.
(completion-extra-properties): New var.
(completion-annotate-function): Make obsolete.
(minibuffer-completion-help): Adjust accordingly.
Use completion-list-insert-choice-function.
(completion-at-point, completion-help-at-point):
Bind completion-extra-properties.
(completion-pcm-word-delimiters): Add | (for uniquify, for example).
* lisp/simple.el (completion-list-insert-choice-function): New var.
(completion-setup-function): Preserve it.
(choose-completion): Pay attention to it, shuffle the code a bit.
(choose-completion-string): New arg `insert-function'.

* lisp/textmodes/bibtex.el: Convert to lexical binding.
(bibtex-mode-map): Use completion-at-point.
(bibtex-mode): Use define-derived-mode&completion-at-point-functions.
(bibtex-completion-at-point-function): New fun, from bibtex-complete.
(bibtex-complete): Define as obsolete alias.
(bibtex-complete-internal): Remove.
(bibtex-format-entry): Remove unused sub-group in regexp.
* lisp/shell.el (shell--command-completion-data)
(shell-environment-variable-completion):
* lisp/pcomplete.el (pcomplete-completions-at-point):
* lisp/comint.el (comint--complete-file-name-data): Use :exit-function
instead of completion-table-with-terminator so it also works for
choose-completion.

8 files changed, 399 insertions, 280 deletions

diff --git a/etc/NEWS b/etc/NEWS
index 98a66259db0..64313480efb 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -68,9 +68,6 @@ and also when HOME is set to C:\ by default.
 
 * Changes in Emacs 24.1
 
-** Completion in a non-minibuffer now tries to detect the end of completion
-and pops down the *Completions* buffer accordingly.
-
 ** emacsclient changes
 
 *** New emacsclient argument --parent-id ID can be used to open a
@@ -83,9 +80,18 @@ client frame in parent X window ID, via XEmbed.  This works like the
 *** If emacsclient shuts down as a result of Emacs signalling an
 error, its exit status is 1.
 
-** Completion can cycle, depending on completion-cycle-threshold.
+** Completion
+*** Many packages have been changed to use completion-at-point rather than
+their own completion code.
+
+*** Completion in a non-minibuffer now tries to detect the end of completion
+and pops down the *Completions* buffer accordingly.
+
+*** Completion can cycle, depending on completion-cycle-threshold.
 
-** `completing-read' can be customized using the new variable
+*** New completion style `substring'.
+
+*** `completing-read' can be customized using the new variable
 `completing-read-function'.
 
 ** auto-mode-case-fold is now enabled by default.
@@ -833,6 +839,17 @@ sc.el, x-menu.el, rnews.el, rnewspost.el
 
 * Lisp changes in Emacs 24.1
 
+** Completion
+*** New variable completion-extra-properties used to specify extra properties
+of the current completion:
+- :annotate-function, same as the old completion-annotate-function.
+- :exit-function, function to call after completion took place.
+
+*** Functions on completion-at-point-functions can return any of the properties
+valid for completion-extra-properties.
+
+*** completion-annotate-function is obsolete.
+
 ** `glyphless-char-display' can now distinguish between graphical and
 text terminal display, via a char-table entry that is a cons cell.
 
@@ -909,8 +926,6 @@ argument is supplied (see Trash changes, above).
 
 ** buffer-substring-filters is obsoleted by filter-buffer-substring-functions.
 
-** New completion style `substring'.
-
 ** `facemenu-read-color' is now an alias for `read-color'.
 The command `read-color' now requires a match for a color name or RGB
 triplet, instead of signalling an error if the user provides a invalid
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index cb00357c23e..ce0f3e8733b 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,40 @@
+2011-05-24  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+	Add an :exit-function for completion-at-point.
+
+	* minibuffer.el (completion--done): New fun.
+	(completion--do-completion): Use it.  New arg `expect-exact'.
+	(minibuffer-complete, minibuffer-complete-word): Don't output message,
+	since completion--do-completion does it for us now.
+	(minibuffer-force-complete): Use completion--done and
+	completion--replace.  Handle sole-completion case with more care.
+	(minibuffer-complete-and-exit): Use new `expect-exact' arg.
+	(completion-extra-properties): New var.
+	(completion-annotate-function): Make obsolete.
+	(minibuffer-completion-help): Adjust accordingly.
+	Use completion-list-insert-choice-function.
+	(completion-at-point, completion-help-at-point):
+	Bind completion-extra-properties.
+	(completion-pcm-word-delimiters): Add | (for uniquify, for example).
+	* simple.el (completion-list-insert-choice-function): New var.
+	(completion-setup-function): Preserve it.
+	(choose-completion): Pay attention to it, shuffle the code a bit.
+	(choose-completion-string): New arg `insert-function'.
+
+	* textmodes/bibtex.el: Convert to lexical binding.
+	(bibtex-mode-map): Use completion-at-point.
+	(bibtex-mode): Use define-derived-mode&completion-at-point-functions.
+	(bibtex-completion-at-point-function): New fun, from bibtex-complete.
+	(bibtex-complete): Define as obsolete alias.
+	(bibtex-complete-internal): Remove.
+	(bibtex-format-entry): Remove unused sub-group in regexp.
+	* shell.el (shell--command-completion-data)
+	(shell-environment-variable-completion):
+	* pcomplete.el (pcomplete-completions-at-point):
+	* comint.el (comint--complete-file-name-data): Use :exit-function
+	instead of completion-table-with-terminator so it also works for
+	choose-completion.
+
 2011-05-23  Stefan Monnier  <monnier@iro.umontreal.ca>
 
 	* <lots-of-files>.el: Don't quote lambda expressions with `quote'.
diff --git a/lisp/comint.el b/lisp/comint.el
index 8608c0d31e9..e4bc530f361 100644
--- a/lisp/comint.el
+++ b/lisp/comint.el
@@ -3134,19 +3134,20 @@ in the same way as TABLE completes strings of the form (concat S2 S)."
              #'comint--table-subvert
              #'completion-file-name-table
              (cdr prefixes) (car prefixes)))))
-    (list
-     filename-beg filename-end
-     (lambda (string pred action)
-       (let ((completion-ignore-case read-file-name-completion-ignore-case)
-             (completion-ignored-extensions comint-completion-fignore))
-         (if (zerop (length filesuffix))
-             (complete-with-action action table string pred)
-           ;; Add a space at the end of completion.  Use a terminator-regexp
-           ;; that never matches since the terminator cannot appear
-           ;; within the completion field anyway.
-           (completion-table-with-terminator
-            (cons filesuffix "\\`a\\`")
-            table string pred action)))))))
+    (nconc
+     (list
+      filename-beg filename-end
+      (lambda (string pred action)
+        (let ((completion-ignore-case read-file-name-completion-ignore-case)
+              (completion-ignored-extensions comint-completion-fignore))
+          (complete-with-action action table string pred))))
+     (unless (zerop (length filesuffix))
+       (list :exit-function
+             (lambda (_s finished)
+               (when (memq finished '(sole finished))
+                 (if (looking-at (regexp-quote filesuffix))
+                     (goto-char (match-end 0))
+                   (insert filesuffix)))))))))
 
 (defun comint-dynamic-complete-as-filename ()
   "Dynamically complete at point as a filename.
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 41399f3f141..f3d92b18722 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -58,12 +58,9 @@
 
 ;;; Todo:
 
+;; - for M-x, cycle-sort commands that have no key binding first.
 ;; - Make things like icomplete-mode or lightning-completion work with
 ;;   completion-in-region-mode.
-;; - completion-insert-complete-hook (called after inserting a complete
-;;   completion), typically used for "complete-abbrev" where it would expand
-;;   the abbrev.  Tho we'd probably want to provide it from the
-;;   completion-table.
 ;; - extend `boundaries' to provide various other meta-data about the
 ;;   output of `all-completions':
 ;;   - preferred sorting order when displayed in *Completions*.
@@ -74,10 +71,6 @@
 ;;   - indicate how to turn all-completion's output into
 ;;     try-completion's output: e.g. completion-ignored-extensions.
 ;;     maybe that could be merged with the "quote" operation above.
-;;   - completion hook to run when the completion is
-;;     selected/inserted (maybe this should be provided some other
-;;     way, e.g. as text-property, so `try-completion can also return it?)
-;;     both for when it's inserted via TAB or via choose-completion.
 ;;   - indicate that `all-completions' doesn't do prefix-completion
 ;;     but just returns some list that relates in some other way to
 ;;     the provided string (as is the case in filecache.el), in which
@@ -87,18 +80,6 @@
 ;;     \n into something else, add special boundaries between
 ;;     completions).  E.g. when completing from the kill-ring.
 
-;; - make partial-completion-mode obsolete:
-;;   - (?) <foo.h> style completion for file names.
-;;     This can't be done identically just by tweaking completion,
-;;     because partial-completion-mode's behavior is to expand <string.h>
-;;     to /usr/include/string.h only when exiting the minibuffer, at which
-;;     point the completion code is actually not involved normally.
-;;     Partial-completion-mode does it via a find-file-not-found-function.
-;;   - special code for C-x C-f <> to visit the file ref'd at point
-;;     via (require 'foo) or #include "foo".  ffap seems like a better
-;;     place for this feature (supplemented with major-mode-provided
-;;     functions to find the file ref'd at point).
-
 ;; - case-sensitivity currently confuses two issues:
 ;;   - whether or not a particular completion table should be case-sensitive
 ;;     (i.e. whether strings that differ only by case are semantically
@@ -562,7 +543,8 @@ candidates than this number."
   (if completion-show-inline-help
       (minibuffer-message msg)))
 
-(defun completion--do-completion (&optional try-completion-function)
+(defun completion--do-completion (&optional try-completion-function
+                                            expect-exact)
   "Do the completion and return a summary of what happened.
 M = completion was performed, the text was Modified.
 C = there were available Completions.
@@ -576,7 +558,11 @@ E = after completion we now have an Exact match.
  100  4 ??? impossible
  101  5 ??? impossible
  110  6 some completion happened
- 111  7 completed to an exact completion"
+ 111  7 completed to an exact completion
+
+TRY-COMPLETION-FUNCTION is a function to use in place of `try-completion'.
+EXPECT-EXACT, if non-nil, means that there is no need to tell the user
+when the buffer's text is already an exact match."
   (let* ((beg (field-beginning))
          (end (field-end))
          (string (buffer-substring beg end))
@@ -595,7 +581,9 @@ E = after completion we now have an Exact match.
       (minibuffer--bitset nil nil nil))
      ((eq t comp)
       (minibuffer-hide-completions)
-      (goto-char (field-end))
+      (goto-char end)
+      (completion--done string 'finished
+                        (unless expect-exact "Sole completion"))
       (minibuffer--bitset nil nil t))   ;Exact and unique match.
      (t
       ;; `completed' should be t if some completion was done, which doesn't
@@ -619,12 +607,12 @@ E = after completion we now have an Exact match.
             ;; whether this is a unique completion or not, so try again using
             ;; the real case (this shouldn't recurse again, because the next
             ;; time try-completion will return either t or the exact string).
-            (completion--do-completion try-completion-function)
+            (completion--do-completion try-completion-function expect-exact)
 
           ;; It did find a match.  Do we match some possibility exactly now?
           (let ((exact (test-completion completion
-					minibuffer-completion-table
-					minibuffer-completion-predicate))
+                                        minibuffer-completion-table
+                                        minibuffer-completion-predicate))
                 (comps
                  ;; Check to see if we want to do cycling.  We do it
                  ;; here, after having performed the normal completion,
@@ -658,7 +646,13 @@ E = after completion we now have an Exact match.
               ;; We could also decide to refresh the completions,
               ;; if they're displayed (and assuming there are
               ;; completions left).
-              (minibuffer-hide-completions))
+              (minibuffer-hide-completions)
+              (if exact
+                  ;; If completion did not put point at end of field,
+                  ;; it's a sign that completion is not finished.
+                  (completion--done completion
+                                    (if (< comp-pos (length completion))
+                                        'exact 'unknown))))
              ;; Show the completion table, if requested.
              ((not exact)
 	      (if (case completion-auto-help
@@ -669,8 +663,12 @@ E = after completion we now have an Exact match.
              ;; If the last exact completion and this one were the same, it
              ;; means we've already given a "Complete, but not unique" message
              ;; and the user's hit TAB again, so now we give him help.
-             ((eq this-command last-command)
-              (if completion-auto-help (minibuffer-completion-help))))
+             (t
+              (if (and (eq this-command last-command) completion-auto-help)
+                  (minibuffer-completion-help))
+              (completion--done completion 'exact
+                                (unless expect-exact
+                                  "Complete, but not unique"))))
 
             (minibuffer--bitset completed t exact))))))))
 
@@ -705,10 +703,6 @@ scroll the window of possible completions."
     t)
    (t (case (completion--do-completion)
         (#b000 nil)
-        (#b001 (completion--message "Sole completion")
-               t)
-        (#b011 (completion--message "Complete, but not unique")
-               t)
         (t     t)))))
 
 (defun completion--flush-all-sorted-completions (&rest _ignore)
@@ -742,10 +736,11 @@ scroll the window of possible completions."
           ;; Prefer recently used completions.
           ;; FIXME: Additional sorting ideas:
           ;; - for M-x, prefer commands that have no key binding.
-          (let ((hist (symbol-value minibuffer-history-variable)))
-            (setq all (sort all (lambda (c1 c2)
-                                  (> (length (member c1 hist))
-                                     (length (member c2 hist)))))))
+          (when (minibufferp)
+            (let ((hist (symbol-value minibuffer-history-variable)))
+              (setq all (sort all (lambda (c1 c2)
+                                    (> (length (member c1 hist))
+                                       (length (member c2 hist))))))))
           ;; Cache the result.  This is not just for speed, but also so that
           ;; repeated calls to minibuffer-force-complete can cycle through
           ;; all possibilities.
@@ -763,14 +758,21 @@ Repeated uses step through the possible completions."
   ;; ~/src/emacs/trunk/ and throws away lisp/minibuffer.el.
   (let* ((start (field-beginning))
          (end (field-end))
-         (all (completion-all-sorted-completions)))
-    (if (not (consp all))
+         (all (completion-all-sorted-completions))
+         (base (+ start (or (cdr (last all)) 0))))
+    (cond
+     ((not (consp all))
         (completion--message
-         (if all "No more completions" "No completions"))
+       (if all "No more completions" "No completions")))
+     ((not (consp (cdr all)))
+      (let ((mod (equal (car all) (buffer-substring-no-properties base end))))
+        (if mod (completion--replace base end (car all)))
+        (completion--done (buffer-substring-no-properties start (point))
+                          'finished (unless mod "Sole completion"))))
+     (t
       (setq completion-cycling t)
-      (goto-char end)
-      (insert (car all))
-      (delete-region (+ start (cdr (last all))) end)
+      (completion--replace base end (car all))
+      (completion--done (buffer-substring-no-properties start (point)) 'sole)
       ;; If completing file names, (car all) may be a directory, so we'd now
       ;; have a new set of possible completions and might want to reset
       ;; completion-all-sorted-completions to nil, but we prefer not to,
@@ -778,7 +780,7 @@ Repeated uses step through the possible completions."
       ;; through the previous possible completions.
       (let ((last (last all)))
         (setcdr last (cons (car all) (cdr last)))
-        (setq completion-all-sorted-completions (cdr all))))))
+        (setq completion-all-sorted-completions (cdr all)))))))
 
 (defvar minibuffer-confirm-exit-commands
   '(minibuffer-complete minibuffer-complete-word PC-complete PC-complete-word)
@@ -850,7 +852,7 @@ If `minibuffer-completion-confirm' is `confirm-after-completion',
      (t
       ;; Call do-completion, but ignore errors.
       (case (condition-case nil
-                (completion--do-completion)
+                (completion--do-completion nil 'expect-exact)
               (error 1))
         ((#b001 #b011) (exit-minibuffer))
         (#b111 (if (not minibuffer-completion-confirm)
@@ -954,10 +956,6 @@ Return nil if there is no valid completion, else t."
   (interactive)
   (case (completion--do-completion 'completion--try-word-completion)
     (#b000 nil)
-    (#b001 (completion--message "Sole completion")
-           t)
-    (#b011 (completion--message "Complete, but not unique")
-           t)
     (t     t)))
 
 (defface completions-annotations '((t :inherit italic))
@@ -1157,6 +1155,21 @@ the completions buffer."
       (run-hooks 'completion-setup-hook)))
   nil)
 
+(defvar completion-extra-properties nil
+  "Property list of extra properties of the current completion job.
+These include:
+`:annotation-function': Function to add annotations in the completions buffer.
+   The function takes a completion and should either return nil, or a string
+   that will be displayed next to the completion.  The function can access the
+   completion data via `minibuffer-completion-table' and related variables.
+`:exit-function': Function to run after completion is performed.
+   The function takes at least 2 parameters (STRING and STATUS) where STRING
+   is the text to which the field was completed and STATUS indicates what
+   kind of operation happened: if text is now complete it's `finished', if text
+   cannot be further completed but completion is not finished, it's `sole', if
+   text is a valid completion but may be further completed, it's `exact', and
+   other STATUSes may be added in the future.")
+
 (defvar completion-annotate-function
   nil
   ;; Note: there's a lot of scope as for when to add annotations and
@@ -1173,6 +1186,27 @@ The function takes a completion and should either return nil, or a string that
 will be displayed next to the completion.  The function can access the
 completion table and predicates via `minibuffer-completion-table' and related
 variables.")
+(make-obsolete-variable 'completion-annotate-function
+                        'completion-extra-properties "24.1")
+
+(defun completion--done (string &optional finished message)
+  (let* ((exit-fun (plist-get completion-extra-properties :exit-function))
+         (pre-msg (and exit-fun (current-message))))
+    (assert (memq finished '(exact sole finished unknown)))
+    ;; FIXME: exit-fun should receive `finished' as a parameter.
+    (when exit-fun
+      (when (eq finished 'unknown)
+        (setq finished
+              (if (eq (try-completion string
+                                      minibuffer-completion-table
+                                      minibuffer-completion-predicate)
+                      t)
+                  'finished 'exact)))
+      (funcall exit-fun string finished))
+    (when (and message
+               ;; Don't output any message if the exit-fun already did so.
+               (equal pre-msg (and exit-fun (current-message))))
+      (completion--message message))))
 
 (defun minibuffer-completion-help ()
   "Display a list of possible completions of the current minibuffer contents."
@@ -1187,44 +1221,77 @@ variables.")
                        minibuffer-completion-predicate
                        (- (point) (field-beginning)))))
     (message nil)
-    (if (and completions
-             (or (consp (cdr completions))
-                 (not (equal (car completions) string))))
-        (let* ((last (last completions))
-               (base-size (cdr last))
-               ;; If the *Completions* buffer is shown in a new
-               ;; window, mark it as softly-dedicated, so bury-buffer in
-               ;; minibuffer-hide-completions will know whether to
-               ;; delete the window or not.
-               (display-buffer-mark-dedicated 'soft))
-          (with-output-to-temp-buffer "*Completions*"
-            ;; Remove the base-size tail because `sort' requires a properly
-            ;; nil-terminated list.
-            (when last (setcdr last nil))
-            (setq completions (sort completions 'string-lessp))
-            (when completion-annotate-function
-              (setq completions
-                    (mapcar (lambda (s)
-                              (let ((ann
-                                     (funcall completion-annotate-function s)))
-                                (if ann (list s ann) s)))
-                            completions)))
-            (with-current-buffer standard-output
-              (set (make-local-variable 'completion-base-position)
-                   (list (+ start base-size)
-                         ;; FIXME: We should pay attention to completion
-                         ;; boundaries here, but currently
-                         ;; completion-all-completions does not give us the
-                         ;; necessary information.
-                         end)))
-            (display-completion-list completions)))
-
-      ;; If there are no completions, or if the current input is already the
-      ;; only possible completion, then hide (previous&stale) completions.
-      (minibuffer-hide-completions)
-      (ding)
-      (minibuffer-message
-       (if completions "Sole completion" "No completions")))
+    (if (or (null completions)
+            (and (not (consp (cdr completions)))
+                 (equal (car completions) string)))
+        (progn
+          ;; If there are no completions, or if the current input is already
+          ;; the sole completion, then hide (previous&stale) completions.
+          (minibuffer-hide-completions)
+          (ding)
+          (minibuffer-message
+           (if completions "Sole completion" "No completions")))
+
+      (let* ((last (last completions))
+             (base-size (cdr last))
+             (prefix (unless (zerop base-size) (substring string 0 base-size)))
+             (global-af (or (plist-get completion-extra-properties
+                                       :annotation-function)
+                            completion-annotate-function))
+             ;; If the *Completions* buffer is shown in a new
+             ;; window, mark it as softly-dedicated, so bury-buffer in
+             ;; minibuffer-hide-completions will know whether to
+             ;; delete the window or not.
+             (display-buffer-mark-dedicated 'soft))
+        (with-output-to-temp-buffer "*Completions*"
+          ;; Remove the base-size tail because `sort' requires a properly
+          ;; nil-terminated list.
+          (when last (setcdr last nil))
+          (setq completions (sort completions 'string-lessp))
+          (setq completions
+                (cond
+                 (global-af
+                  (mapcar (lambda (s)
+                            (let ((ann (funcall global-af s)))
+                              (if ann (list s ann) s)))
+                          completions))
+                 (t completions)))
+
+          (with-current-buffer standard-output
+            (set (make-local-variable 'completion-base-position)
+                 (list (+ start base-size)
+                       ;; FIXME: We should pay attention to completion
+                       ;; boundaries here, but currently
+                       ;; completion-all-completions does not give us the
+                       ;; necessary information.
+                       end))
+            (set (make-local-variable 'completion-list-insert-choice-function)
+                 (let ((ctable minibuffer-completion-table)
+                       (cpred minibuffer-completion-predicate)
+                       (cprops completion-extra-properties))
+                   (lambda (start end choice)
+                     (unless
+			 (or (zerop (length prefix))
+			     (equal prefix
+				    (buffer-substring-no-properties
+				     (max (point-min) (- start (length prefix)))
+				     start)))
+                       (message "*Completions* out of date"))
+                     ;; FIXME: Use `md' to do quoting&terminator here.
+                     (completion--replace start end choice)
+                     (let* ((minibuffer-completion-table ctable)
+                            (minibuffer-completion-predicate cpred)
+                            (completion-extra-properties cprops)
+                            (result (concat prefix choice))
+                            (bounds (completion-boundaries
+                                     result ctable cpred "")))
+                       ;; If the completion introduces a new field, then
+                       ;; completion is not finished.
+                       (completion--done result
+                                         (if (eq (car bounds) (length result))
+                                             'exact 'finished)))))))
+
+          (display-completion-list completions))))
     nil))
 
 (defun minibuffer-hide-completions ()
@@ -1364,9 +1431,9 @@ or a list of the form (START END COLLECTION &rest PROPS) where
  START and END delimit the entity to complete and should include point,
  COLLECTION is the completion table to use to complete it, and
  PROPS is a property list for additional information.
-Currently supported properties are:
- `:predicate'           a predicate that completion candidates need to satisfy.
- `:annotation-function' the value to use for `completion-annotate-function'.")
+Currently supported properties are all the properties that can appear in
+`completion-extra-properties' plus:
+ `:predicate'           a predicate that completion candidates need to satisfy.")
 
 (defvar completion--capf-misbehave-funs nil
   "List of functions found on `completion-at-point-functions' that misbehave.")
@@ -1403,9 +1470,7 @@ The completion method is determined by `completion-at-point-functions'."
     (pcase res
      (`(,_ . ,(and (pred functionp) f)) (funcall f))
      (`(,hookfun . (,start ,end ,collection . ,plist))
-      (let* ((completion-annotate-function
-              (or (plist-get plist :annotation-function)
-                  completion-annotate-function))
+      (let* ((completion-extra-properties plist)
              (completion-in-region-mode-predicate
               (lambda ()
                 ;; We're still in the same completion field.
@@ -1428,9 +1493,7 @@ The completion method is determined by `completion-at-point-functions'."
      (`(,hookfun . (,start ,end ,collection . ,plist))
       (let* ((minibuffer-completion-table collection)
              (minibuffer-completion-predicate (plist-get plist :predicate))
-             (completion-annotate-function
-              (or (plist-get plist :annotation-function)
-                  completion-annotate-function))
+             (completion-extra-properties plist)
              (completion-in-region-mode-predicate
               (lambda ()
                 ;; We're still in the same completion field.
@@ -2029,7 +2092,7 @@ from lowercase to uppercase characters).")
 (defun completion-pcm--prepare-delim-re (delims)
   (setq completion-pcm--delim-wild-regex (concat "[" delims "*]")))
 
-(defcustom completion-pcm-word-delimiters "-_./: "
+(defcustom completion-pcm-word-delimiters "-_./:| "
   "A string of characters treated as word delimiters for completion.
 Some arcane rules:
 If `]' is in this string, it must come first.
diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el
index 2f5dcdfb5e8..932436df8c9 100644
--- a/lisp/pcomplete.el
+++ b/lisp/pcomplete.el
@@ -527,19 +527,19 @@ Same as `pcomplete' but using the standard completion UI."
                            (funcall pcomplete-norm-func
                                     (directory-file-name f))
                            pcomplete-seen)))))))
-          (unless (zerop (length pcomplete-termination-string))
-            ;; Add a space at the end of completion.  Use a terminator-regexp
-            ;; that never matches since the terminator cannot appear
-            ;; within the completion field anyway.
-            (setq table
-                  (apply-partially #'completion-table-with-terminator
-                                   (cons pcomplete-termination-string
-                                         "\\`a\\`")
-                                   table)))
           (when pcomplete-ignore-case
             (setq table
                   (apply-partially #'completion-table-case-fold table)))
-          (list beg (point) table :predicate pred))))))
+          (list beg (point) table
+                :predicate pred
+                :exit-function
+                (unless (zerop (length pcomplete-termination-string))
+                  (lambda (_s finished)
+                    (when (memq finished '(sole finished))
+                      (if (looking-at
+                           (regexp-quote pcomplete-termination-string))
+                          (goto-char (match-end 0))
+                        (insert pcomplete-termination-string)))))))))))
 
  ;; I don't think such commands are usable before first setting up buffer-local
  ;; variables to parse args, so there's no point autoloading it.
diff --git a/lisp/shell.el b/lisp/shell.el
index cba50038bc0..53455944ee6 100644
--- a/lisp/shell.el
+++ b/lisp/shell.el
@@ -1074,12 +1074,15 @@ Returns t if successful."
     (list
      start end
      (lambda (string pred action)
-       (completion-table-with-terminator
-        " " (lambda (string pred action)
-              (if (string-match "/" string)
-                  (completion-file-name-table string pred action)
-                (complete-with-action action completions string pred)))
-        string pred action)))))
+       (if (string-match "/" string)
+           (completion-file-name-table string pred action)
+         (complete-with-action action completions string pred)))
+     :exit-function
+     (lambda (_string finished)
+       (when (memq finished '(sole finished))
+         (if (looking-at " ")
+             (goto-char (match-end 0))
+           (insert " ")))))))
 
 ;; (defun shell-dynamic-complete-as-command ()
 ;;    "Dynamically complete at point as a command.
@@ -1150,18 +1153,17 @@ Returns non-nil if successful."
                                   (substring x 0 (string-match "=" x)))
                                 process-environment))
              (suffix (case (char-before start) (?\{ "}") (?\( ")") (t ""))))
-        (list
-         start end
-         (apply-partially
-          #'completion-table-with-terminator
-          (cons (lambda (comp)
-                  (concat comp
-                          suffix
-                          (if (file-directory-p
-                               (comint-directory (getenv comp)))
-                              "/")))
-                "\\`a\\`")
-          variables))))))
+        (list start end variables
+              :exit-function
+              (lambda (s finished)
+                (when (memq finished '(sole finished))
+                  (let ((suf (concat suffix
+                                     (if (file-directory-p
+                                          (comint-directory (getenv s)))
+                                         "/"))))
+                    (if (looking-at (regexp-quote suf))
+                        (goto-char (match-end 0))
+                      (insert suf))))))))))
 
 
 (defun shell-c-a-p-replace-by-expanded-directory ()
diff --git a/lisp/simple.el b/lisp/simple.el
index ac53ce3add1..4cf38178357 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -5968,6 +5968,12 @@ Its value is a list of the form (START END) where START is the place
 where the completion should be inserted and END (if non-nil) is the end
 of the text to replace.  If END is nil, point is used instead.")
 
+(defvar completion-list-insert-choice-function #'completion--replace
+  "Function to use to insert the text chosen in *Completions*.
+Called with 3 arguments (BEG END TEXT), it should replace the text
+between BEG and END with TEXT.  Expected to be set buffer-locally
+in the *Completions* buffer.")
+
 (defvar completion-base-size nil
   "Number of chars before point not involved in completion.
 This is a local variable in the completion list buffer.
@@ -6031,26 +6037,30 @@ With prefix argument N, move N items (negative N means move backward)."
   ;; In case this is run via the mouse, give temporary modes such as
   ;; isearch a chance to turn off.
   (run-hooks 'mouse-leave-buffer-hook)
-  (let (buffer base-size base-position choice)
-    (with-current-buffer (window-buffer (posn-window (event-start event)))
-      (setq buffer completion-reference-buffer)
-      (setq base-size completion-base-size)
-      (setq base-position completion-base-position)
-      (save-excursion
-        (goto-char (posn-point (event-start event)))
-        (let (beg end)
-          (if (and (not (eobp)) (get-text-property (point) 'mouse-face))
-              (setq end (point) beg (1+ (point))))
-          (if (and (not (bobp)) (get-text-property (1- (point)) 'mouse-face))
-              (setq end (1- (point)) beg (point)))
-          (if (null beg)
-              (error "No completion here"))
-          (setq beg (previous-single-property-change beg 'mouse-face))
-          (setq end (or (next-single-property-change end 'mouse-face)
-                        (point-max)))
-          (setq choice (buffer-substring-no-properties beg end)))))
-
-    (let ((owindow (selected-window)))
+  (with-current-buffer (window-buffer (posn-window (event-start event)))
+    (let ((buffer completion-reference-buffer)
+          (base-size completion-base-size)
+          (base-position completion-base-position)
+          (insert-function completion-list-insert-choice-function)
+          (choice
+           (save-excursion
+             (goto-char (posn-point (event-start event)))
+             (let (beg end)
+               (cond
+                ((and (not (eobp)) (get-text-property (point) 'mouse-face))
+                 (setq end (point) beg (1+ (point))))
+                ((and (not (bobp))
+                      (get-text-property (1- (point)) 'mouse-face))
+                 (setq end (1- (point)) beg (point)))
+                (t (error "No completion here")))
+               (setq beg (previous-single-property-change beg 'mouse-face))
+               (setq end (or (next-single-property-change end 'mouse-face)
+                             (point-max)))
+               (buffer-substring-no-properties beg end))))
+          (owindow (selected-window)))
+
+      (unless (buffer-live-p buffer)
+        (error "Destination buffer is dead"))
       (select-window (posn-window (event-start event)))
       (if (and (one-window-p t 'selected-frame)
 	       (window-dedicated-p (selected-window)))
@@ -6059,20 +6069,20 @@ With prefix argument N, move N items (negative N means move backward)."
 	(or (window-dedicated-p (selected-window))
 	    (bury-buffer)))
       (select-window
-       (or (and (buffer-live-p buffer)
-		(get-buffer-window buffer 0))
-	   owindow)))
-
-    (choose-completion-string
-     choice buffer
-     (or base-position
-         (when base-size
-           ;; Someone's using old completion code that doesn't know
-           ;; about base-position yet.
-           (list (+ base-size (with-current-buffer buffer (field-beginning)))))
-         ;; If all else fails, just guess.
-         (with-current-buffer buffer
-           (list (choose-completion-guess-base-position choice)))))))
+       (or (get-buffer-window buffer 0)
+           owindow))
+
+      (with-current-buffer buffer
+        (choose-completion-string
+         choice buffer
+         (or base-position
+             (when base-size
+               ;; Someone's using old completion code that doesn't know
+               ;; about base-position yet.
+               (list (+ base-size (field-beginning))))
+             ;; If all else fails, just guess.
+             (list (choose-completion-guess-base-position choice)))
+         insert-function)))))
 
 ;; Delete the longest partial match for STRING
 ;; that can be found before POINT.
@@ -6118,7 +6128,8 @@ the minibuffer; no further functions will be called.
 If all functions in the list return nil, that means to use
 the default method of inserting the completion in BUFFER.")
 
-(defun choose-completion-string (choice &optional buffer base-position)
+(defun choose-completion-string (choice &optional
+                                        buffer base-position insert-function)
   "Switch to BUFFER and insert the completion choice CHOICE.
 BASE-POSITION, says where to insert the completion."
 
@@ -6138,8 +6149,8 @@ BASE-POSITION, says where to insert the completion."
     ;; If BUFFER is a minibuffer, barf unless it's the currently
     ;; active minibuffer.
     (if (and mini-p
-	     (or (not (active-minibuffer-window))
-		 (not (equal buffer
+             (not (and (active-minibuffer-window)
+                       (equal buffer
 			     (window-buffer (active-minibuffer-window))))))
 	(error "Minibuffer is not active for completion")
       ;; Set buffer so buffer-local choose-completion-string-functions works.
@@ -6151,13 +6162,15 @@ BASE-POSITION, says where to insert the completion."
                ;; and indeed unused.  The last used to be `base-size', so we
                ;; keep it to try and avoid breaking old code.
 	       choice buffer base-position nil)
+        ;; This remove-text-properties should be unnecessary since `choice'
+        ;; comes from buffer-substring-no-properties.
+        ;;(remove-text-properties 0 (lenth choice) '(mouse-face nil) choice)
 	;; Insert the completion into the buffer where it was requested.
-        (delete-region (or (car base-position) (point))
-                       (or (cadr base-position) (point)))
-	(insert choice)
-	(remove-text-properties (- (point) (length choice)) (point)
-				'(mouse-face nil))
-	;; Update point in the window that BUFFER is showing in.
+        (funcall (or insert-function completion-list-insert-choice-function)
+                 (or (car base-position) (point))
+                 (or (cadr base-position) (point))
+                 choice)
+        ;; Update point in the window that BUFFER is showing in.
 	(let ((window (get-buffer-window buffer t)))
 	  (set-window-point window (point)))
 	;; If completing for the minibuffer, exit it with this choice.
@@ -6223,10 +6236,13 @@ Called from `temp-buffer-show-hook'."
                            0 (or completion-base-size 0)))))))
     (with-current-buffer standard-output
       (let ((base-size completion-base-size) ;Read before killing localvars.
-            (base-position completion-base-position))
+            (base-position completion-base-position)
+            (insert-fun completion-list-insert-choice-function))
         (completion-list-mode)
         (set (make-local-variable 'completion-base-size) base-size)
-        (set (make-local-variable 'completion-base-position) base-position))
+        (set (make-local-variable 'completion-base-position) base-position)
+        (set (make-local-variable 'completion-list-insert-choice-function)
+	     insert-fun))
       (set (make-local-variable 'completion-reference-buffer) mainbuf)
       (if base-dir (setq default-directory base-dir))
       ;; Maybe insert help string.
diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el
index e49d7549776..9d05728ffad 100644
--- a/lisp/textmodes/bibtex.el
+++ b/lisp/textmodes/bibtex.el
@@ -1,4 +1,4 @@
-;;; bibtex.el --- BibTeX mode for GNU Emacs
+;;; bibtex.el --- BibTeX mode for GNU Emacs -*- lexical-binding: t -*-
 
 ;; Copyright (C) 1992, 1994-1999, 2001-2011  Free Software Foundation, Inc.
 
@@ -204,7 +204,7 @@ See also `bibtex-sort-ignore-string-entries'."
                  (const entry-class)
                  (const t)))
 (put 'bibtex-maintain-sorted-entries 'safe-local-variable
-     '(lambda (a) (memq a '(nil t plain crossref entry-class))))
+     (lambda (a) (memq a '(nil t plain crossref entry-class))))
 
 (defcustom bibtex-sort-entry-class
   '(("String")
@@ -968,7 +968,7 @@ Set this variable before loading BibTeX mode."
     (modify-syntax-entry ?\" "\"" st)
     (modify-syntax-entry ?$ "$$  " st)
     (modify-syntax-entry ?% "<   " st)
-    (modify-syntax-entry ?' "w   " st)
+    (modify-syntax-entry ?' "w   " st)	;FIXME: Not allowed in @string keys.
     (modify-syntax-entry ?@ "w   " st)
     (modify-syntax-entry ?\\ "\\" st)
     (modify-syntax-entry ?\f ">   " st)
@@ -984,7 +984,7 @@ Set this variable before loading BibTeX mode."
     ;; The Key `C-c&' is reserved for reftex.el
     (define-key km "\t" 'bibtex-find-text)
     (define-key km "\n" 'bibtex-next-field)
-    (define-key km "\M-\t" 'bibtex-complete)
+    (define-key km "\M-\t" 'completion-at-point)
     (define-key km "\C-c\"" 'bibtex-remove-delimiters)
     (define-key km "\C-c{" 'bibtex-remove-delimiters)
     (define-key km "\C-c}" 'bibtex-remove-delimiters)
@@ -2018,7 +2018,7 @@ Formats current entry according to variable `bibtex-entry-format'."
                     ;; remove delimiters from purely numerical fields
                     (when (and (memq 'numerical-fields format)
                                (progn (goto-char beg-text)
-                                      (looking-at "\\(\"[0-9]+\"\\)\\|\\({[0-9]+}\\)")))
+                                      (looking-at "\"[0-9]+\"\\|{[0-9]+}")))
                       (goto-char end-text)
                       (delete-char -1)
                       (goto-char beg-text)
@@ -2247,10 +2247,11 @@ applied to the content of FIELD.  It is an alist with pairs
          (content (bibtex-text-in-field field bibtex-autokey-use-crossref))
         case-fold-search)
     (unless content (setq content ""))
-    (dolist (pattern change-list content)
+    (dolist (pattern change-list)
       (setq content (replace-regexp-in-string (car pattern)
                                               (cdr pattern)
-                                              content t)))))
+                                              content t)))
+    content))
 
 (defun bibtex-autokey-get-names ()
   "Get contents of the name field of the current entry.
@@ -2521,7 +2522,7 @@ for parsing BibTeX keys.  If parsing fails, try to set this variable to nil."
                       (bibtex-sort-ignore-string-entries t)
                       bounds)
                   (bibtex-map-entries
-                   (lambda (key beg end)
+                   (lambda (key _beg end)
                      (if (and abortable
                               (input-pending-p))
                          ;; user has aborted by typing a key: return `aborted'
@@ -2714,20 +2715,6 @@ When called interactively, FORCE is t, CURRENT is t if current buffer uses
           (message "No BibTeX buffers defined")))
     buffer-list))
 
-(defun bibtex-complete-internal (completions)
-  "Complete word fragment before point to longest prefix of COMPLETIONS.
-COMPLETIONS is an alist of strings.  If point is not after the part
-of a word, all strings are listed.  Return completion."
-  ;; Return value is used by cleanup functions.
-  ;; Code inspired by `lisp-complete-symbol'.
-  (let ((beg (save-excursion
-                (re-search-backward "[ \t{\"]")
-                (forward-char)
-                (point)))
-        (end (point)))
-    (when (completion-in-region beg end completions)
-      (buffer-substring beg (point)))))
-
 (defun bibtex-complete-string-cleanup (str compl)
   "Cleanup after inserting string STR.
 Remove enclosing field delimiters for STR.  Display message with
@@ -2941,7 +2928,7 @@ BOUND limits the search."
 ;; Interactive Functions:
 
 ;;;###autoload
-(defun bibtex-mode ()
+(define-derived-mode bibtex-mode nil "BibTeX"
   "Major mode for editing BibTeX files.
 
 General information on working with BibTeX mode:
@@ -2953,7 +2940,7 @@ new entry with the command \\[bibtex-clean-entry].
 
 Some features of BibTeX mode are available only by setting the variable
 `bibtex-maintain-sorted-entries' to non-nil.  However, then BibTeX mode
-works only with buffers containing valid (syntactical correct) and sorted
+works only with buffers containing valid (syntactically correct) and sorted
 entries.  This is usually the case, if you have created a buffer completely
 with BibTeX mode and finished every new entry with \\[bibtex-clean-entry].
 
@@ -2975,7 +2962,7 @@ the name of a field with \\[bibtex-remove-OPT-or-ALT].
 \\[bibtex-remove-delimiters] removes the double-quotes or braces around the text of the current field.
 \\[bibtex-empty-field] replaces the text of the current field with the default \"\" or {}.
 \\[bibtex-find-text] moves point to the end of the current field.
-\\[bibtex-complete] completes word fragment before point according to context.
+\\[completion-at-point] completes word fragment before point according to context.
 
 The command \\[bibtex-clean-entry] cleans the current entry, i.e. it removes OPT/ALT
 from the names of all non-empty optional or alternative fields, checks that
@@ -2993,12 +2980,8 @@ Entry to BibTeX mode calls the value of `bibtex-mode-hook'
 if that value is non-nil.
 
 \\{bibtex-mode-map}"
-  (interactive)
-  (kill-all-local-variables)
-  (use-local-map bibtex-mode-map)
-  (setq major-mode 'bibtex-mode)
-  (setq mode-name "BibTeX")
-  (set-syntax-table bibtex-mode-syntax-table)
+  (add-hook 'completion-at-point-functions
+            'bibtex-completion-at-point-function nil 'local)
   (make-local-variable 'bibtex-buffer-last-parsed-tick)
   ;; Install stealthy parse function if not already installed
   (unless bibtex-parse-idle-timer
@@ -3013,9 +2996,8 @@ if that value is non-nil.
   (set (make-local-variable 'defun-prompt-regexp) "^[ \t]*@[[:alnum:]]+[ \t]*")
   (set (make-local-variable 'outline-regexp) "[ \t]*@")
   (set (make-local-variable 'fill-paragraph-function) 'bibtex-fill-field)
-  (set (make-local-variable 'fill-prefix) (make-string (+ bibtex-entry-offset
-                                                          bibtex-contline-indentation)
-                                                       ?\s))
+  (set (make-local-variable 'fill-prefix)
+       (make-string (+ bibtex-entry-offset bibtex-contline-indentation) ?\s))
   (set (make-local-variable 'font-lock-defaults)
        '(bibtex-font-lock-keywords
          nil t ((?$ . "\"")
@@ -3037,11 +3019,9 @@ if that value is non-nil.
   (setq imenu-generic-expression
         (list (list nil bibtex-entry-head bibtex-key-in-head))
         imenu-case-fold-search t)
-  (make-local-variable 'choose-completion-string-functions)
   ;; XEmacs needs `easy-menu-add', Emacs does not care
   (easy-menu-add bibtex-edit-menu)
-  (easy-menu-add bibtex-entry-menu)
-  (run-mode-hooks 'bibtex-mode-hook))
+  (easy-menu-add bibtex-entry-menu))
 
 (defun bibtex-field-list (entry-type)
   "Return list of allowed fields for entry ENTRY-TYPE.
@@ -3383,7 +3363,7 @@ If mark is active count entries in region, if not in whole buffer."
         (bibtex-sort-ignore-string-entries (not count-string-entries)))
     (save-restriction
       (if mark-active (narrow-to-region (region-beginning) (region-end)))
-      (bibtex-map-entries (lambda (key beg end) (setq number (1+ number)))))
+      (bibtex-map-entries (lambda (_key _beg _end) (setq number (1+ number)))))
     (message "%s contains %d entries."
              (if mark-active "Region" "Buffer")
              number)))
@@ -3438,12 +3418,13 @@ of the head of the entry found.  Return nil if no entry found."
   (unless (local-variable-p 'bibtex-sort-entry-class-alist)
     (set (make-local-variable 'bibtex-sort-entry-class-alist)
          (let ((i -1) alist)
-           (dolist (class bibtex-sort-entry-class alist)
+           (dolist (class bibtex-sort-entry-class)
              (setq i (1+ i))
              (dolist (entry class)
                ;; All entry types should be downcase (for ease of comparison).
                (push (cons (if (stringp entry) (downcase entry) entry) i)
-                     alist)))))))
+                     alist)))
+           alist))))
 
 (defun bibtex-lessp (index1 index2)
   "Predicate for sorting BibTeX entries with indices INDEX1 and INDEX2.
@@ -3735,7 +3716,7 @@ Return t if test was successful, nil otherwise."
           (let (previous current key-list)
             (bibtex-progress-message "Checking for duplicate keys")
             (bibtex-map-entries
-             (lambda (key beg end)
+             (lambda (key _beg _end)
                (bibtex-progress-message)
                (setq current (bibtex-entry-index))
                (cond ((not previous))
@@ -3773,7 +3754,7 @@ Return t if test was successful, nil otherwise."
              "Checking required fields and month fields")
             (let ((bibtex-sort-ignore-string-entries t))
               (bibtex-map-entries
-               (lambda (key beg end)
+               (lambda (_key beg _end)
                  (bibtex-progress-message)
                  (let* ((entry-list (assoc-string (bibtex-type-in-head)
                                                   bibtex-entry-field-alist t))
@@ -4440,7 +4421,7 @@ If mark is active reformat entries in region, if not in whole buffer."
       (if (memq 'realign bibtex-entry-format)
           (bibtex-realign))
       (bibtex-progress-message "Formatting" 1)
-      (bibtex-map-entries (lambda (key beg end)
+      (bibtex-map-entries (lambda (_key _beg _end)
                             (bibtex-progress-message)
                             (bibtex-clean-entry reformat-reference-keys t)))
       (bibtex-progress-message 'done))
@@ -4473,17 +4454,15 @@ entries from minibuffer."
     (goto-char (point-max))
     (message "Buffer is now parsable.  Please save it.")))
 
-(defun bibtex-complete ()
-  "Complete word fragment before point according to context.
-If point is inside key or crossref field perform key completion based on
-`bibtex-reference-keys'.  Inside a month field perform key completion
-based on `bibtex-predefined-month-strings'.  Inside any other field
-\(including a String or Preamble definition) perform string completion
-based on `bibtex-strings'.
-An error is signaled if point is outside key or BibTeX field."
-  (interactive)
+(define-obsolete-function-alias 'bibtex-complete 'completion-at-point "24.1")
+(defun bibtex-completion-at-point-function ()
   (let ((pnt (point))
         (case-fold-search t)
+        (beg (save-excursion
+               (re-search-backward "[ \t{\"]")
+               (forward-char)
+               (point)))
+        (end (point))
         bounds name compl)
     (save-excursion
       (if (and (setq bounds (bibtex-enclosing-field nil t))
@@ -4524,49 +4503,56 @@ An error is signaled if point is outside key or BibTeX field."
                (setq compl 'key)))))
 
     (cond ((eq compl 'key)
-           ;; key completion: no cleanup needed
-           (setq choose-completion-string-functions nil)
-           (let (completion-ignore-case)
-             (bibtex-complete-internal (bibtex-global-key-alist))))
+           ;; Key completion: no cleanup needed.
+           (list beg end
+                 (lambda (s p a)
+                   (let (completion-ignore-case)
+                     (complete-with-action a (bibtex-global-key-alist) s p)))))
 
           ((eq compl 'crossref-key)
-           ;; crossref key completion
-           ;;
-           ;; If we quit the *Completions* buffer without requesting
-           ;; a completion, `choose-completion-string-functions' is still
-           ;; non-nil.  Therefore, `choose-completion-string-functions' is
-           ;; always set (either to non-nil or nil) when a new completion
-           ;; is requested.
-           (let (completion-ignore-case)
-             (setq choose-completion-string-functions
-                   (lambda (choice buffer base-position &rest ignored)
-                     (setq choose-completion-string-functions nil)
-                     (choose-completion-string choice buffer base-position)
-                     (bibtex-complete-crossref-cleanup choice)
-                     t)) ; needed by choose-completion-string-functions
-             (bibtex-complete-crossref-cleanup
-              (bibtex-complete-internal (bibtex-global-key-alist)))))
+           ;; Crossref key completion.
+           (let* ((buf (current-buffer)))
+             (list beg end
+                   (lambda (s p a)
+                     (cond
+                      ((eq a 'metadata) `(metadata (category . bibtex-key)))
+                      (t (let ((completion-ignore-case nil))
+                           (complete-with-action
+                            a (bibtex-global-key-alist) s p)))))
+                   :exit-function
+                   (lambda (string status)
+                     (when (memq status '(exact sole finished))
+                       (let ((summary
+                              (with-current-buffer buf
+                                (save-excursion
+                                  (if (bibtex-search-entry string)
+                                      (funcall bibtex-summary-function))))))
+                         (when summary
+                           (message "%s %s" string summary))))))))
 
           ((eq compl 'string)
-           ;; string key completion: no cleanup needed
-           (setq choose-completion-string-functions nil)
-           (let ((completion-ignore-case t))
-             (bibtex-complete-internal bibtex-strings)))
+           ;; String key completion: no cleanup needed.
+           (list beg end
+                 (lambda (s p a)
+                   (let ((completion-ignore-case t))
+                     (complete-with-action a bibtex-strings s p)))))
 
           (compl
-           ;; string completion
-           (let ((completion-ignore-case t))
-             (setq choose-completion-string-functions
-                   `(lambda (choice buffer base-position &rest ignored)
-                      (setq choose-completion-string-functions nil)
-                      (choose-completion-string choice buffer base-position)
-                      (bibtex-complete-string-cleanup choice ',compl)
-                      t)) ; needed by `choose-completion-string-functions'
-             (bibtex-complete-string-cleanup (bibtex-complete-internal compl)
-                                             compl)))
-
-          (t (setq choose-completion-string-functions nil)
-             (error "Point outside key or BibTeX field")))))
+           ;; String completion.
+           (list beg end
+                 (lambda (s p a)
+                   (cond
+                    ((eq a 'metadata) `(metadata (category . bibtex-string)))
+                    (t (let ((completion-ignore-case t))
+                         (complete-with-action a compl s p)))))
+                 :exit-function
+                 (lambda (string status)
+                   (when (memq status '(exact finished sole))
+                     (let ((abbr (cdr (assoc-string string compl t))))
+                       (when abbr
+                         (message "%s = abbreviation for `%s'" string abbr))))
+                   (when (eq status 'finished)
+                     (save-excursion (bibtex-remove-delimiters)))))))))
 
 (defun bibtex-Article ()
   "Insert a new BibTeX @Article entry; see also `bibtex-entry'."
@@ -4772,5 +4758,4 @@ Return the URL or nil if none can be generated."
 ;; Make BibTeX a Feature
 
 (provide 'bibtex)
-
 ;;; bibtex.el ends here