[elpa] master f0ac1d8 31/62: Added mixed-case case handling

[Ian Dunn]

branch: master
commit f0ac1d8f516e96cd66fc059ac4d11b1db3766d5d
Author: Ian Dunn <address@hidden>
Commit: Ian Dunn <address@hidden>

    Added mixed-case case handling
    
    * paced.el (paced-dictionary): Added mixed-case option
      (paced-mixed-case-word-p): New defun.
      (paced--handle-word-case): Add case for mixed-case.
      (paced-dictionary-fix-completion-case): Add case for mixed-case
    
    * paced-tests.el (paced-mixed-case-word): New test
      (paced-handle-word-case): Added case for mixed-case.
---
 paced-tests.el | 13 ++++++++++++-
 paced.el       | 45 ++++++++++++++++++++++++++++++++++++++++-----
 2 files changed, 52 insertions(+), 6 deletions(-)

diff --git a/paced-tests.el b/paced-tests.el
index 96fb32f..041f4d0 100644
--- a/paced-tests.el
+++ b/paced-tests.el
@@ -45,7 +45,18 @@
     (should (string-equal (paced--handle-word-case 'downcase word) "eieio"))
     (should (string-equal (paced--handle-word-case 'upcase   word) "EIEIO"))
     (should (string-equal (paced--handle-word-case 'downcase-first word) 
"eiEiO"))
-    (should (string-equal (paced--handle-word-case 'upcase-first word) 
"EiEiO"))))
+    (should (string-equal (paced--handle-word-case 'upcase-first word) 
"EiEiO"))
+    (should (string-equal (paced--handle-word-case 'mixed-case word) 
"EiEiO"))))
+
+(ert-deftest paced-mixed-case-word ()
+  (should-not (paced-mixed-case-word-p "HAS"))
+  (should     (paced-mixed-case-word-p "HAs"))
+  (should     (paced-mixed-case-word-p "HaS"))
+  (should-not (paced-mixed-case-word-p "Has"))
+  (should     (paced-mixed-case-word-p "hAS"))
+  (should     (paced-mixed-case-word-p "hAs"))
+  (should     (paced-mixed-case-word-p "haS"))
+  (should-not (paced-mixed-case-word-p "has")))
 
 (ert-deftest paced-create-dictionary ()
   (let* ((paced--registered-dictionaries paced-test-default-registered-map)
diff --git a/paced.el b/paced.el
index 7956bcd..7f9fd62 100644
--- a/paced.el
+++ b/paced.el
@@ -170,12 +170,13 @@ entry should be of the form (VAR VALUE).")
 This is used with the `object-write' method.")
    (case-handling :initarg :case-handling
                   :initform downcase
-                  :type (member downcase upcase preserve downcase-first 
upcase-first)
+                  :type (member downcase upcase preserve downcase-first 
upcase-first mixed-case)
                   :custom (choice (const :tag "Downcase All Words" downcase)
                                   (const :tag "Upcase All Words" upcase)
                                   (const :tag "Preserve Case" preserve)
                                   (const :tag "Downcase Just the First Letter" 
downcase-first)
-                                  (const :tag "Upcase Just the First Letter" 
upcase-first))
+                                  (const :tag "Upcase Just the First Letter" 
upcase-first)
+                                  (const :tag "Preserve Case on Mixed-Case 
Words" mixed-case))
                   :label "Case Sensitive"
                   :documentation "A symbol indicating how case should be 
handled during population.
 
@@ -185,7 +186,12 @@ It can be one of the following:
 * upcase          Upcase every word
 * preserve        Preserve case
 * downcase-first  Downcase the first letter of each word, leave the rest the 
same
-* upcase-first    Upcase the first letter of each word, leave the rest the 
same")
+* upcase-first    Upcase the first letter of each word, leave the rest the same
+* mixed-case      Preserve case on mixed-case words; single-case words
+                  are downcased.  See `paced-mixed-case-word-p' for an
+                  explanation of how \"mixed-case\" is defined.
+
+This doesn't affect completion; set `paced-completion-ignore-case' for that.")
    (updated :initarg :updated
             :initform nil
             :type boolean
@@ -474,6 +480,23 @@ Things is based on `paced-thing-at-point-constituent'."
   (interactive "p")
   (forward-thing paced-thing-at-point-constituent number))
 
+(defun paced-mixed-case-word-p (word)
+  "Return non-nil if WORD is mixed-case.
+
+A mixed-case word is one with both uppercase and lowercase
+letters, but ignoring the first letter if it's uppercase.  This
+is due to assuming the first letter is unimportant, as per
+sentence starting."
+  ;; Mixed case would typically be an uppercase letter followed by a lowercase
+  ;; letter, or a lowercase letter followed by an uppercase letter.  Since 
we're
+  ;; ignoring the first letter of a word if it's uppercase, we need to check 
for
+  ;; two distinct uppercase letters, followed by a lowercase letter.
+  (let ((case-fold-search nil)) ;; Case is important
+    (string-match-p (rx (or (and lower upper) ;; lower followed by upper
+                            ;; Two distinct uppercase letters, as in HAs
+                            (and upper upper lower)))
+                    word)))
+
 (defun paced--handle-word-case (case-handling word)
   "Process WORD based on CASE-HANDLING.
 
@@ -490,7 +513,9 @@ This is a separate function only for testing; use
     ;; Upcase the first letter
     (`upcase-first
      (concat (upcase (substring word 0 1))
-             (substring word 1)))))
+             (substring word 1)))
+    (`mixed-case
+     (if (paced-mixed-case-word-p word) word (downcase word)))))
 
 (cl-defmethod paced-dictionary-process-word ((dict paced-dictionary) word)
   "Return WORD, modified based on DICT's case handling."
@@ -668,7 +693,17 @@ case-handling in `paced-dictionary-process-word'."
             (when (stringp completion)
               (concat (substring prefix 0 prefix-length)
                       (substring-no-properties completion prefix-length))))
-          completions))))))
+          completions)))
+      (`mixed-case
+       ;; Only change prefix on single-case completion options
+       (let ((prefix-length (length prefix)))
+         (mapcar
+          (lambda (completion)
+            (when (stringp completion)
+              (if (paced-mixed-case-word-p completion)
+                  completion
+                (concat (substring prefix 0 prefix-length)
+                        (substring-no-properties completion 
prefix-length)))))))))))
 
 (cl-defmethod paced-dictionary-completions ((dict paced-dictionary) prefix 
action &optional pred)
   (let* ((completion-ignore-case paced-completion-ignore-case)