[Emacs-diffs] master 41a929c 1/2: Add new function string-greaterp

[Nicolas Petton]

branch: master
commit 41a929c5ae1110e39f94c018dc2b3e224e884f18
Author: Nicolas Petton <address@hidden>
Commit: Nicolas Petton <address@hidden>

    Add new function string-greaterp
    
    * lisp/subr.el (string-greaterp): New function.  Also aliased to
    `string>'.
    * test/automated/subr-tests.el (string-comparison-test): Add unit
    tests for `string>'and `string<'.
    * src/fns.c (string-lessp): Better docstring.
---
 lisp/subr.el                 |    8 ++++++++
 src/fns.c                    |   28 ++++++++++++++--------------
 test/automated/subr-tests.el |   24 +++++++++++++++++++++++-
 3 files changed, 45 insertions(+), 15 deletions(-)

diff --git a/lisp/subr.el b/lisp/subr.el
index b9a847d..df17310 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -1384,6 +1384,7 @@ is converted into a string by expressing it in decimal."
 (defalias 'send-region 'process-send-region)
 (defalias 'string= 'string-equal)
 (defalias 'string< 'string-lessp)
+(defalias 'string> 'string-greaterp)
 (defalias 'move-marker 'set-marker)
 (defalias 'rplaca 'setcar)
 (defalias 'rplacd 'setcdr)
@@ -3834,6 +3835,13 @@ consisting of STR followed by an invisible left-to-right 
mark
   (if (string-match "\\cR" str)
       (concat str (propertize (string ?\x200e) 'invisible t))
     str))
+
+(defun string-greaterp (string1 string2)
+  "Return non-nil if STRING1 is greater than STRING2 in lexicographic order.
+Case is significant.
+Symbols are also allowed; their print names are used instead."
+  (string-lessp string2 string1))
+
 
 ;;;; Specifying things to do later.
 
diff --git a/src/fns.c b/src/fns.c
index 235a4f6..6bbb57f 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -303,26 +303,26 @@ If string STR1 is greater, the value is a positive number 
N;
 }
 
 DEFUN ("string-lessp", Fstring_lessp, Sstring_lessp, 2, 2, 0,
-       doc: /* Return t if first arg string is less than second in 
lexicographic order.
+       doc: /* Return non-nil if STRING1 is less than STRING2 in lexicographic 
order.
 Case is significant.
 Symbols are also allowed; their print names are used instead.  */)
-  (register Lisp_Object s1, Lisp_Object s2)
+  (register Lisp_Object string1, Lisp_Object string2)
 {
   register ptrdiff_t end;
   register ptrdiff_t i1, i1_byte, i2, i2_byte;
 
-  if (SYMBOLP (s1))
-    s1 = SYMBOL_NAME (s1);
-  if (SYMBOLP (s2))
-    s2 = SYMBOL_NAME (s2);
-  CHECK_STRING (s1);
-  CHECK_STRING (s2);
+  if (SYMBOLP (string1))
+    string1 = SYMBOL_NAME (string1);
+  if (SYMBOLP (string2))
+    string2 = SYMBOL_NAME (string2);
+  CHECK_STRING (string1);
+  CHECK_STRING (string2);
 
   i1 = i1_byte = i2 = i2_byte = 0;
 
-  end = SCHARS (s1);
-  if (end > SCHARS (s2))
-    end = SCHARS (s2);
+  end = SCHARS (string1);
+  if (end > SCHARS (string2))
+    end = SCHARS (string2);
 
   while (i1 < end)
     {
@@ -330,13 +330,13 @@ Symbols are also allowed; their print names are used 
instead.  */)
         characters, not just the bytes.  */
       int c1, c2;
 
-      FETCH_STRING_CHAR_ADVANCE (c1, s1, i1, i1_byte);
-      FETCH_STRING_CHAR_ADVANCE (c2, s2, i2, i2_byte);
+      FETCH_STRING_CHAR_ADVANCE (c1, string1, i1, i1_byte);
+      FETCH_STRING_CHAR_ADVANCE (c2, string2, i2, i2_byte);
 
       if (c1 != c2)
        return c1 < c2 ? Qt : Qnil;
     }
-  return i1 < SCHARS (s2) ? Qt : Qnil;
+  return i1 < SCHARS (string2) ? Qt : Qnil;
 }
 
 DEFUN ("string-collate-lessp", Fstring_collate_lessp, Sstring_collate_lessp, 
2, 4, 0,
diff --git a/test/automated/subr-tests.el b/test/automated/subr-tests.el
index d29efc6..28a423f 100644
--- a/test/automated/subr-tests.el
+++ b/test/automated/subr-tests.el
@@ -2,7 +2,8 @@
 
 ;; Copyright (C) 2015 Free Software Foundation, Inc.
 
-;; Author: Oleh Krehel <address@hidden>
+;; Author: Oleh Krehel <address@hidden>,
+;;         Nicolas Petton <address@hidden>
 ;; Keywords:
 
 ;; This file is part of GNU Emacs.
@@ -60,5 +61,26 @@
                      (quote
                       (0 font-lock-keyword-face))))))))
 
+(ert-deftest string-comparison-test ()
+  (should (string-lessp "abc" "acb"))
+  (should (string-lessp "aBc" "abc"))
+  (should (string-lessp "abc" "abcd"))
+  (should (string-lessp "abc" "abcd"))
+  (should-not (string-lessp "abc" "abc"))
+  (should-not (string-lessp "" ""))
+
+  (should (string-greaterp "acb" "abc"))
+  (should (string-greaterp "abc" "aBc"))
+  (should (string-greaterp "abcd" "abc"))
+  (should (string-greaterp "abcd" "abc"))
+  (should-not (string-greaterp "abc" "abc"))
+  (should-not (string-greaterp "" ""))
+
+  ;; Symbols are also accepted
+  (should (string-lessp 'abc 'acb))
+  (should (string-lessp "abc" 'acb))
+  (should (string-greaterp 'acb 'abc))
+  (should (string-greaterp "acb" 'abc)))
+
 (provide 'subr-tests)
 ;;; subr-tests.el ends here