commit 3e67708d7239cde24b0988d4d1288bc75585cfea (HEAD, refs/remotes/origin/master) Author: Lars Ingebrigtsen Date: Sun Feb 21 16:57:04 2016 +1100 Add a function to delete URL cookies * doc/misc/url.texi (Cookies): Document url-cookie-delete-cookies. * lisp/url/url-cookie.el (url-cookie-delete-cookies): New function. diff --git a/doc/misc/url.texi b/doc/misc/url.texi index c468599..14a4c96 100644 --- a/doc/misc/url.texi +++ b/doc/misc/url.texi @@ -417,6 +417,12 @@ cookies, if there are any. You can remove a cookie using the @kbd{C-k} (@code{url-cookie-delete}) command. @end defun +@defun url-cookie-delete-cookies &optional regexp +This function takes a regular expression as its parameters and deletes +all cookies from that domain. If @var{regexp} is @code{nil}, delete +all cookies. +@end defun + @defopt url-cookie-file The file in which cookies are stored, defaulting to @file{cookies} in the directory specified by @code{url-configuration-directory}. diff --git a/etc/NEWS b/etc/NEWS index 9f0fb8d..bad9519 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1040,6 +1040,11 @@ we should not be queried about things like TLS certificate validity. plist will contain a :peer element that has the output of `gnutls-peer-status' (if Emacs is built with GnuTLS support). ++++ +*** The new function `url-cookie-delete-cookie' can be used to +programmatically delete all cookies, or cookies from a specific +domain. + ** Tramp +++ diff --git a/lisp/url/url-cookie.el b/lisp/url/url-cookie.el index 4c7366a..a4b7a58 100644 --- a/lisp/url/url-cookie.el +++ b/lisp/url/url-cookie.el @@ -353,6 +353,19 @@ to run the `url-cookie-setup-save-timer' function manually." url-cookie-save-interval #'url-cookie-write-file)))) +(defun url-cookie-delete-cookies (&optional regexp) + "Delete all cookies from the cookie store where the domain matches REGEXP. +If REGEXP is nil, all cookies are deleted." + (dolist (variable '(url-cookie-secure-storage url-cookie-storage)) + (let ((cookies (symbol-value variable))) + (dolist (elem cookies) + (when (or (null regexp) + (string-match regexp (car elem))) + (setq cookies (delq elem cookies)))) + (set variable cookies))) + (setq url-cookies-changed-since-last-save t) + (url-cookie-write-file)) + ;;; Mode for listing and editing cookies. (defun url-cookie-list () commit 336dac5820083df3a6e9d4b4d06768b88ecb8690 Author: Lars Ingebrigtsen Date: Sun Feb 21 16:28:37 2016 +1100 Avoid integer overflows in string-numeric-lessp * src/fns.c (Fstring_numeric_lessp): If we have an integer overflow, compare lexicographically. diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi index a3efbf2..19301de 100644 --- a/doc/lispref/strings.texi +++ b/doc/lispref/strings.texi @@ -643,7 +643,10 @@ lexicographically ``smaller'' than @samp{2}. If one string has a number in a position in the string, and the other doesn't, then lexicograpic comparison is done at that point, so -@samp{foo.png} is ``smaller'' than @samp{foo2.png}. +@samp{foo.png} is ``smaller'' than @samp{foo2.png}. If any of the +numbers in the strings are larger than can be represented as an +integer number, the entire string is compared using +@code{string-less}. @end defun @defun string-prefix-p string1 string2 &optional ignore-case diff --git a/src/fns.c b/src/fns.c index 927fcda..77ad450 100644 --- a/src/fns.c +++ b/src/fns.c @@ -23,6 +23,7 @@ along with GNU Emacs. If not, see . */ #include #include #include +#include #include "lisp.h" #include "character.h" @@ -336,42 +337,26 @@ Symbols are also allowed; their print names are used instead. */) pointers are increased and left at the next character after the numerical characters. */ static size_t -gather_number_from_string (int c, Lisp_Object string, +gather_number_from_string (Lisp_Object string, ptrdiff_t *isp, ptrdiff_t *isp_byte) { - size_t number = c - '0'; - unsigned char *chp; - int chlen; + size_t number = 0; + char *s = SSDATA (string); + char *end; - do + errno = 0; + number = strtoumax (s + *isp_byte, &end, 10); + if (errno == ERANGE) + /* If we have an integer overflow, then we fall back on lexical + comparison. */ + return -1; + else { - if (STRING_MULTIBYTE (string)) - { - chp = &SDATA (string)[*isp_byte]; - c = STRING_CHAR_AND_LENGTH (chp, chlen); - } - else - { - c = SREF (string, *isp_byte); - chlen = 1; - } - - /* If we're still in a number, add it to the sum and continue. */ - /* FIXME: Integer overflow? */ - if (c >= '0' && c <= '9') - { - number = number * 10; - number += c - '0'; - (*isp)++; - (*isp_byte) += chlen; - } - else - break; + size_t diff = end - (s + *isp_byte); + (*isp) += diff; + (*isp_byte) += diff; + return number; } - /* Stop when we get to the end of the string anyway. */ - while (c != 0); - - return number; } DEFUN ("string-numeric-lessp", Fstring_numeric_lessp, @@ -388,6 +373,8 @@ Symbols are also allowed; their print names are used instead. */) ptrdiff_t end; ptrdiff_t i1, i1_byte, i2, i2_byte; size_t num1, num2; + unsigned char *chp; + int chlen1, chlen2; if (SYMBOLP (string1)) string1 = SYMBOL_NAME (string1); @@ -408,22 +395,53 @@ Symbols are also allowed; their print names are used instead. */) characters, not just the bytes. */ int c1, c2; - FETCH_STRING_CHAR_ADVANCE (c1, string1, i1, i1_byte); - FETCH_STRING_CHAR_ADVANCE (c2, string2, i2, i2_byte); + if (STRING_MULTIBYTE (string1)) + { + chp = &SDATA (string1)[i1_byte]; + c1 = STRING_CHAR_AND_LENGTH (chp, chlen1); + } + else + { + c1 = SREF (string1, i1_byte); + chlen1 = 1; + } + + if (STRING_MULTIBYTE (string2)) + { + chp = &SDATA (string1)[i2_byte]; + c2 = STRING_CHAR_AND_LENGTH (chp, chlen2); + } + else + { + c2 = SREF (string2, i2_byte); + chlen2 = 1; + } if (c1 >= '0' && c1 <= '9' && c2 >= '0' && c2 <= '9') /* Both strings are numbers, so compare them. */ { - num1 = gather_number_from_string (c1, string1, &i1, &i1_byte); - num2 = gather_number_from_string (c2, string2, &i2, &i2_byte); - if (num1 < num2) + num1 = gather_number_from_string (string1, &i1, &i1_byte); + num2 = gather_number_from_string (string2, &i2, &i2_byte); + /* If we have an integer overflow, then resort to sorting + the entire string lexicographically. */ + if (num1 == -1 || num2 == -1) + return Fstring_lessp (string1, string2); + else if (num1 < num2) return Qt; else if (num1 > num2) return Qnil; } - else if (c1 != c2) - return c1 < c2 ? Qt : Qnil; + else + { + if (c1 != c2) + return c1 < c2 ? Qt : Qnil; + + i1++; + i2++; + i1_byte += chlen1; + i2_byte += chlen2; + } } return i1 < SCHARS (string2) ? Qt : Qnil; } commit 71783e90a46ca913ea2c334cdc8cb24cd74055f8 Author: Lars Ingebrigtsen Date: Sun Feb 21 15:32:45 2016 +1100 Add the string-numeric-lessp function * doc/lispref/strings.texi (Text Comparison): Document `string-numerical-lessp'. * src/fns.c (Fstring_numeric_lessp): New function. (gather_number_from_string): Helper function for that function. * test/src/fns-tests.el (fns-tests-string-numeric-lessp): Add tests. diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi index 9d6613c..a3efbf2 100644 --- a/doc/lispref/strings.texi +++ b/doc/lispref/strings.texi @@ -633,6 +633,19 @@ If your system does not support a locale environment, this function behaves like @code{string-lessp}. @end defun +@defun string-numerical-lessp strin1 string2 +This function behaves like @code{string-lessp} for stretches of +consecutive non-numerical characters, but compares sequences of +numerical characters as if they comprised a base-ten number, and then +compares the numbers. So @samp{foo2.png} is ``smaller'' than +@samp{foo12.png} according to this predicate, even if @samp{12} is +lexicographically ``smaller'' than @samp{2}. + +If one string has a number in a position in the string, and the other +doesn't, then lexicograpic comparison is done at that point, so +@samp{foo.png} is ``smaller'' than @samp{foo2.png}. +@end defun + @defun string-prefix-p string1 string2 &optional ignore-case This function returns non-@code{nil} if @var{string1} is a prefix of @var{string2}; i.e., if @var{string2} starts with @var{string1}. If diff --git a/etc/NEWS b/etc/NEWS index 33c1b13..9f0fb8d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1720,6 +1720,12 @@ environment. For the time being this is implemented for modern POSIX systems and for MS-Windows, for other systems they fall back to their counterparts `string-lessp' and `string-equal'. ++++ +** The new function `string-numeric-lessp' compares strings by +interpreting consecutive runs of numerical characters as numbers, and +compares their numerical values. According to this predicate, +"foo2.png" is smaller than "foo12.png". + --- *** The ls-lisp package uses `string-collate-lessp' to sort file names. The effect is that, on systems that use ls-lisp for Dired, the default diff --git a/src/fns.c b/src/fns.c index d180844..927fcda 100644 --- a/src/fns.c +++ b/src/fns.c @@ -331,6 +331,103 @@ Symbols are also allowed; their print names are used instead. */) return i1 < SCHARS (string2) ? Qt : Qnil; } +/* Return the numerical value of a consecutive run of numerical + characters from STRING. The ISP and ISP_BYTE address pointer + pointers are increased and left at the next character after the + numerical characters. */ +static size_t +gather_number_from_string (int c, Lisp_Object string, + ptrdiff_t *isp, ptrdiff_t *isp_byte) +{ + size_t number = c - '0'; + unsigned char *chp; + int chlen; + + do + { + if (STRING_MULTIBYTE (string)) + { + chp = &SDATA (string)[*isp_byte]; + c = STRING_CHAR_AND_LENGTH (chp, chlen); + } + else + { + c = SREF (string, *isp_byte); + chlen = 1; + } + + /* If we're still in a number, add it to the sum and continue. */ + /* FIXME: Integer overflow? */ + if (c >= '0' && c <= '9') + { + number = number * 10; + number += c - '0'; + (*isp)++; + (*isp_byte) += chlen; + } + else + break; + } + /* Stop when we get to the end of the string anyway. */ + while (c != 0); + + return number; +} + +DEFUN ("string-numeric-lessp", Fstring_numeric_lessp, + Sstring_numeric_lessp, 2, 2, 0, + doc: /* Return non-nil if STRING1 is less than STRING2 in 'numeric' order. +Sequences of non-numerical characters are compared lexicographically, +while sequences of numerical characters are converted into numbers, +and then the numbers are compared. This means that \"foo2.png\" is +less than \"foo12.png\" according to this predicate. +Case is significant. +Symbols are also allowed; their print names are used instead. */) + (register Lisp_Object string1, Lisp_Object string2) +{ + ptrdiff_t end; + ptrdiff_t i1, i1_byte, i2, i2_byte; + size_t num1, num2; + + 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 (string1); + if (end > SCHARS (string2)) + end = SCHARS (string2); + + while (i1 < end) + { + /* When we find a mismatch, we must compare the + characters, not just the bytes. */ + int c1, c2; + + FETCH_STRING_CHAR_ADVANCE (c1, string1, i1, i1_byte); + FETCH_STRING_CHAR_ADVANCE (c2, string2, i2, i2_byte); + + if (c1 >= '0' && c1 <= '9' && + c2 >= '0' && c2 <= '9') + /* Both strings are numbers, so compare them. */ + { + num1 = gather_number_from_string (c1, string1, &i1, &i1_byte); + num2 = gather_number_from_string (c2, string2, &i2, &i2_byte); + if (num1 < num2) + return Qt; + else if (num1 > num2) + return Qnil; + } + else if (c1 != c2) + return c1 < c2 ? Qt : Qnil; + } + return i1 < SCHARS (string2) ? Qt : Qnil; +} + DEFUN ("string-collate-lessp", Fstring_collate_lessp, Sstring_collate_lessp, 2, 4, 0, doc: /* Return t if first arg string is less than second in collation order. Symbols are also allowed; their print names are used instead. @@ -5049,6 +5146,7 @@ this variable. */); defsubr (&Sstring_equal); defsubr (&Scompare_strings); defsubr (&Sstring_lessp); + defsubr (&Sstring_numeric_lessp); defsubr (&Sstring_collate_lessp); defsubr (&Sstring_collate_equalp); defsubr (&Sappend); diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el index 762f7bd..0c6edb8 100644 --- a/test/src/fns-tests.el +++ b/test/src/fns-tests.el @@ -191,3 +191,20 @@ (string-collate-lessp a b (if (eq system-type 'windows-nt) "enu_USA" "en_US.UTF-8"))))) '("Adrian" "Ævar" "Agustín" "Eli")))) + +(ert-deftest fns-tests-string-numeric-lessp () + (should (string-numeric-lessp "foo2.png" "foo12.png")) + (should (not (string-numeric-lessp "foo12.png" "foo2.png"))) + (should (string-numeric-lessp "foo12.png" "foo20000.png")) + (should (not (string-numeric-lessp "foo20000.png" "foo12.png"))) + (should (string-numeric-lessp "foo.png" "foo2.png")) + (should (not (string-numeric-lessp "foo2.png" "foo.png"))) + (should (equal (sort '("foo12.png" "foo2.png" "foo1.png") + 'string-numeric-lessp) + '("foo1.png" "foo2.png" "foo12.png"))) + (should (string-numeric-lessp "foo2" "foo1234")) + (should (not (string-numeric-lessp "foo1234" "foo2"))) + (should (string-numeric-lessp "foo.png" "foo2")) + (should (string-numeric-lessp "foo1.25.5.png" "foo1.125.5")) + (should (string-numeric-lessp "2" "1245")) + (should (not (string-numeric-lessp "1245" "2"))))