Spelling fixes.

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

diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index d62b377..11e195d 100644 (file)
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -51,7 +51,7 @@
 ;; - choose-completion doesn't know how to quote the text it inserts.
 ;;   E.g. it fails to double the dollars in file-name completion, or
 ;;   to backslash-escape spaces and other chars in comint completion.
 ;; - choose-completion doesn't know how to quote the text it inserts.
 ;;   E.g. it fails to double the dollars in file-name completion, or
 ;;   to backslash-escape spaces and other chars in comint completion.

-;;   - when completing ~/tmp/fo$$o, the highligting in *Completions*
+;;   - when completing ~/tmp/fo$$o, the highlighting in *Completions*

 ;;     is off by one position.
 ;;   - all code like PCM which relies on all-completions to match
 ;;     its argument gets confused because all-completions returns unquoted
 ;;     is off by one position.
 ;;   - all code like PCM which relies on all-completions to match
 ;;     its argument gets confused because all-completions returns unquoted


@@ -216,9 +216,13 @@ You should give VAR a non-nil `risky-local-variable' property."
           (setq ,var (,fun)))
         ,var))))
 
           (setq ,var (,fun)))
         ,var))))
 

-(defun completion-table-case-fold (table string pred action)
-  (let ((completion-ignore-case t))
-    (complete-with-action action table string pred)))
+(defun completion-table-case-fold (table &optional dont-fold)
+  "Return new completion TABLE that is case insensitive.
+If DONT-FOLD is non-nil, return a completion table that is
+case sensitive instead."
+  (lambda (string pred action)
+    (let ((completion-ignore-case (not dont-fold)))
+      (complete-with-action action table string pred))))

 
 (defun completion-table-with-context (prefix table string pred action)
   ;; TODO: add `suffix' maybe?
 
 (defun completion-table-with-context (prefix table string pred action)
   ;; TODO: add `suffix' maybe?


@@ -322,14 +326,15 @@ Note: TABLE needs to be a proper completion table which obeys predicates."
     (test-completion string table pred2))
    (t
     (or (complete-with-action action table string
     (test-completion string table pred2))
    (t
     (or (complete-with-action action table string

-                              (if (null pred2) pred1
+                              (if (not (and pred1 pred2))
+                                  (or pred1 pred2)

                                 (lambda (x)
                                   ;; Call `pred1' first, so that `pred2'
                                   ;; really can't tell that `x' is in table.
                                 (lambda (x)
                                   ;; Call `pred1' first, so that `pred2'
                                   ;; really can't tell that `x' is in table.

-                                  (if (funcall pred1 x) (funcall pred2 x)))))
+                                  (and (funcall pred1 x) (funcall pred2 x)))))

         ;; If completion failed and we're not applying pred1 strictly, try
         ;; again without pred1.
         ;; If completion failed and we're not applying pred1 strictly, try
         ;; again without pred1.

-        (and (not strict)
+        (and (not strict) pred1 pred2

              (complete-with-action action table string pred2))))))
 
 (defun completion-table-in-turn (&rest tables)
              (complete-with-action action table string pred2))))))
 
 (defun completion-table-in-turn (&rest tables)


@@ -467,6 +472,15 @@ ALL-COMPLETIONS is the function that lists the completions (it should
 follow the calling convention of `completion-all-completions'),
 and DOC describes the way this style of completion works.")
 
 follow the calling convention of `completion-all-completions'),
 and DOC describes the way this style of completion works.")
 

+(defconst completion--styles-type
+  `(repeat :tag "insert a new menu to add more styles"
+           (choice ,@(mapcar (lambda (x) (list 'const (car x)))
+                             completion-styles-alist))))
+(defconst completion--cycling-threshold-type
+  '(choice (const :tag "No cycling" nil)
+           (const :tag "Always cycle" t)
+           (integer :tag "Threshold")))
+

 (defcustom completion-styles
   ;; First, use `basic' because prefix completion has been the standard
   ;; for "ever" and works well in most cases, so using it first
 (defcustom completion-styles
   ;; First, use `basic' because prefix completion has been the standard
   ;; for "ever" and works well in most cases, so using it first


@@ -481,31 +495,34 @@ and DOC describes the way this style of completion works.")
     ;; and simply add "bar" to the end of the result.
     emacs22)
   "List of completion styles to use.
     ;; and simply add "bar" to the end of the result.
     emacs22)
   "List of completion styles to use.

-The available styles are listed in `completion-styles-alist'."
-  :type `(repeat (choice ,@(mapcar (lambda (x) (list 'const (car x)))
-                                   completion-styles-alist)))
+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

   :group 'minibuffer
   :version "23.1")
 
 (defcustom completion-category-overrides
   '((buffer (styles . (basic substring))))
   :group 'minibuffer
   :version "23.1")
 
 (defcustom completion-category-overrides
   '((buffer (styles . (basic substring))))

-  "List of overrides for specific categories.
+  "List of `completion-styles' overrides for specific categories.

 Each override has the shape (CATEGORY . ALIST) where ALIST is
 an association list that can specify properties such as:
 - `styles': the list of `completion-styles' to use for that category.
 - `cycle': the `completion-cycle-threshold' to use for that category."
 Each override has the shape (CATEGORY . ALIST) where ALIST is
 an association list that can specify properties such as:
 - `styles': the list of `completion-styles' to use for that category.
 - `cycle': the `completion-cycle-threshold' to use for that category."

-  :type `(alist :key-type (choice (const buffer)
+  :type `(alist :key-type (choice :tag "Category"
+                                 (const buffer)

                                   (const file)
                                   (const file)

+                                  (const unicode-name)

                                   symbol)
           :value-type
                                   symbol)
           :value-type

-          (set
-           (cons (const style)
-                 (repeat ,@(mapcar (lambda (x) (list 'const (car x)))
-                                   completion-styles-alist)))
-           (cons (const cycle)
-                 (choice (const :tag "No cycling" nil)
-                         (const :tag "Always cycle" t)
-                         (integer :tag "Threshold"))))))
+          (set :tag "Properties to override"
+          (cons :tag "Completion Styles"
+                (const :tag "Select a style from the menu;" styles)
+                ,completion--styles-type)
+           (cons :tag "Completion Cycling"
+                (const :tag "Select one value from the menu." cycle)
+                 ,completion--cycling-threshold-type))))

 
 (defun completion--styles (metadata)
   (let* ((cat (completion-metadata-get metadata 'category))
 
 (defun completion--styles (metadata)
   (let* ((cat (completion-metadata-get metadata 'category))


@@ -579,7 +596,7 @@ 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 newtext)
+    (insert-and-inherit newtext)

     (delete-region (point) (+ (point) (- end beg)))
     (forward-char suffix-len)))
 
     (delete-region (point) (+ (point) (- end beg)))
     (forward-char suffix-len)))
 


@@ -591,9 +608,7 @@ If nil, cycling is never used.
 If t, cycling is always used.
 If an integer, cycling is used as soon as there are fewer completion
 candidates than this number."
 If t, cycling is always used.
 If an integer, cycling is used as soon as there are fewer completion
 candidates than this number."

-  :type '(choice (const :tag "No cycling" nil)
-          (const :tag "Always cycle" t)
-          (integer :tag "Threshold")))
+  :type completion--cycling-threshold-type)

 
 (defun completion--cycle-threshold (metadata)
   (let* ((cat (completion-metadata-get metadata 'category))
 
 (defun completion--cycle-threshold (metadata)
   (let* ((cat (completion-metadata-get metadata 'category))


@@ -912,9 +927,7 @@ If `minibuffer-completion-confirm' is `confirm-after-completion',
                      ;; file, so `try-completion' actually completes to
                      ;; that file.
                      (= (length string) (length compl)))
                      ;; file, so `try-completion' actually completes to
                      ;; that file.
                      (= (length string) (length compl)))

-            (goto-char end)
-            (insert compl)
-            (delete-region beg end))))
+            (completion--replace beg end compl))))

       (exit-minibuffer))
 
      ((memq minibuffer-completion-confirm '(confirm confirm-after-completion))
       (exit-minibuffer))
 
      ((memq minibuffer-completion-confirm '(confirm confirm-after-completion))


@@ -1076,12 +1089,15 @@ It also eliminates runs of equal strings."
            (column 0)
           (rows (/ (length strings) columns))
           (row 0)
            (column 0)
           (rows (/ (length strings) columns))
           (row 0)

+           (first t)

           (laststring nil))
       ;; The insertion should be "sensible" no matter what choices were made
       ;; for the parameters above.
       (dolist (str strings)
        (unless (equal laststring str) ; Remove (consecutive) duplicates.
          (setq laststring str)
           (laststring nil))
       ;; The insertion should be "sensible" no matter what choices were made
       ;; for the parameters above.
       (dolist (str strings)
        (unless (equal laststring str) ; Remove (consecutive) duplicates.
          (setq laststring str)

+          ;; FIXME: `string-width' doesn't pay attention to
+          ;; `display' properties.

           (let ((length (if (consp str)
                             (+ (string-width (car str))
                                (string-width (cadr str)))
           (let ((length (if (consp str)
                             (+ (string-width (car str))
                                (string-width (cadr str)))


@@ -1100,11 +1116,11 @@ It also eliminates runs of equal strings."
                    (forward-line 1)
                    (end-of-line)))
                (insert " \t")
                    (forward-line 1)
                    (end-of-line)))
                (insert " \t")

-               (set-text-properties (- (point) 1) (point)
+               (set-text-properties (1- (point)) (point)

                                     `(display (space :align-to ,column)))))
             (t
              ;; Horizontal format
                                     `(display (space :align-to ,column)))))
             (t
              ;; Horizontal format

-             (unless (bolp)
+             (unless first

                (if (< wwidth (+ (max colwidth length) column))
                    ;; No space for `str' at point, move to next line.
                    (progn (insert "\n") (setq column 0))
                (if (< wwidth (+ (max colwidth length) column))
                    ;; No space for `str' at point, move to next line.
                    (progn (insert "\n") (setq column 0))


@@ -1112,12 +1128,13 @@ It also eliminates runs of equal strings."
                  ;; Leave the space unpropertized so that in the case we're
                  ;; already past the goal column, there is still
                  ;; a space displayed.
                  ;; Leave the space unpropertized so that in the case we're
                  ;; already past the goal column, there is still
                  ;; a space displayed.

-                 (set-text-properties (- (point) 1) (point)
+                 (set-text-properties (1- (point)) (point)

                                       ;; We can't just set tab-width, because
                                       ;; completion-setup-function will kill
                                       ;; all local variables :-(
                                       `(display (space :align-to ,column)))
                  nil))))
                                       ;; We can't just set tab-width, because
                                       ;; completion-setup-function will kill
                                       ;; all local variables :-(
                                       `(display (space :align-to ,column)))
                  nil))))

+            (setq first nil)

             (if (not (consp str))
                 (put-text-property (point) (progn (insert str) (point))
                                    'mouse-face 'highlight)
             (if (not (consp str))
                 (put-text-property (point) (progn (insert str) (point))
                                    'mouse-face 'highlight)


@@ -1770,59 +1787,60 @@ same as `substitute-in-file-name'."
 
 (defun completion-file-name-table (string pred action)
   "Completion table for file names."
 
 (defun completion-file-name-table (string pred action)
   "Completion table for file names."

-  (ignore-errors
-    (cond
-     ((eq action 'metadata) '(metadata (category . file)))
-     ((eq (car-safe action) 'boundaries)
-      (let ((start (length (file-name-directory string)))
-            (end (string-match-p "/" (cdr action))))
-        (list* 'boundaries
-               ;; if `string' is "C:" in w32, (file-name-directory string)
-               ;; returns "C:/", so `start' is 3 rather than 2.
-               ;; Not quite sure what is The Right Fix, but clipping it
-               ;; back to 2 will work for this particular case.  We'll
-               ;; see if we can come up with a better fix when we bump
-               ;; into more such problematic cases.
-               (min start (length string)) end)))
-
-     ((eq action 'lambda)
-      (if (zerop (length string))
-          nil    ;Not sure why it's here, but it probably doesn't harm.
-        (funcall (or pred 'file-exists-p) string)))
+  (condition-case nil
+      (cond
+       ((eq action 'metadata) '(metadata (category . file)))
+       ((eq (car-safe action) 'boundaries)
+        (let ((start (length (file-name-directory string)))
+              (end (string-match-p "/" (cdr action))))
+          (list* 'boundaries
+                 ;; if `string' is "C:" in w32, (file-name-directory string)
+                 ;; returns "C:/", so `start' is 3 rather than 2.
+                 ;; Not quite sure what is The Right Fix, but clipping it
+                 ;; back to 2 will work for this particular case.  We'll
+                 ;; see if we can come up with a better fix when we bump
+                 ;; into more such problematic cases.
+                 (min start (length string)) end)))

 
 

-     (t
-      (let* ((name (file-name-nondirectory string))
-             (specdir (file-name-directory string))
-             (realdir (or specdir default-directory)))
+       ((eq action 'lambda)
+        (if (zerop (length string))
+            nil          ;Not sure why it's here, but it probably doesn't harm.
+          (funcall (or pred 'file-exists-p) string)))

 
 

-        (cond
-         ((null action)
-          (let ((comp (file-name-completion name realdir pred)))
-            (if (stringp comp)
-                (concat specdir comp)
-              comp)))
-
-         ((eq action t)
-          (let ((all (file-name-all-completions name realdir)))
-
-            ;; Check the predicate, if necessary.
-            (unless (memq pred '(nil file-exists-p))
-              (let ((comp ())
-                    (pred
-                     (if (eq pred 'file-directory-p)
-                         ;; Brute-force speed up for directory checking:
-                         ;; Discard strings which don't end in a slash.
-                         (lambda (s)
-                           (let ((len (length s)))
-                             (and (> len 0) (eq (aref s (1- len)) ?/))))
-                       ;; Must do it the hard (and slow) way.
-                       pred)))
-                (let ((default-directory (expand-file-name realdir)))
-                  (dolist (tem all)
-                    (if (funcall pred tem) (push tem comp))))
-                (setq all (nreverse comp))))
-
-            all))))))))
+       (t
+        (let* ((name (file-name-nondirectory string))
+               (specdir (file-name-directory string))
+               (realdir (or specdir default-directory)))
+
+          (cond
+           ((null action)
+            (let ((comp (file-name-completion name realdir pred)))
+              (if (stringp comp)
+                  (concat specdir comp)
+                comp)))
+
+           ((eq action t)
+            (let ((all (file-name-all-completions name realdir)))
+
+              ;; Check the predicate, if necessary.
+              (unless (memq pred '(nil file-exists-p))
+                (let ((comp ())
+                      (pred
+                       (if (eq pred 'file-directory-p)
+                           ;; Brute-force speed up for directory checking:
+                           ;; Discard strings which don't end in a slash.
+                           (lambda (s)
+                             (let ((len (length s)))
+                               (and (> len 0) (eq (aref s (1- len)) ?/))))
+                         ;; Must do it the hard (and slow) way.
+                         pred)))
+                  (let ((default-directory (expand-file-name realdir)))
+                    (dolist (tem all)
+                      (if (funcall pred tem) (push tem comp))))
+                  (setq all (nreverse comp))))
+
+              all))))))
+    (file-error nil)))               ;PCM often calls with invalid directories.

 
 (defvar read-file-name-predicate nil
   "Current predicate used by `read-file-name-internal'.")
 
 (defvar read-file-name-predicate nil
   "Current predicate used by `read-file-name-internal'.")


@@ -2299,7 +2317,7 @@ the commands start with a \"-\" or a SPC."
 (defun completion-pcm--string->pattern (string &optional point)
   "Split STRING into a pattern.
 A pattern is a list where each element is either a string
 (defun completion-pcm--string->pattern (string &optional point)
   "Split STRING into a pattern.
 A pattern is a list where each element is either a string

-or a symbol chosen among `any', `star', `point', `prefix'."
+or a symbol, see `completion-pcm--merge-completions'."

   (if (and point (< point (length string)))
       (let ((prefix (substring string 0 point))
             (suffix (substring string point)))
   (if (and point (< point (length string)))
       (let ((prefix (substring string 0 point))
             (suffix (substring string point)))


@@ -2409,7 +2427,7 @@ PATTERN is as returned by `completion-pcm--string->pattern'."
   "Find all completions for STRING at POINT in TABLE, satisfying PRED.
 POINT is a position inside STRING.
 FILTER is a function applied to the return value, that can be used, e.g. to
   "Find all completions for STRING at POINT in TABLE, satisfying PRED.
 POINT is a position inside STRING.
 FILTER is a function applied to the return value, that can be used, e.g. to

-filter out additional entries (because TABLE migth not obey PRED)."
+filter out additional entries (because TABLE might not obey PRED)."

   (unless filter (setq filter 'identity))
   (let* ((beforepoint (substring string 0 point))
          (afterpoint (substring string point))
   (unless filter (setq filter 'identity))
   (let* ((beforepoint (substring string 0 point))
          (afterpoint (substring string point))


@@ -2515,7 +2533,19 @@ filter out additional entries (because TABLE migth not obey PRED)."
     (mapcar 'completion--sreverse strs))))
 
 (defun completion-pcm--merge-completions (strs pattern)
     (mapcar 'completion--sreverse strs))))
 
 (defun completion-pcm--merge-completions (strs pattern)

-  "Extract the commonality in STRS, with the help of PATTERN."
+  "Extract the commonality in STRS, with the help of PATTERN.
+PATTERN can contain strings and symbols chosen among `star', `any', `point',
+and `prefix'.  They all match anything (aka \".*\") but are merged differently:
+`any' only grows from the left (when matching \"a1b\" and \"a2b\" it gets
+  completed to just \"a\").
+`prefix' only grows from the right (when matching \"a1b\" and \"a2b\" it gets
+  completed to just \"b\").
+`star' grows from both ends and is reified into a \"*\"  (when matching \"a1b\"
+  and \"a2b\" it gets completed to \"a*b\").
+`point' is like `star' except that it gets reified as the position of point
+  instead of being reified as a \"*\" character.
+The underlying idea is that we should return a string which still matches
+the same set of elements."

   ;; When completing while ignoring case, we want to try and avoid
   ;; completing "fo" to "foO" when completing against "FOO" (bug#4219).
   ;; So we try and make sure that the string we return is all made up
   ;; When completing while ignoring case, we want to try and avoid
   ;; completing "fo" to "foO" when completing against "FOO" (bug#4219).
   ;; So we try and make sure that the string we return is all made up


@@ -2568,7 +2598,9 @@ filter out additional entries (because TABLE migth not obey PRED)."
               (let* ((prefix (try-completion fixed comps))
                      (unique (or (and (eq prefix t) (setq prefix fixed))
                                  (eq t (try-completion prefix comps)))))
               (let* ((prefix (try-completion fixed comps))
                      (unique (or (and (eq prefix t) (setq prefix fixed))
                                  (eq t (try-completion prefix comps)))))

-                (unless (equal prefix "") (push prefix res))
+                (unless (or (eq elem 'prefix)
+                            (equal prefix ""))
+                  (push prefix res))

                 ;; If there's only one completion, `elem' is not useful
                 ;; any more: it can only match the empty string.
                 ;; FIXME: in some cases, it may be necessary to turn an
                 ;; If there's only one completion, `elem' is not useful
                 ;; any more: it can only match the empty string.
                 ;; FIXME: in some cases, it may be necessary to turn an


@@ -2754,15 +2786,12 @@ See `completing-read' for the meaning of the arguments."
                      base-keymap
                    ;; Layer minibuffer-local-filename-completion-map
                    ;; on top of the base map.
                      base-keymap
                    ;; Layer minibuffer-local-filename-completion-map
                    ;; on top of the base map.

-                   ;; Use make-composed-keymap so that set-keymap-parent
-                   ;; doesn't modify minibuffer-local-filename-completion-map.
-                   (let ((map (make-composed-keymap
-                               minibuffer-local-filename-completion-map)))
-                     ;; Set base-keymap as the parent, so that nil bindings
-                     ;; in minibuffer-local-filename-completion-map can
-                     ;; override bindings in base-keymap.
-                     (set-keymap-parent map base-keymap)
-                     map)))
+                   (make-composed-keymap
+                    minibuffer-local-filename-completion-map
+                    ;; Set base-keymap as the parent, so that nil bindings
+                    ;; in minibuffer-local-filename-completion-map can
+                    ;; override bindings in base-keymap.
+                    base-keymap)))

          (result (read-from-minibuffer prompt initial-input keymap
                                        nil hist def inherit-input-method)))
     (when (and (equal result "") def)
          (result (read-from-minibuffer prompt initial-input keymap
                                        nil hist def inherit-input-method)))
     (when (and (equal result "") def)