mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-25 07:28:20 +00:00
Code Issues Releases Activity

Add new function string-greaterp

Browse Source 
* 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.
This commit is contained in:
Nicolas Petton 2015-06-04 18:20:18 +02:00
parent 285260fce8
commit 41a929c5ae
3 changed files with 45 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
lisp/subr.el
View File

@ -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.

28
src/fns.c
View File

@ -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,

24
test/automated/subr-tests.el
View File

@ -2,7 +2,8 @@
;; Copyright (C) 2015 Free Software Foundation, Inc.
;; Author: Oleh Krehel <ohwoeowho@gmail.com>
;; Author: Oleh Krehel <ohwoeowho@gmail.com>,
;; Nicolas Petton <nicolas@petton.fr>
;; 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