From 3dc61a0913bb72f576cfbd18ef31299f8548ab19 Mon Sep 17 00:00:00 2001
From: Stefan Monnier <monnier@iro.umontreal.ca>
Date: Mon, 3 Oct 2011 11:03:00 -0400
Subject: [PATCH] * lisp/minibuffer.el (completion-table-case-fold): Use
 currying. (completion--styles-type, completion--cycling-threshold-type): New
 constants. (completion-styles, completion-category-overrides)
 (completion-cycle-threshold): Use them. * lisp/pcomplete.el
 (pcomplete-completions-at-point): Adjust call to completion-table-case-fold.

---
 lisp/ChangeLog     | 10 ++++++++++
 lisp/minibuffer.el | 35 +++++++++++++++++++++--------------
 lisp/pcomplete.el  |  3 +--
 3 files changed, 32 insertions(+), 16 deletions(-)

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 0dab1a4f224..2a08568e74f 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,13 @@
+2011-10-03  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+	* minibuffer.el (completion-table-case-fold): Use currying.
+	(completion--styles-type, completion--cycling-threshold-type):
+	New constants.
+	(completion-styles, completion-category-overrides)
+	(completion-cycle-threshold): Use them.
+	* pcomplete.el (pcomplete-completions-at-point): Adjust call to
+	completion-table-case-fold.
+
 2011-10-03  Stephen Berman  <stephen.berman@gmx.net>
 
 	* minibuffer.el (completion-category-overrides): Fix type of styles
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index ba07a119d92..e2ed07f1ef1 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -216,9 +216,13 @@ You should give VAR a non-nil `risky-local-variable' property."
           (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?
@@ -468,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.")
 
+(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
@@ -486,8 +499,7 @@ 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 `(repeat (choice ,@(mapcar (lambda (x) (list 'const (car x)))
-                                   completion-styles-alist)))
+  :type completion--styles-type
   :group 'minibuffer
   :version "23.1")
 
@@ -501,19 +513,16 @@ an association list that can specify properties such as:
   :type `(alist :key-type (choice :tag "Category"
 				  (const buffer)
                                   (const file)
+                                  (const unicode-name)
                                   symbol)
           :value-type
           (set :tag "Properties to override"
 	   (cons :tag "Completion Styles"
 		 (const :tag "Select a style from the menu;" styles)
-		 (repeat :tag "insert a new menu to add more styles"
-			 (choice ,@(mapcar (lambda (x) (list 'const (car x)))
-					   completion-styles-alist))))
+		 ,completion--styles-type)
            (cons :tag "Completion Cycling"
 		 (const :tag "Select one value from the menu." cycle)
-                 (choice (const :tag "No cycling" nil)
-                         (const :tag "Always cycle" t)
-                         (integer :tag "Threshold"))))))
+                 ,completion--cycling-threshold-type))))
 
 (defun completion--styles (metadata)
   (let* ((cat (completion-metadata-get metadata 'category))
@@ -599,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."
-  :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))
diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el
index 4ac69df8e3a..4b25c1643af 100644
--- a/lisp/pcomplete.el
+++ b/lisp/pcomplete.el
@@ -523,8 +523,7 @@ Same as `pcomplete' but using the standard completion UI."
                            (funcall norm-func (directory-file-name f))
                            seen)))))))
           (when pcomplete-ignore-case
-            (setq table
-                  (apply-partially #'completion-table-case-fold table)))
+            (setq table (completion-table-case-fold table)))
           (list beg (point) table
                 :predicate pred
                 :exit-function
-- 
2.39.2