* src/fns.c (Fcompare_strings): Use FETCH_STRING_CHAR_AS_MULTIBYTE_ADVANCE.

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

diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 87ba8a2..e7e0834 100644 (file)
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -244,8 +244,7 @@ The result is a completion table which completes strings of the
 form (concat S1 S) in the same way as TABLE completes strings of
 the form (concat S2 S)."
   (lambda (string pred action)
 form (concat S1 S) in the same way as TABLE completes strings of
 the form (concat S2 S)."
   (lambda (string pred action)

-    (let* ((str (if (eq t (compare-strings string 0 (length s1) s1 nil nil
-                                           completion-ignore-case))
+    (let* ((str (if (string-prefix-p s1 string completion-ignore-case)

                     (concat s2 (substring string (length s1)))))
            (res (if str (complete-with-action action table str pred))))
       (when res
                     (concat s2 (substring string (length s1)))))
            (res (if str (complete-with-action action table str pred))))
       (when res


@@ -257,8 +256,7 @@ the form (concat S2 S)."
                     (+ beg (- (length s1) (length s2))))
               . ,(and (eq (car-safe res) 'boundaries) (cddr res)))))
          ((stringp res)
                     (+ beg (- (length s1) (length s2))))
               . ,(and (eq (car-safe res) 'boundaries) (cddr res)))))
          ((stringp res)

-          (if (eq t (compare-strings res 0 (length s2) s2 nil nil
-                                     completion-ignore-case))
+          (if (string-prefix-p s2 string completion-ignore-case)

               (concat s1 (substring res (length s2)))))
          ((eq action t)
           (let ((bounds (completion-boundaries str table pred "")))
               (concat s1 (substring res (length s2)))))
          ((eq action t)
           (let ((bounds (completion-boundaries str table pred "")))


@@ -529,7 +527,7 @@ for use at QPOS."
       (let* ((qpos pred)
             (ustring (funcall unquote string))
             (uprefix (funcall unquote (substring string 0 qpos)))
       (let* ((qpos pred)
             (ustring (funcall unquote string))
             (uprefix (funcall unquote (substring string 0 qpos)))

-            ;; FIXME: we really should pass `qpos' to `unuote' and have that
+            ;; FIXME: we really should pass `qpos' to `unquote' and have that

             ;; function give us the corresponding `uqpos'.  But for now we
             ;; presume (more or less) that `concat' and `unquote' commute.
             (uqpos (if (string-prefix-p uprefix ustring)
             ;; function give us the corresponding `uqpos'.  But for now we
             ;; presume (more or less) that `concat' and `unquote' commute.
             (uqpos (if (string-prefix-p uprefix ustring)


@@ -873,6 +871,7 @@ completing buffer and file names, respectively."
   ;; part of the string (e.g. substitute-in-file-name).
   (let ((requote
          (when (completion-metadata-get metadata 'completion--unquote-requote)
   ;; part of the string (e.g. substitute-in-file-name).
   (let ((requote
          (when (completion-metadata-get metadata 'completion--unquote-requote)

+           (cl-assert (functionp table))

            (let ((new (funcall table string point 'completion--unquote)))
              (setq string (pop new))
              (setq table (pop new))
            (let ((new (funcall table string point 'completion--unquote)))
              (setq string (pop new))
              (setq table (pop new))


@@ -1117,9 +1116,10 @@ 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))
+  (when (<= (minibuffer-prompt-end) (point))
+    (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,
 
 (defun completion--in-region-1 (beg end)
   ;; If the previous command was not this,


@@ -1222,12 +1222,16 @@ scroll the window of possible completions."
 (defun minibuffer-force-complete-and-exit ()
   "Complete the minibuffer with first of the matches and exit."
   (interactive)
 (defun minibuffer-force-complete-and-exit ()
   "Complete the minibuffer with first of the matches and exit."
   (interactive)

-  (minibuffer-force-complete)
-  (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 (and (eq (minibuffer-prompt-end) (point-max))
+           minibuffer-default)
+      ;; Use the provided default if there's one (bug#17545).
+      (minibuffer-complete-and-exit)
+    (minibuffer-force-complete)
+    (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")))))

 
 (defun minibuffer-force-complete (&optional start end)
   "Complete the minibuffer to an exact match.
 
 (defun minibuffer-force-complete (&optional start end)
   "Complete the minibuffer to an exact match.


@@ -1389,19 +1393,18 @@ 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))
-              (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)))))
+        (let ((exts (mapcar (lambda (str) (propertize str 'completion-try-word t))
+                            '(" " "-")))
+              (before (substring string 0 point))
+              (after (substring string point))
+             tem)
+          ;; If both " " and "-" lead to completions, prefer " " so SPC behaves
+          ;; a bit more like a self-inserting key (bug#17375).
+         (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))))

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


@@ -1877,14 +1880,14 @@ variables.")
   (exit-minibuffer))
 
 (defvar completion-in-region-functions nil
   (exit-minibuffer))
 
 (defvar completion-in-region-functions nil

-  "Wrapper hook around `completion-in-region'.")
+  "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.
 (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
+The arguments and expected return value are as specified for

 `completion-in-region'.")
 
 (defvar completion-in-region--data nil)
 `completion-in-region'.")
 
 (defvar completion-in-region--data nil)


@@ -1902,10 +1905,12 @@ we entered `completion-in-region-mode'.")
 
 (defun completion-in-region (start end collection &optional predicate)
   "Complete the text between START and END using COLLECTION.
 
 (defun completion-in-region (start end collection &optional predicate)
   "Complete the text between START and END using COLLECTION.

-Return nil if there is no valid completion, else t.

 Point needs to be somewhere between START and END.
 Point needs to be somewhere between START and END.

-PREDICATE (a function called with no arguments) says when to
-exit."
+PREDICATE (a function called with no arguments) says when to exit.
+This calls the function that `completion-in-region-function' specifies
+\(passing the same four arguments that it received) to do the work,
+and returns whatever it does.  The return value should be nil
+if there was no valid completion, else t."

   (cl-assert (<= start (point)) (<= (point) end))
   (funcall completion-in-region-function start end collection predicate))
 
   (cl-assert (<= start (point)) (<= (point) end))
   (funcall completion-in-region-function start end collection predicate))
 


@@ -1917,6 +1922,9 @@ exit."
   :version "22.1")
 
 (defun completion--in-region (start end collection &optional predicate)
   :version "22.1")
 
 (defun completion--in-region (start end collection &optional predicate)

+  "Default function to use for `completion-in-region-function'.
+Its arguments and return value are as specified for `completion-in-region'.
+This respects the wrapper hook `completion-in-region-functions'."

   (with-wrapper-hook
       ;; FIXME: Maybe we should use this hook to provide a "display
       ;; completions" operation as well.
   (with-wrapper-hook
       ;; FIXME: Maybe we should use this hook to provide a "display
       ;; completions" operation as well.


@@ -1942,7 +1950,7 @@ exit."
   "Keymap activated during `completion-in-region'.")
 
 ;; It is difficult to know when to exit completion-in-region-mode (i.e. hide
   "Keymap activated during `completion-in-region'.")
 
 ;; It is difficult to know when to exit completion-in-region-mode (i.e. hide

-;; the *Completions*).
+;; the *Completions*).  Here's how previous packages did it:

 ;; - lisp-mode: never.
 ;; - comint: only do it if you hit SPC at the right time.
 ;; - pcomplete: pop it down on SPC or after some time-delay.
 ;; - lisp-mode: never.
 ;; - comint: only do it if you hit SPC at the right time.
 ;; - pcomplete: pop it down on SPC or after some time-delay.


@@ -3057,16 +3065,9 @@ filter out additional entries (because TABLE might not obey PRED)."
       (nconc (completion-pcm--hilit-commonality pattern all)
              (length prefix)))))
 
       (nconc (completion-pcm--hilit-commonality pattern all)
              (length prefix)))))
 

-(defun completion--sreverse (str)
-  "Like `reverse' but for a string STR rather than a list."
-  (apply #'string (nreverse (mapcar 'identity str))))
-

 (defun completion--common-suffix (strs)
   "Return the common suffix of the strings STRS."
 (defun completion--common-suffix (strs)
   "Return the common suffix of the strings STRS."

-  (completion--sreverse
-   (try-completion
-    ""
-    (mapcar #'completion--sreverse strs))))
+  (nreverse (try-completion "" (mapcar #'reverse strs))))

 
 (defun completion-pcm--merge-completions (strs pattern)
   "Extract the commonality in STRS, with the help of PATTERN.
 
 (defun completion-pcm--merge-completions (strs pattern)
   "Extract the commonality in STRS, with the help of PATTERN.


@@ -3216,11 +3217,20 @@ the same set of elements."
                          ;; Not `prefix'.
                          mergedpat))
            ;; New pos from the start.
                          ;; Not `prefix'.
                          mergedpat))
            ;; New pos from the start.

-           (newpos (length (completion-pcm--pattern->string pointpat)))
+          (newpos (length (completion-pcm--pattern->string pointpat)))

            ;; Do it afterwards because it changes `pointpat' by side effect.
            (merged (completion-pcm--pattern->string (nreverse mergedpat))))
 
            ;; Do it afterwards because it changes `pointpat' by side effect.
            (merged (completion-pcm--pattern->string (nreverse mergedpat))))
 

-      (setq suffix (completion--merge-suffix merged newpos suffix))
+      (setq suffix (completion--merge-suffix
+                    ;; The second arg should ideally be "the position right
+                    ;; after the last char of `merged' that comes from the text
+                    ;; to be completed".  But completion-pcm--merge-completions
+                    ;; currently doesn't give us that info.  So instead we just
+                    ;; use the "last but one" position, which tends to work
+                    ;; well in practice since `suffix' always starts
+                    ;; with a boundary and we hence mostly/only care about
+                    ;; merging this boundary (bug#15419).
+                    merged (max 0 (1- (length merged))) suffix))

       (cons (concat prefix merged suffix) (+ newpos (length prefix)))))))
 
 (defun completion-pcm-try-completion (string table pred point)
       (cons (concat prefix merged suffix) (+ newpos (length prefix)))))))
 
 (defun completion-pcm-try-completion (string table pred point)