lisp/frameset.el: Optimize check for visible frame.

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

diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index e18f4c9..bbb7114 100644 (file)
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -1,6 +1,6 @@
 ;;; minibuffer.el --- Minibuffer completion functions -*- lexical-binding: t -*-
 
 ;;; minibuffer.el --- Minibuffer completion functions -*- lexical-binding: t -*-
 

-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2014 Free Software Foundation, Inc.

 
 ;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
 ;; Package: emacs
 
 ;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
 ;; Package: emacs


@@ -38,7 +38,7 @@
 
 ;;; Bugs:
 
 
 ;;; Bugs:
 

-;; - completion-all-sorted-completions list all the completions, whereas
+;; - completion-all-sorted-completions lists all the completions, whereas

 ;;   it should only lists the ones that `try-completion' would consider.
 ;;   E.g.  it should honor completion-ignored-extensions.
 ;; - choose-completion can't automatically figure out the boundaries
 ;;   it should only lists the ones that `try-completion' would consider.
 ;;   E.g.  it should honor completion-ignored-extensions.
 ;; - choose-completion can't automatically figure out the boundaries


@@ -145,7 +145,7 @@ Like CL's `some'."
   (let ((firsterror nil)
         res)
     (while (and (not res) xs)
   (let ((firsterror nil)
         res)
     (while (and (not res) xs)

-      (condition-case err
+      (condition-case-unless-debug err

           (setq res (funcall fun (pop xs)))
         (error (unless firsterror (setq firsterror err)) nil)))
     (or res
           (setq res (funcall fun (pop xs)))
         (error (unless firsterror (setq firsterror err)) nil)))
     (or res


@@ -179,7 +179,9 @@ FUN will be called in the buffer from which the minibuffer was entered.
 
 The result of the `completion-table-dynamic' form is a function
 that can be used as the COLLECTION argument to `try-completion' and
 
 The result of the `completion-table-dynamic' form is a function
 that can be used as the COLLECTION argument to `try-completion' and

-`all-completions'.  See Info node `(elisp)Programmed Completion'."
+`all-completions'.  See Info node `(elisp)Programmed Completion'.
+
+See also the related function `completion-table-with-cache'."

   (lambda (string pred action)
     (if (or (eq (car-safe action) 'boundaries) (eq action 'metadata))
         ;; `fun' is not supposed to return another function but a plain old
   (lambda (string pred action)
     (if (or (eq (car-safe action) 'boundaries) (eq action 'metadata))
         ;; `fun' is not supposed to return another function but a plain old


@@ -190,6 +192,26 @@ that can be used as the COLLECTION argument to `try-completion' and
                                (current-buffer)))
         (complete-with-action action (funcall fun string) string pred)))))
 
                                (current-buffer)))
         (complete-with-action action (funcall fun string) string pred)))))
 

+(defun completion-table-with-cache (fun &optional ignore-case)
+  "Create dynamic completion table from function FUN, with cache.
+This is a wrapper for `completion-table-dynamic' that saves the last
+argument-result pair from FUN, so that several lookups with the
+same argument (or with an argument that starts with the first one)
+only need to call FUN once.  This can be useful when FUN performs a
+relatively slow operation, such as calling an external process.
+
+When IGNORE-CASE is non-nil, FUN is expected to be case-insensitive."
+  ;; See eg bug#11906.
+  (let* (last-arg last-result
+         (new-fun
+          (lambda (arg)
+            (if (and last-arg (string-prefix-p last-arg arg ignore-case))
+                last-result
+              (prog1
+                  (setq last-result (funcall fun arg))
+                (setq last-arg arg))))))
+    (completion-table-dynamic new-fun)))
+

 (defmacro lazy-completion-table (var fun)
   "Initialize variable VAR as a lazy completion table.
 If the completion table VAR is used for the first time (e.g., by passing VAR
 (defmacro lazy-completion-table (var fun)
   "Initialize variable VAR as a lazy completion table.
 If the completion table VAR is used for the first time (e.g., by passing VAR


@@ -370,11 +392,37 @@ Note: TABLE needs to be a proper completion table which obeys predicates."
   "Create a completion table that tries each table in TABLES in turn."
   ;; FIXME: the boundaries may come from TABLE1 even when the completion list
   ;; is returned by TABLE2 (because TABLE1 returned an empty list).
   "Create a completion table that tries each table in TABLES in turn."
   ;; FIXME: the boundaries may come from TABLE1 even when the completion list
   ;; is returned by TABLE2 (because TABLE1 returned an empty list).

+  ;; Same potential problem if any of the tables use quoting.

   (lambda (string pred action)
     (completion--some (lambda (table)
                         (complete-with-action action table string pred))
                       tables)))
 
   (lambda (string pred action)
     (completion--some (lambda (table)
                         (complete-with-action action table string pred))
                       tables)))
 

+(defun completion-table-merge (&rest tables)
+  "Create a completion table that collects completions from all TABLES."
+  ;; FIXME: same caveats as in `completion-table-in-turn'.
+  (lambda (string pred action)
+    (cond
+     ((null action)
+      (let ((retvals (mapcar (lambda (table)
+                               (try-completion string table pred))
+                             tables)))
+        (if (member string retvals)
+            string
+          (try-completion string
+                          (mapcar (lambda (value)
+                                    (if (eq value t) string value))
+                                  (delq nil retvals))
+                          pred))))
+     ((eq action t)
+      (apply #'append (mapcar (lambda (table)
+                                (all-completions string table pred))
+                              tables)))
+     (t
+      (completion--some (lambda (table)
+                          (complete-with-action action table string pred))
+                        tables)))))
+

 (defun completion-table-with-quoting (table unquote requote)
   ;; A difficult part of completion-with-quoting is to map positions in the
   ;; quoted string to equivalent positions in the unquoted string and
 (defun completion-table-with-quoting (table unquote requote)
   ;; A difficult part of completion-with-quoting is to map positions in the
   ;; quoted string to equivalent positions in the unquoted string and


@@ -525,7 +573,7 @@ for use at QPOS."
   (eq t (compare-strings s1 nil nil s2 nil nil 'ignore-case)))
 
 (defun completion--twq-all (string ustring completions boundary
   (eq t (compare-strings s1 nil nil s2 nil nil 'ignore-case)))
 
 (defun completion--twq-all (string ustring completions boundary

-                                   unquote requote)
+                                   _unquote requote)

   (when completions
     (pcase-let*
         ((prefix
   (when completions
     (pcase-let*
         ((prefix


@@ -568,6 +616,17 @@ for use at QPOS."
                  (cl-assert (string-prefix-p prefix completion 'ignore-case) t)
                  (let* ((new (substring completion (length prefix)))
                         (qnew (funcall qfun new))
                  (cl-assert (string-prefix-p prefix completion 'ignore-case) t)
                  (let* ((new (substring completion (length prefix)))
                         (qnew (funcall qfun new))

+                       (qprefix
+                         (if (not completion-ignore-case)
+                             qprefix
+                           ;; Make qprefix inherit the case from `completion'.
+                           (let* ((rest (substring completion
+                                                   0 (length prefix)))
+                                  (qrest (funcall qfun rest)))
+                             (if (completion--string-equal-p qprefix qrest)
+                                 (propertize qrest 'face
+                                             'completions-common-part)
+                               qprefix))))

                         (qcompletion (concat qprefix qnew)))
                   ;; FIXME: Similarly here, Cygwin's mapping trips this
                   ;; assertion.
                         (qcompletion (concat qprefix qnew)))
                   ;; FIXME: Similarly here, Cygwin's mapping trips this
                   ;; assertion.


@@ -612,7 +671,8 @@ If ARGS are provided, then pass MESSAGE through `format'."
           (message nil)))
     ;; Clear out any old echo-area message to make way for our new thing.
     (message nil)
           (message nil)))
     ;; Clear out any old echo-area message to make way for our new thing.
     (message nil)

-    (setq message (if (and (null args) (string-match-p "\\` *\\[.+\\]\\'" message))
+    (setq message (if (and (null args)
+                           (string-match-p "\\` *\\[.+\\]\\'" message))

                       ;; Make sure we can put-text-property.
                       (copy-sequence message)
                     (concat " [" message "]")))
                       ;; Make sure we can put-text-property.
                       (copy-sequence message)
                     (concat " [" message "]")))


@@ -638,8 +698,9 @@ If ARGS are provided, then pass MESSAGE through `format'."
 
 (defun minibuffer-completion-contents ()
   "Return the user input in a minibuffer before point as a string.
 
 (defun minibuffer-completion-contents ()
   "Return the user input in a minibuffer before point as a string.

-That is what completion commands operate on."
-  (buffer-substring (field-beginning) (point)))
+In Emacs-22, that was what completion commands operated on."
+  (declare (obsolete nil "24.4"))
+  (buffer-substring (minibuffer-prompt-end) (point)))

 
 (defun delete-minibuffer-contents ()
   "Delete all user input in a minibuffer.
 
 (defun delete-minibuffer-contents ()
   "Delete all user input in a minibuffer.


@@ -658,8 +719,7 @@ If the value is t the *Completion* buffer is displayed whenever completion
 is requested but cannot be done.
 If the value is `lazy', the *Completions* buffer is only displayed after
 the second failed attempt to complete."
 is requested but cannot be done.
 If the value is `lazy', the *Completions* buffer is only displayed after
 the second failed attempt to complete."

-  :type '(choice (const nil) (const t) (const lazy))
-  :group 'minibuffer)
+  :type '(choice (const nil) (const t) (const lazy)))

 
 (defconst completion-styles-alist
   '((emacs21
 
 (defconst completion-styles-alist
   '((emacs21


@@ -738,7 +798,6 @@ The available styles are listed in `completion-styles-alist'.
 Note that `completion-category-overrides' may override these
 styles for specific categories, such as files, buffers, etc."
   :type completion--styles-type
 Note that `completion-category-overrides' may override these
 styles for specific categories, such as files, buffers, etc."
   :type completion--styles-type

-  :group 'minibuffer

   :version "23.1")
 
 (defcustom completion-category-overrides
   :version "23.1")
 
 (defcustom completion-category-overrides


@@ -795,12 +854,12 @@ completing buffer and file names, respectively."
              (setq table (pop new))
              (setq point (pop new))
              (pop new))))
              (setq table (pop new))
              (setq point (pop new))
              (pop new))))

-       (result
-        (completion--some (lambda (style)
-                            (funcall (nth n (assq style
-                                                  completion-styles-alist))
-                                     string table pred point))
-                          (completion--styles metadata))))
+        (result
+         (completion--some (lambda (style)
+                             (funcall (nth n (assq style
+                                                   completion-styles-alist))
+                                      string table pred point))
+                           (completion--styles metadata))))

     (if requote
         (funcall requote result n)
       result)))
     (if requote
         (funcall requote result n)
       result)))


@@ -862,13 +921,14 @@ Moves point to the end of the new text."
       (setq end (- end suffix-len))
       (setq newtext (substring newtext 0 (- suffix-len))))
     (goto-char beg)
       (setq end (- end suffix-len))
       (setq newtext (substring newtext 0 (- suffix-len))))
     (goto-char beg)

-    (insert-and-inherit newtext)
-    (delete-region (point) (+ (point) (- end beg)))
+    (let ((length (- end beg)))         ;Read `end' before we insert the text.
+      (insert-and-inherit newtext)
+      (delete-region (point) (+ (point) length)))

     (forward-char suffix-len)))
 
 (defcustom completion-cycle-threshold nil
   "Number of completion candidates below which cycling is used.
     (forward-char suffix-len)))
 
 (defcustom completion-cycle-threshold nil
   "Number of completion candidates below which cycling is used.

-Depending on this setting `minibuffer-complete' may use cycling,
+Depending on this setting `completion-in-region' may use cycling,

 like `minibuffer-force-complete'.
 If nil, cycling is never used.
 If t, cycling is always used.
 like `minibuffer-force-complete'.
 If nil, cycling is never used.
 If t, cycling is always used.


@@ -882,8 +942,7 @@ completion candidates than this number."
          (over (assq 'cycle (cdr (assq cat completion-category-overrides)))))
     (if over (cdr over) completion-cycle-threshold)))
 
          (over (assq 'cycle (cdr (assq cat completion-category-overrides)))))
     (if over (cdr over) completion-cycle-threshold)))
 

-(defvar completion-all-sorted-completions nil)
-(make-variable-buffer-local 'completion-all-sorted-completions)
+(defvar-local completion-all-sorted-completions nil)

 (defvar-local completion--all-sorted-completions-location nil)
 (defvar completion-cycling nil)
 
 (defvar-local completion--all-sorted-completions-location nil)
 (defvar completion-cycling nil)
 


@@ -894,8 +953,8 @@ completion candidates than this number."
   (if completion-show-inline-help
       (minibuffer-message msg)))
 
   (if completion-show-inline-help
       (minibuffer-message msg)))
 

-(defun completion--do-completion (&optional try-completion-function
-                                            expect-exact)
+(defun completion--do-completion (beg end &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.
   "Do the completion and return a summary of what happened.
 M = completion was performed, the text was Modified.
 C = there were available Completions.


@@ -914,9 +973,7 @@ E = after completion we now have an Exact match.
 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."
 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))
+  (let* ((string (buffer-substring beg end))

          (md (completion--field-metadata beg))
          (comp (funcall (or try-completion-function
                             'completion-try-completion)
          (md (completion--field-metadata beg))
          (comp (funcall (or try-completion-function
                             'completion-try-completion)


@@ -951,7 +1008,8 @@ when the buffer's text is already an exact match."
         (if unchanged
            (goto-char end)
           ;; Insert in minibuffer the chars we got.
         (if unchanged
            (goto-char end)
           ;; Insert in minibuffer the chars we got.

-          (completion--replace beg end completion))
+          (completion--replace beg end completion)
+          (setq end (+ beg (length completion))))

        ;; Move point to its completion-mandated destination.
        (forward-char (- comp-pos (length completion)))
 
        ;; Move point to its completion-mandated destination.
        (forward-char (- comp-pos (length completion)))
 


@@ -960,7 +1018,8 @@ when the buffer's text is already 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).
             ;; 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 expect-exact)
+            (completion--do-completion beg end
+                                       try-completion-function expect-exact)

 
           ;; It did find a match.  Do we match some possibility exactly now?
           (let* ((exact (test-completion completion
 
           ;; It did find a match.  Do we match some possibility exactly now?
           (let* ((exact (test-completion completion


@@ -983,7 +1042,7 @@ when the buffer's text is already an exact match."
                                           minibuffer-completion-predicate
                                          ""))
                                    comp-pos)))
                                           minibuffer-completion-predicate
                                          ""))
                                    comp-pos)))

-                   (completion-all-sorted-completions))))
+                   (completion-all-sorted-completions beg end))))

             (completion--flush-all-sorted-completions)
             (cond
              ((and (consp (cdr comps)) ;; There's something to cycle.
             (completion--flush-all-sorted-completions)
             (cond
              ((and (consp (cdr comps)) ;; There's something to cycle.


@@ -994,8 +1053,8 @@ when the buffer's text is already an exact match."
               ;; Not more than completion-cycle-threshold remaining
               ;; completions: let's cycle.
               (setq completed t exact t)
               ;; Not more than completion-cycle-threshold remaining
               ;; completions: let's cycle.
               (setq completed t exact t)

-              (completion--cache-all-sorted-completions comps)
-              (minibuffer-force-complete))
+              (completion--cache-all-sorted-completions beg end comps)
+              (minibuffer-force-complete beg end))

              (completed
               ;; We could also decide to refresh the completions,
               ;; if they're displayed (and assuming there are
              (completed
               ;; We could also decide to refresh the completions,
               ;; if they're displayed (and assuming there are


@@ -1012,14 +1071,14 @@ when the buffer's text is already an exact match."
              (if (pcase completion-auto-help
                     (`lazy (eq this-command last-command))
                     (_ completion-auto-help))
              (if (pcase completion-auto-help
                     (`lazy (eq this-command last-command))
                     (_ completion-auto-help))

-                  (minibuffer-completion-help)
+                  (minibuffer-completion-help beg end)

                 (completion--message "Next char not unique")))
              ;; 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.
              (t
               (if (and (eq this-command last-command) completion-auto-help)
                 (completion--message "Next char not unique")))
              ;; 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.
              (t
               (if (and (eq this-command last-command) completion-auto-help)

-                  (minibuffer-completion-help))
+                  (minibuffer-completion-help beg end))

               (completion--done completion 'exact
                                 (unless expect-exact
                                   "Complete, but not unique"))))
               (completion--done completion 'exact
                                 (unless expect-exact
                                   "Complete, but not unique"))))


@@ -1033,6 +1092,11 @@ If no characters can be completed, display a list of possible completions.
 If you repeat this command after it displayed such a list,
 scroll the window of possible completions."
   (interactive)
 If you repeat this command after it displayed such a list,
 scroll the window of possible completions."
   (interactive)

+  (completion-in-region (minibuffer-prompt-end) (point-max)
+                        minibuffer-completion-table
+                        minibuffer-completion-predicate))
+
+(defun completion--in-region-1 (beg end)

   ;; If the previous command was not this,
   ;; mark the completion buffer obsolete.
   (setq this-command 'completion-at-point)
   ;; If the previous command was not this,
   ;; mark the completion buffer obsolete.
   (setq this-command 'completion-at-point)


@@ -1043,28 +1107,30 @@ scroll the window of possible completions."
   (cond
    ;; If there's a fresh completion window with a live buffer,
    ;; and this command is repeated, scroll that window.
   (cond
    ;; If there's a fresh completion window with a live buffer,
    ;; and this command is repeated, scroll that window.

-   ((window-live-p minibuffer-scroll-window)
+   ((and (window-live-p minibuffer-scroll-window)
+         (eq t (frame-visible-p (window-frame minibuffer-scroll-window))))

     (let ((window minibuffer-scroll-window))
       (with-current-buffer (window-buffer window)
         (if (pos-visible-in-window-p (point-max) window)
             ;; If end is in view, scroll up to the beginning.
             (set-window-start window (point-min) nil)
           ;; Else scroll down one screen.
     (let ((window minibuffer-scroll-window))
       (with-current-buffer (window-buffer window)
         (if (pos-visible-in-window-p (point-max) window)
             ;; If end is in view, scroll up to the beginning.
             (set-window-start window (point-min) nil)
           ;; Else scroll down one screen.

-          (scroll-other-window))
+          (with-selected-window window
+           (scroll-up)))

         nil)))
    ;; If we're cycling, keep on cycling.
    ((and completion-cycling completion-all-sorted-completions)
         nil)))
    ;; If we're cycling, keep on cycling.
    ((and completion-cycling completion-all-sorted-completions)

-    (minibuffer-force-complete)
+    (minibuffer-force-complete beg end)

     t)
     t)

-   (t (pcase (completion--do-completion)
+   (t (pcase (completion--do-completion beg end)

         (#b000 nil)
         (_     t)))))
 
         (#b000 nil)
         (_     t)))))
 

-(defun completion--cache-all-sorted-completions (comps)
+(defun completion--cache-all-sorted-completions (beg end comps)

   (add-hook 'after-change-functions
             'completion--flush-all-sorted-completions nil t)
   (setq completion--all-sorted-completions-location
   (add-hook 'after-change-functions
             'completion--flush-all-sorted-completions nil t)
   (setq completion--all-sorted-completions-location

-        (cons (copy-marker (field-beginning)) (copy-marker (field-end))))
+        (cons (copy-marker beg) (copy-marker end)))

   (setq completion-all-sorted-completions comps))
 
 (defun completion--flush-all-sorted-completions (&optional start end _len)
   (setq completion-all-sorted-completions comps))
 
 (defun completion--flush-all-sorted-completions (&optional start end _len)


@@ -1084,10 +1150,10 @@ scroll the window of possible completions."
     (if (eq (car bounds) base) md-at-point
       (completion-metadata (substring string 0 base) table pred))))
 
     (if (eq (car bounds) base) md-at-point
       (completion-metadata (substring string 0 base) table pred))))
 

-(defun completion-all-sorted-completions ()
+(defun completion-all-sorted-completions (&optional start end)

   (or completion-all-sorted-completions
   (or completion-all-sorted-completions

-      (let* ((start (field-beginning))
-             (end (field-end))
+      (let* ((start (or start (minibuffer-prompt-end)))
+             (end (or end (point-max)))

              (string (buffer-substring start end))
              (md (completion--field-metadata start))
              (all (completion-all-completions
              (string (buffer-substring start end))
              (md (completion--field-metadata start))
              (all (completion-all-completions


@@ -1125,28 +1191,31 @@ scroll the window of possible completions."
           ;; Cache the result.  This is not just for speed, but also so that
           ;; repeated calls to minibuffer-force-complete can cycle through
           ;; all possibilities.
           ;; Cache the result.  This is not just for speed, but also so that
           ;; repeated calls to minibuffer-force-complete can cycle through
           ;; all possibilities.

-          (completion--cache-all-sorted-completions (nconc all base-size))))))
+          (completion--cache-all-sorted-completions
+           start end (nconc all base-size))))))

 
 (defun minibuffer-force-complete-and-exit ()
   "Complete the minibuffer with first of the matches and exit."
   (interactive)
   (minibuffer-force-complete)
 
 (defun minibuffer-force-complete-and-exit ()
   "Complete the minibuffer with first of the matches and exit."
   (interactive)
   (minibuffer-force-complete)

-  (minibuffer--complete-and-exit
+  (completion--complete-and-exit
+   (minibuffer-prompt-end) (point-max) #'exit-minibuffer

    ;; If the previous completion completed to an element which fails
    ;; test-completion, then we shouldn't exit, but that should be rare.
    (lambda () (minibuffer-message "Incomplete"))))
 
    ;; If the previous completion completed to an element which fails
    ;; test-completion, then we shouldn't exit, but that should be rare.
    (lambda () (minibuffer-message "Incomplete"))))
 

-(defun minibuffer-force-complete ()
+(defun minibuffer-force-complete (&optional start end)

   "Complete the minibuffer to an exact match.
 Repeated uses step through the possible completions."
   (interactive)
   "Complete the minibuffer to an exact match.
 Repeated uses step through the possible completions."
   (interactive)

+  (setq minibuffer-scroll-window nil)

   ;; FIXME: Need to deal with the extra-size issue here as well.
   ;; FIXME: ~/src/emacs/t<M-TAB>/lisp/minibuffer.el completes to
   ;; ~/src/emacs/trunk/ and throws away lisp/minibuffer.el.
   ;; FIXME: Need to deal with the extra-size issue here as well.
   ;; FIXME: ~/src/emacs/t<M-TAB>/lisp/minibuffer.el completes to
   ;; ~/src/emacs/trunk/ and throws away lisp/minibuffer.el.

-  (let* ((start (copy-marker (field-beginning)))
-         (end (field-end))
+  (let* ((start (copy-marker (or start (minibuffer-prompt-end))))
+         (end (or end (point-max)))

          ;; (md (completion--field-metadata start))
          ;; (md (completion--field-metadata start))

-         (all (completion-all-sorted-completions))
+         (all (completion-all-sorted-completions start end))

          (base (+ start (or (cdr (last all)) 0))))
     (cond
      ((not (consp all))
          (base (+ start (or (cdr (last all)) 0))))
     (cond
      ((not (consp all))


@@ -1159,9 +1228,11 @@ Repeated uses step through the possible completions."
                           'finished (when done "Sole completion"))))
      (t
       (completion--replace base end (car all))
                           'finished (when done "Sole completion"))))
      (t
       (completion--replace base end (car all))

+      (setq end (+ base (length (car all))))

       (completion--done (buffer-substring-no-properties start (point)) 'sole)
       ;; Set cycling after modifying the buffer since the flush hook resets it.
       (setq completion-cycling t)
       (completion--done (buffer-substring-no-properties start (point)) 'sole)
       ;; Set cycling after modifying the buffer since the flush hook resets it.
       (setq completion-cycling t)

+      (setq this-command 'completion-at-point) ;For completion-in-region.

       ;; 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,
       ;; 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,


@@ -1169,7 +1240,7 @@ Repeated uses step through the possible completions."
       ;; through the previous possible completions.
       (let ((last (last all)))
         (setcdr last (cons (car all) (cdr last)))
       ;; through the previous possible completions.
       (let ((last (last all)))
         (setcdr last (cons (car all) (cdr last)))

-        (completion--cache-all-sorted-completions (cdr all)))
+        (completion--cache-all-sorted-completions start end (cdr all)))

       ;; Make sure repeated uses cycle, even though completion--done might
       ;; have added a space or something that moved us outside of the field.
       ;; (bug#12221).
       ;; Make sure repeated uses cycle, even though completion--done might
       ;; have added a space or something that moved us outside of the field.
       ;; (bug#12221).


@@ -1181,7 +1252,7 @@ Repeated uses step through the possible completions."
                 (interactive)
                 (let ((completion-extra-properties extra-prop))
                   (completion-in-region start (point) table pred)))))
                 (interactive)
                 (let ((completion-extra-properties extra-prop))
                   (completion-in-region start (point) table pred)))))

-        (set-temporary-overlay-map
+        (set-transient-map

          (let ((map (make-sparse-keymap)))
            (define-key map [remap completion-at-point] cmd)
            (define-key map (vector last-command-event) cmd)
          (let ((map (make-sparse-keymap)))
            (define-key map [remap completion-at-point] cmd)
            (define-key map (vector last-command-event) cmd)


@@ -1208,27 +1279,32 @@ If `minibuffer-completion-confirm' is `confirm-after-completion',
  `minibuffer-confirm-exit-commands', and accept the input
  otherwise."
   (interactive)
  `minibuffer-confirm-exit-commands', and accept the input
  otherwise."
   (interactive)

-  (minibuffer--complete-and-exit
+  (completion-complete-and-exit (minibuffer-prompt-end) (point-max)
+                                #'exit-minibuffer))
+
+(defun completion-complete-and-exit (beg end exit-function)
+  (completion--complete-and-exit
+   beg end exit-function

    (lambda ()
      (pcase (condition-case nil
    (lambda ()
      (pcase (condition-case nil

-                (completion--do-completion nil 'expect-exact)
+                (completion--do-completion beg end
+                                           nil 'expect-exact)

               (error 1))
               (error 1))

-       ((or #b001 #b011) (exit-minibuffer))
+       ((or #b001 #b011) (funcall exit-function))

        (#b111 (if (not minibuffer-completion-confirm)
        (#b111 (if (not minibuffer-completion-confirm)

-                  (exit-minibuffer)
+                  (funcall exit-function)

                 (minibuffer-message "Confirm")
                 nil))
        (_ nil)))))
 
                 (minibuffer-message "Confirm")
                 nil))
        (_ nil)))))
 

-(defun minibuffer--complete-and-exit (completion-function)
+(defun completion--complete-and-exit (beg end
+                                          exit-function completion-function)

   "Exit from `require-match' minibuffer.
 COMPLETION-FUNCTION is called if the current buffer's content does not
 appear to be a match."
   "Exit from `require-match' minibuffer.
 COMPLETION-FUNCTION is called if the current buffer's content does not
 appear to be a match."

-  (let ((beg (field-beginning))
-        (end (field-end)))

     (cond
      ;; Allow user to specify null string
     (cond
      ;; Allow user to specify null string

-     ((= beg end) (exit-minibuffer))
+   ((= beg end) (funcall exit-function))

      ((test-completion (buffer-substring beg end)
                        minibuffer-completion-table
                        minibuffer-completion-predicate)
      ((test-completion (buffer-substring beg end)
                        minibuffer-completion-table
                        minibuffer-completion-predicate)


@@ -1254,7 +1330,7 @@ appear to be a match."
                      ;; that file.
                      (= (length string) (length compl)))
             (completion--replace beg end compl))))
                      ;; that file.
                      (= (length string) (length compl)))
             (completion--replace beg end compl))))

-      (exit-minibuffer))
+    (funcall exit-function))

 
      ((memq minibuffer-completion-confirm '(confirm confirm-after-completion))
       ;; The user is permitted to exit with an input that's rejected
 
      ((memq minibuffer-completion-confirm '(confirm confirm-after-completion))
       ;; The user is permitted to exit with an input that's rejected


@@ -1265,13 +1341,13 @@ appear to be a match."
               ;; catches most minibuffer typos).
               (and (eq minibuffer-completion-confirm 'confirm-after-completion)
                    (not (memq last-command minibuffer-confirm-exit-commands))))
               ;; catches most minibuffer typos).
               (and (eq minibuffer-completion-confirm 'confirm-after-completion)
                    (not (memq last-command minibuffer-confirm-exit-commands))))

-          (exit-minibuffer)
+        (funcall exit-function)

         (minibuffer-message "Confirm")
         nil))
 
      (t
       ;; Call do-completion, but ignore errors.
         (minibuffer-message "Confirm")
         nil))
 
      (t
       ;; Call do-completion, but ignore errors.

-      (funcall completion-function)))))
+    (funcall completion-function))))

 
 (defun completion--try-word-completion (string table predicate point md)
   (let ((comp (completion-try-completion string table predicate point md)))
 
 (defun completion--try-word-completion (string table predicate point md)
   (let ((comp (completion-try-completion string table predicate point md)))


@@ -1288,16 +1364,19 @@ appear to be a match."
         ;; instead, but it was too blunt, leading to situations where SPC
         ;; was the only insertable char at point but minibuffer-complete-word
         ;; refused inserting it.
         ;; instead, but it was too blunt, leading to situations where SPC
         ;; was the only insertable char at point but minibuffer-complete-word
         ;; refused inserting it.

-        (let ((exts (mapcar (lambda (str) (propertize str 'completion-try-word t))
-                            '(" " "-")))
-              (before (substring string 0 point))
-              (after (substring string point))
-             tem)
-         (while (and exts (not (consp tem)))
-            (setq tem (completion-try-completion
-                      (concat before (pop exts) after)
-                      table predicate (1+ point) md)))
-         (if (consp tem) (setq comp tem))))
+        (let* ((exts (mapcar (lambda (str) (propertize str 'completion-try-word t))
+                            '(" " "-")))
+              (before (substring string 0 point))
+              (after (substring string point))
+              (comps
+               (delete nil
+                       (mapcar (lambda (ext)
+                                 (completion-try-completion
+                                  (concat before ext after)
+                                  table predicate (1+ point) md))
+                               exts))))
+         (when (and (null (cdr comps)) (consp (car comps)))
+           (setq comp (car comps)))))

 
       ;; Completing a single word is actually more difficult than completing
       ;; as much as possible, because we first have to find the "current
 
       ;; Completing a single word is actually more difficult than completing
       ;; as much as possible, because we first have to find the "current


@@ -1366,9 +1445,18 @@ After one word is completed as much as possible, a space or hyphen
 is added, provided that matches some possible completion.
 Return nil if there is no valid completion, else t."
   (interactive)
 is added, provided that matches some possible completion.
 Return nil if there is no valid completion, else t."
   (interactive)

-  (pcase (completion--do-completion 'completion--try-word-completion)
+  (completion-in-region--single-word
+   (minibuffer-prompt-end) (point-max)
+   minibuffer-completion-table minibuffer-completion-predicate))
+
+(defun completion-in-region--single-word (beg end collection
+                                              &optional predicate)
+  (let ((minibuffer-completion-table collection)
+        (minibuffer-completion-predicate predicate))
+    (pcase (completion--do-completion beg end
+                                      #'completion--try-word-completion)

     (#b000 nil)
     (#b000 nil)

-    (_     t)))
+      (_     t))))

 
 (defface completions-annotations '((t :inherit italic))
   "Face to use for annotations in the *Completions* buffer.")
 
 (defface completions-annotations '((t :inherit italic))
   "Face to use for annotations in the *Completions* buffer.")


@@ -1380,7 +1468,6 @@ in columns in the *Completions* buffer.
 If the value is `horizontal', display completions sorted
 horizontally in alphabetical order, rather than down the screen."
   :type '(choice (const horizontal) (const vertical))
 If the value is `horizontal', display completions sorted
 horizontally in alphabetical order, rather than down the screen."
   :type '(choice (const horizontal) (const vertical))

-  :group 'minibuffer

   :version "23.2")
 
 (defun completion--insert-strings (strings)
   :version "23.2")
 
 (defun completion--insert-strings (strings)


@@ -1458,9 +1545,11 @@ It also eliminates runs of equal strings."
                                    'mouse-face 'highlight)
               (put-text-property (point) (progn (insert (car str)) (point))
                                  'mouse-face 'highlight)
                                    'mouse-face 'highlight)
               (put-text-property (point) (progn (insert (car str)) (point))
                                  'mouse-face 'highlight)

-              (add-text-properties (point) (progn (insert (cadr str)) (point))
-                                   '(mouse-face nil
-                                     face completions-annotations)))
+              (let ((beg (point))
+                    (end (progn (insert (cadr str)) (point))))
+                (put-text-property beg end 'mouse-face nil)
+                (font-lock-prepend-text-property beg end 'face
+                                                 'completions-annotations)))

            (cond
             ((eq completions-format 'vertical)
              ;; Vertical format
            (cond
             ((eq completions-format 'vertical)
              ;; Vertical format


@@ -1487,18 +1576,26 @@ See also `display-completion-list'.")
 
 (defface completions-first-difference
   '((t (:inherit bold)))
 
 (defface completions-first-difference
   '((t (:inherit bold)))

-  "Face put on the first uncommon character in completions in *Completions* buffer."
-  :group 'completion)
-
-(defface completions-common-part
-  '((t (:inherit default)))
-  "Face put on the common prefix substring in completions in *Completions* buffer.
-The idea of `completions-common-part' is that you can use it to
-make the common parts less visible than normal, so that the rest
-of the differing parts is, by contrast, slightly highlighted."
-  :group 'completion)
-
-(defun completion-hilit-commonality (completions prefix-len base-size)
+  "Face for the first uncommon character in completions.
+See also the face `completions-common-part'.")
+
+(defface completions-common-part '((t nil))
+  "Face for the common prefix substring in completions.
+The idea of this face is that you can use it to make the common parts
+less visible than normal, so that the differing parts are emphasized
+by contrast.
+See also the face `completions-first-difference'.")
+
+(defun completion-hilit-commonality (completions prefix-len &optional base-size)
+  "Apply font-lock highlighting to a list of completions, COMPLETIONS.
+PREFIX-LEN is an integer.  BASE-SIZE is an integer or nil (meaning zero).
+
+This adds the face `completions-common-part' to the first
+\(PREFIX-LEN - BASE-SIZE) characters of each completion, and the face
+`completions-first-difference' to the first character after that.
+
+It returns a list with font-lock properties applied to each element,
+and with BASE-SIZE appended as the last element."

   (when completions
     (let ((com-str-len (- prefix-len (or base-size 0))))
       (nconc
   (when completions
     (let ((com-str-len (- prefix-len (or base-size 0))))
       (nconc


@@ -1513,17 +1610,18 @@ of the differing parts is, by contrast, slightly highlighted."
                      (car (setq elem (cons (copy-sequence (car elem))
                                            (cdr elem))))
                    (setq elem (copy-sequence elem)))))
                      (car (setq elem (cons (copy-sequence (car elem))
                                            (cdr elem))))
                    (setq elem (copy-sequence elem)))))

-            (put-text-property 0
-                              ;; If completion-boundaries returns incorrect
-                              ;; values, all-completions may return strings
-                              ;; that don't contain the prefix.
-                              (min com-str-len (length str))
-                               'font-lock-face 'completions-common-part
-                               str)
+            (font-lock-prepend-text-property
+             0
+             ;; If completion-boundaries returns incorrect
+             ;; values, all-completions may return strings
+             ;; that don't contain the prefix.
+             (min com-str-len (length str))
+             'face 'completions-common-part str)

             (if (> (length str) com-str-len)
             (if (> (length str) com-str-len)

-                (put-text-property com-str-len (1+ com-str-len)
-                                   'font-lock-face 'completions-first-difference
-                                   str)))
+                (font-lock-prepend-text-property com-str-len (1+ com-str-len)
+                                                 'face
+                                                 'completions-first-difference
+                                                 str)))

           elem)
         completions)
        base-size))))
           elem)
         completions)
        base-size))))


@@ -1538,12 +1636,8 @@ alternative, the second serves as annotation.
 The actual completion alternatives, as inserted, are given `mouse-face'
 properties of `highlight'.
 At the end, this runs the normal hook `completion-setup-hook'.
 The actual completion alternatives, as inserted, are given `mouse-face'
 properties of `highlight'.
 At the end, this runs the normal hook `completion-setup-hook'.

-It can find the completion buffer in `standard-output'.
-
-The obsolete optional arg COMMON-SUBSTRING, if non-nil, should be a string
-specifying a common substring for adding the faces
-`completions-first-difference' and `completions-common-part' to
-the completions buffer."
+It can find the completion buffer in `standard-output'."
+  (declare (advertised-calling-convention (completions) "24.4"))

   (if common-substring
       (setq completions (completion-hilit-commonality
                          completions (length common-substring)
   (if common-substring
       (setq completions (completion-hilit-commonality
                          completions (length common-substring)


@@ -1630,19 +1724,19 @@ variables.")
                (equal pre-msg (and exit-fun (current-message))))
       (completion--message message))))
 
                (equal pre-msg (and exit-fun (current-message))))
       (completion--message message))))
 

-(defun minibuffer-completion-help ()
+(defun minibuffer-completion-help (&optional start end)

   "Display a list of possible completions of the current minibuffer contents."
   (interactive)
   (message "Making completion list...")
   "Display a list of possible completions of the current minibuffer contents."
   (interactive)
   (message "Making completion list...")

-  (let* ((start (field-beginning))
-         (end (field-end))
-         (string (field-string))
+  (let* ((start (or start (minibuffer-prompt-end)))
+         (end (or end (point-max)))
+         (string (buffer-substring start end))

          (md (completion--field-metadata start))
          (completions (completion-all-completions
                        string
                        minibuffer-completion-table
                        minibuffer-completion-predicate
          (md (completion--field-metadata start))
          (completions (completion-all-completions
                        string
                        minibuffer-completion-table
                        minibuffer-completion-predicate

-                       (- (point) (field-beginning))
+                       (- (point) start)

                        md)))
     (message nil)
     (if (or (null completions)
                        md)))
     (message nil)
     (if (or (null completions)


@@ -1758,14 +1852,15 @@ variables.")
   (exit-minibuffer))
 
 (defvar completion-in-region-functions nil
   (exit-minibuffer))
 
 (defvar completion-in-region-functions nil

-  "Wrapper hook around `completion-in-region'.
-The functions on this special hook are called with 5 arguments:
-  NEXT-FUN START END COLLECTION PREDICATE.
-NEXT-FUN is a function of four arguments (START END COLLECTION PREDICATE)
-that performs the default operation.  The other four arguments are like
-the ones passed to `completion-in-region'.  The functions on this hook
-are expected to perform completion on START..END using COLLECTION
-and PREDICATE, either by calling NEXT-FUN or by doing it themselves.")
+  "Wrapper hook around `completion-in-region'.")
+(make-obsolete-variable 'completion-in-region-functions
+                        'completion-in-region-function "24.4")
+
+(defvar completion-in-region-function #'completion--in-region
+  "Function to perform the job of `completion-in-region'.
+The function is called with 4 arguments: START END COLLECTION PREDICATE.
+The arguments and expected return value are like the ones of
+`completion-in-region'.")

 
 (defvar completion-in-region--data nil)
 
 
 (defvar completion-in-region--data nil)
 


@@ -1787,27 +1882,30 @@ Point needs to be somewhere between START and END.
 PREDICATE (a function called with no arguments) says when to
 exit."
   (cl-assert (<= start (point)) (<= (point) end))
 PREDICATE (a function called with no arguments) says when to
 exit."
   (cl-assert (<= start (point)) (<= (point) end))

+  (funcall completion-in-region-function start end collection predicate))
+
+(defcustom read-file-name-completion-ignore-case
+  (if (memq system-type '(ms-dos windows-nt darwin cygwin))
+      t nil)
+  "Non-nil means when reading a file name completion ignores case."
+  :type 'boolean
+  :version "22.1")
+
+(defun completion--in-region (start end collection &optional predicate)

   (with-wrapper-hook
       ;; FIXME: Maybe we should use this hook to provide a "display
       ;; completions" operation as well.
       completion-in-region-functions (start end collection predicate)
     (let ((minibuffer-completion-table collection)
   (with-wrapper-hook
       ;; FIXME: Maybe we should use this hook to provide a "display
       ;; completions" operation as well.
       completion-in-region-functions (start end collection predicate)
     (let ((minibuffer-completion-table collection)

-          (minibuffer-completion-predicate predicate)
-          (ol (make-overlay start end nil nil t)))
-      (overlay-put ol 'field 'completion)
+          (minibuffer-completion-predicate predicate))

       ;; HACK: if the text we are completing is already in a field, we
       ;; want the completion field to take priority (e.g. Bug#6830).
       ;; HACK: if the text we are completing is already in a field, we
       ;; want the completion field to take priority (e.g. Bug#6830).

-      (overlay-put ol 'priority 100)

       (when completion-in-region-mode-predicate
       (when completion-in-region-mode-predicate

-        (completion-in-region-mode 1)

         (setq completion-in-region--data
         (setq completion-in-region--data

-             (list (if (markerp start) start (copy-marker start))
-                    (copy-marker end) collection)))
-      ;; FIXME: `minibuffer-complete' should call `completion-in-region' rather
-      ;; than the other way around!
-      (unwind-protect
-          (call-interactively 'minibuffer-complete)
-        (delete-overlay ol)))))
+             `(,(if (markerp start) start (copy-marker start))
+                ,(copy-marker end t) ,collection ,predicate))
+        (completion-in-region-mode 1))
+      (completion--in-region-1 start end))))

 
 (defvar completion-in-region-mode-map
   (let ((map (make-sparse-keymap)))
 
 (defvar completion-in-region-mode-map
   (let ((map (make-sparse-keymap)))


@@ -1840,21 +1938,25 @@ exit."
 
 ;; (defalias 'completion-in-region--prech 'completion-in-region--postch)
 
 
 ;; (defalias 'completion-in-region--prech 'completion-in-region--postch)
 

+(defvar completion-in-region-mode nil)  ;Explicit defvar, i.s.o defcustom.
+

 (define-minor-mode completion-in-region-mode
 (define-minor-mode completion-in-region-mode

-  "Transient minor mode used during `completion-in-region'.
-With a prefix argument ARG, enable the modemode if ARG is
-positive, and disable it otherwise.  If called from Lisp, enable
-the mode if ARG is omitted or nil."
+  "Transient minor mode used during `completion-in-region'."

   :global t
   :global t

-  (setq completion-in-region--data nil)
+  :group 'minibuffer
+  ;; Prevent definition of a custom-variable since it makes no sense to
+  ;; customize this variable.
+  :variable completion-in-region-mode

   ;; (remove-hook 'pre-command-hook #'completion-in-region--prech)
   (remove-hook 'post-command-hook #'completion-in-region--postch)
   (setq minor-mode-overriding-map-alist
         (delq (assq 'completion-in-region-mode minor-mode-overriding-map-alist)
               minor-mode-overriding-map-alist))
   (if (null completion-in-region-mode)
   ;; (remove-hook 'pre-command-hook #'completion-in-region--prech)
   (remove-hook 'post-command-hook #'completion-in-region--postch)
   (setq minor-mode-overriding-map-alist
         (delq (assq 'completion-in-region-mode minor-mode-overriding-map-alist)
               minor-mode-overriding-map-alist))
   (if (null completion-in-region-mode)

-      (unless (equal "*Completions*" (buffer-name (window-buffer)))
-       (minibuffer-hide-completions))
+      (progn
+        (setq completion-in-region--data nil)
+        (unless (equal "*Completions*" (buffer-name (window-buffer)))
+          (minibuffer-hide-completions)))

     ;; (add-hook 'pre-command-hook #'completion-in-region--prech)
     (cl-assert completion-in-region-mode-predicate)
     (setq completion-in-region-mode--predicate
     ;; (add-hook 'pre-command-hook #'completion-in-region--prech)
     (cl-assert completion-in-region-mode-predicate)
     (setq completion-in-region-mode--predicate


@@ -1971,19 +2073,15 @@ The completion method is determined by `completion-at-point-functions'."
                (lambda ()
                  ;; We're still in the same completion field.
                  (let ((newstart (car-safe (funcall hookfun))))
                (lambda ()
                  ;; We're still in the same completion field.
                  (let ((newstart (car-safe (funcall hookfun))))

-                   (and newstart (= newstart start)))))
-              (ol (make-overlay start end nil nil t)))
+                   (and newstart (= newstart start))))))

          ;; FIXME: We should somehow (ab)use completion-in-region-function or
          ;; introduce a corresponding hook (plus another for word-completion,
          ;; and another for force-completion, maybe?).
          ;; FIXME: We should somehow (ab)use completion-in-region-function or
          ;; introduce a corresponding hook (plus another for word-completion,
          ;; and another for force-completion, maybe?).

-         (overlay-put ol 'field 'completion)
-         (overlay-put ol 'priority 100)
-         (completion-in-region-mode 1)

          (setq completion-in-region--data
          (setq completion-in-region--data

-               (list start (copy-marker end) collection))
-         (unwind-protect
-             (call-interactively 'minibuffer-completion-help)
-           (delete-overlay ol))))
+               `(,start ,(copy-marker end t) ,collection
+                        ,(plist-get plist :predicate)))
+         (completion-in-region-mode 1)
+         (minibuffer-completion-help start end)))

       (`(,hookfun . ,_)
        ;; The hook function already performed completion :-(
        ;; Not much we can do at this point.
       (`(,hookfun . ,_)
        ;; The hook function already performed completion :-(
        ;; Not much we can do at this point.


@@ -2257,14 +2355,6 @@ except that it passes the file name through `substitute-in-file-name'.")
   "The function called by `read-file-name' to do its work.
 It should accept the same arguments as `read-file-name'.")
 
   "The function called by `read-file-name' to do its work.
 It should accept the same arguments as `read-file-name'.")
 

-(defcustom read-file-name-completion-ignore-case
-  (if (memq system-type '(ms-dos windows-nt darwin cygwin))
-      t nil)
-  "Non-nil means when reading a file name completion ignores case."
-  :group 'minibuffer
-  :type 'boolean
-  :version "22.1")
-

 (defcustom insert-default-directory t
   "Non-nil means when reading a filename start with default dir in minibuffer.
 
 (defcustom insert-default-directory t
   "Non-nil means when reading a filename start with default dir in minibuffer.
 


@@ -2286,7 +2376,6 @@ the minibuffer empty.
 For some commands, exiting with an empty minibuffer has a special meaning,
 such as making the current buffer visit no file in the case of
 `set-visited-file-name'."
 For some commands, exiting with an empty minibuffer has a special meaning,
 such as making the current buffer visit no file in the case of
 `set-visited-file-name'."

-  :group 'minibuffer

   :type 'boolean)
 
 ;; Not always defined, but only called if next-read-file-uses-dialog-p says so.
   :type 'boolean)
 
 ;; Not always defined, but only called if next-read-file-uses-dialog-p says so.


@@ -2321,7 +2410,7 @@ such as making the current buffer visit no file in the case of
 
 (defun read-file-name (prompt &optional dir default-filename mustmatch initial predicate)
   "Read file name, prompting with PROMPT and completing in directory DIR.
 
 (defun read-file-name (prompt &optional dir default-filename mustmatch initial predicate)
   "Read file name, prompting with PROMPT and completing in directory DIR.

-Value is not expanded---you must call `expand-file-name' yourself.
+The return value is not expanded---you must call `expand-file-name' yourself.

 
 DIR is the directory to use for completing relative file names.
 It should be an absolute directory name, or nil (which means the
 
 DIR is the directory to use for completing relative file names.
 It should be an absolute directory name, or nil (which means the


@@ -2679,7 +2768,6 @@ expression (not containing character ranges like `a-z')."
          ;; Refresh other vars.
          (completion-pcm--prepare-delim-re value))
   :initialize 'custom-initialize-reset
          ;; Refresh other vars.
          (completion-pcm--prepare-delim-re value))
   :initialize 'custom-initialize-reset

-  :group 'minibuffer

   :type 'string)
 
 (defcustom completion-pcm-complete-word-inserts-delimiters nil
   :type 'string)
 
 (defcustom completion-pcm-complete-word-inserts-delimiters nil


@@ -2712,7 +2800,8 @@ or a symbol, see `completion-pcm--merge-completions'."
                 (completion-pcm--string->pattern suffix)))
     (let* ((pattern nil)
            (p 0)
                 (completion-pcm--string->pattern suffix)))
     (let* ((pattern nil)
            (p 0)

-           (p0 p))
+           (p0 p)
+           (pending nil))

 
       (while (and (setq p (string-match completion-pcm--delim-wild-regex
                                         string p))
 
       (while (and (setq p (string-match completion-pcm--delim-wild-regex
                                         string p))


@@ -2729,18 +2818,49 @@ or a symbol, see `completion-pcm--merge-completions'."
         ;; This is determined by the presence of a submatch-1 which delimits
         ;; the prefix.
         (if (match-end 1) (setq p (match-end 1)))
         ;; This is determined by the presence of a submatch-1 which delimits
         ;; the prefix.
         (if (match-end 1) (setq p (match-end 1)))

-        (push (substring string p0 p) pattern)
+        (unless (= p0 p)
+          (if pending (push pending pattern))
+          (push (substring string p0 p) pattern))
+        (setq pending nil)

         (if (eq (aref string p) ?*)
             (progn
               (push 'star pattern)
               (setq p0 (1+ p)))
           (push 'any pattern)
         (if (eq (aref string p) ?*)
             (progn
               (push 'star pattern)
               (setq p0 (1+ p)))
           (push 'any pattern)

-          (setq p0 p))
-        (cl-incf p))
-
+          (if (match-end 1)
+              (setq p0 p)
+            (push (substring string p (match-end 0)) pattern)
+            ;; `any-delim' is used so that "a-b" also finds "array->beginning".
+            (setq pending 'any-delim)
+            (setq p0 (match-end 0))))
+        (setq p p0))
+
+      (when (> (length string) p0)
+        (if pending (push pending pattern))
+        (push (substring string p0) pattern))

       ;; An empty string might be erroneously added at the beginning.
       ;; It should be avoided properly, but it's so easy to remove it here.
       ;; An empty string might be erroneously added at the beginning.
       ;; It should be avoided properly, but it's so easy to remove it here.

-      (delete "" (nreverse (cons (substring string p0) pattern))))))
+      (delete "" (nreverse pattern)))))
+
+(defun completion-pcm--optimize-pattern (p)
+  ;; Remove empty strings in a separate phase since otherwise a ""
+  ;; might prevent some other optimization, as in '(any "" any).
+  (setq p (delete "" p))
+  (let ((n '()))
+    (while p
+      (pcase p
+        (`(,(and s1 (pred stringp)) ,(and s2 (pred stringp)) . ,rest)
+         (setq p (cons (concat s1 s2) rest)))
+        (`(,(and p1 (pred symbolp)) ,(and p2 (guard (eq p1 p2))) . ,_)
+         (setq p (cdr p)))
+        (`(star ,(pred symbolp) . ,rest) (setq p `(star . ,rest)))
+        (`(,(pred symbolp) star . ,rest) (setq p `(star . ,rest)))
+        (`(point ,(or `any `any-delim) . ,rest) (setq p `(point . ,rest)))
+        (`(,(or `any `any-delim) point . ,rest) (setq p `(point . ,rest)))
+        (`(any ,(or `any `any-delim) . ,rest) (setq p `(any . ,rest)))
+        (`(,(pred symbolp)) (setq p nil)) ;Implicit terminating `any'.
+        (_ (push (pop p) n))))
+    (nreverse n)))

 
 (defun completion-pcm--pattern->regex (pattern &optional group)
   (let ((re
 
 (defun completion-pcm--pattern->regex (pattern &optional group)
   (let ((re


@@ -2749,8 +2869,13 @@ or a symbol, see `completion-pcm--merge-completions'."
                   (lambda (x)
                     (cond
                      ((stringp x) (regexp-quote x))
                   (lambda (x)
                     (cond
                      ((stringp x) (regexp-quote x))

-                     ((if (consp group) (memq x group) group) "\\(.*?\\)")
-                    (t ".*?")))
+                     (t
+                      (let ((re (if (eq x 'any-delim)
+                                    (concat completion-pcm--delim-wild-regex "*?")
+                                  ".*?")))
+                        (if (if (consp group) (memq x group) group)
+                            (concat "\\(" re "\\)")
+                          re)))))

                   pattern
                   ""))))
     ;; Avoid pathological backtracking.
                   pattern
                   ""))))
     ;; Avoid pathological backtracking.


@@ -2824,11 +2949,11 @@ filter out additional entries (because TABLE might not obey PRED)."
     (setq string (substring string (car bounds) (+ point (cdr bounds))))
     (let* ((relpoint (- point (car bounds)))
            (pattern (completion-pcm--string->pattern string relpoint))
     (setq string (substring string (car bounds) (+ point (cdr bounds))))
     (let* ((relpoint (- point (car bounds)))
            (pattern (completion-pcm--string->pattern string relpoint))

-           (all (condition-case err
+           (all (condition-case-unless-debug err

                     (funcall filter
                              (completion-pcm--all-completions
                               prefix pattern table pred))
                     (funcall filter
                              (completion-pcm--all-completions
                               prefix pattern table pred))

-                  (error (unless firsterror (setq firsterror err)) nil))))
+                  (error (setq firsterror err) nil))))

       (when (and (null all)
                  (> (car bounds) 0)
                  (null (ignore-errors (try-completion prefix table pred))))
       (when (and (null all)
                  (> (car bounds) 0)
                  (null (ignore-errors (try-completion prefix table pred))))


@@ -2995,12 +3120,21 @@ the same set of elements."
                 ;; here any more.
                 (unless unique
                   (push elem res)
                 ;; here any more.
                 (unless unique
                   (push elem res)

-                  (when (memq elem '(star point prefix))
-                    ;; Extract common suffix additionally to common prefix.
-                    ;; Only do it for `point', `star', and `prefix' since for
-                    ;; `any' it could lead to a merged completion that
-                    ;; doesn't itself match the candidates.
-                    (let ((suffix (completion--common-suffix comps)))
+                  ;; Extract common suffix additionally to common prefix.
+                  ;; Don't do it for `any' since it could lead to a merged
+                  ;; completion that doesn't itself match the candidates.
+                  (when (and (memq elem '(star point prefix))
+                             ;; If prefix is one of the completions, there's no
+                             ;; suffix left to find.
+                             (not (assoc-string prefix comps t)))
+                    (let ((suffix
+                           (completion--common-suffix
+                            (if (zerop (length prefix)) comps
+                              ;; Ignore the chars in the common prefix, so we
+                              ;; don't merge '("abc" "abbc") as "ab*bc".
+                              (let ((skip (length prefix)))
+                                (mapcar (lambda (str) (substring str skip))
+                                        comps))))))

                       (cl-assert (stringp suffix))
                       (unless (equal suffix "")
                         (push suffix res)))))
                       (cl-assert (stringp suffix))
                       (unless (equal suffix "")
                         (push suffix res)))))