[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master 70341cab3e: string-equal-ignore-case: new function
|
From: |
Sam Steingold |
|
Subject: |
master 70341cab3e: string-equal-ignore-case: new function |
|
Date: |
Tue, 26 Jul 2022 13:50:06 -0400 (EDT) |
branch: master
commit 70341cab3eb26e2f49bbc13d6bca247ab9403abc
Author: Sam Steingold <sds@gnu.org>
Commit: Sam Steingold <sds@gnu.org>
string-equal-ignore-case: new function
* lisp/cedet/semantic/complete.el
(semantic-collector-calculate-completions):
Use `string-prefix-p' instead of explicit `compare-strings'.
* lisp/emacs-lisp/byte-opt.el (side-effect-free-fns):
Add `string-equal-ignore-case'.
* lisp/emacs-lisp/cl-extra.el (cl-equalp): Use `string-equal-ignore-case'.
* lisp/emacs-lisp/shadow.el (load-path-shadows-find): Likewise.
* lisp/emacs-lisp/shortdoc.el (string): Add `string-equal-ignore-case'.
* lisp/files.el (file-truename): Use `string-equal-ignore-case'.
(file-relative-name): Likewise.
* lisp/gnus/gnus-art.el (article-hide-boring-headers):
Use `string-equal-ignore-case' instead of `gnus-string-equal'.
* lisp/gnus/gnus-util.el (gnus-string-equal):
Remove, use `string-equal-ignore-case' instead.
* lisp/international/mule-cmds.el (describe-language-environment):
Use `string-equal-ignore-case'.
(locale-charset-match-p): Likewise.
* lisp/man.el (Man-softhyphen-to-minus): Use `string-prefix-p'.
* lisp/minibuffer.el (completion--string-equal-p):
Remove, use `string-equal-ignore-case' instead.
(completion--twq-all): Use `string-equal-ignore-case'.
(completion--do-completion): Likewise.
* lisp/net/browse-url.el (browse-url-default-windows-browser):
Use `string-prefix-p' instead of explicit `compare-strings'.
* lisp/org/ob-core.el (org-babel-results-keyword):
Use `string-equal-ignore-case' instead of explicit `compare-strings'.
(org-babel-insert-result): Likewise.
* lisp/org/org-compat.el (string-equal-ignore-case):
Define unless defined already.
(org-mode-flyspell-verify): Use `string-equal-ignore-case'.
* lisp/org/org-lint.el (org-lint-duplicate-custom-id): Likewise.
* lisp/org/ox.el (org-export-resolve-radio-link): Use
`string-equal-ignore-case' and `string-clean-whitespace'.
* lisp/progmodes/flymake-proc.el
(flymake-proc--check-patch-master-file-buffer):
Use `string-prefix-p' instead of explicit `compare-strings'.
* lisp/progmodes/idlwave.el (idlwave-class-or-superclass-with-tag):
Use `string-equal-ignore-case' instead of explicit `compare-strings'.
* lisp/subr.el (member-ignore-case): Use `string-equal-ignore-case'.
(string-equal-ignore-case): Compare strings ignoring case.
* lisp/textmodes/bibtex.el (bibtex-string=): Remove.
(bibtex-format-entry, bibtex-font-lock-url, bibtex-autofill-entry)
(bibtex-print-help-message, bibtex-validate, bibtex-validate-globally)
(bibtex-clean-entry, bibtex-completion-at-point-function, (bibtex-url):
Use `string-equal-ignore-case' instead of `bibtex-string='.
* lisp/textmodes/sgml-mode.el (sgml-get-context):
Use `string-equal-ignore-case' instead of explicit `compare-strings'.
(sgml-calculate-indent): Likewise
* test/lisp/subr-tests.el (string-comparison-test):
Add tests for `string-equal-ignore-case'.
---
doc/lispref/hash.texi | 10 ++++------
doc/lispref/strings.texi | 5 +++++
etc/NEWS | 3 +++
lisp/cedet/semantic/complete.el | 10 ++--------
lisp/emacs-lisp/byte-opt.el | 2 +-
lisp/emacs-lisp/cl-extra.el | 3 +--
lisp/emacs-lisp/shadow.el | 7 ++-----
lisp/emacs-lisp/shortdoc.el | 2 ++
lisp/files.el | 28 ++++++++++++----------------
lisp/gnus/gnus-art.el | 12 ++++++------
lisp/gnus/gnus-util.el | 9 ---------
lisp/international/mule-cmds.el | 5 ++---
lisp/man.el | 3 +--
lisp/minibuffer.el | 15 +++++----------
lisp/net/browse-url.el | 3 +--
lisp/org/ob-core.el | 9 ++++-----
lisp/org/org-compat.el | 14 ++++++++++----
lisp/org/org-lint.el | 6 ++----
lisp/org/ox.el | 12 +++++-------
lisp/progmodes/flymake-proc.el | 5 +----
lisp/progmodes/idlwave.el | 2 +-
lisp/subr.el | 8 +++++++-
lisp/textmodes/bibtex.el | 32 ++++++++++++++------------------
lisp/textmodes/sgml-mode.el | 13 +++++--------
lisp/vc/vc-dispatcher.el | 3 +--
test/lisp/subr-tests.el | 7 +++++++
26 files changed, 104 insertions(+), 124 deletions(-)
diff --git a/doc/lispref/hash.texi b/doc/lispref/hash.texi
index d3ae673d44..25a56bd715 100644
--- a/doc/lispref/hash.texi
+++ b/doc/lispref/hash.texi
@@ -324,15 +324,13 @@ the same integer.
compared case-insensitively.
@example
-(defun case-fold-string= (a b)
- (eq t (compare-strings a nil nil b nil nil t)))
-(defun case-fold-string-hash (a)
+(defun string-hash-ignore-case (a)
(sxhash-equal (upcase a)))
-(define-hash-table-test 'case-fold
- 'case-fold-string= 'case-fold-string-hash)
+(define-hash-table-test 'ignore-case
+ 'string-equal-ignore-case 'string-hash-ignore-case)
-(make-hash-table :test 'case-fold)
+(make-hash-table :test 'ignore-case)
@end example
Here is how you could define a hash table test equivalent to the
diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi
index cb9019daa9..bf61bb7c47 100644
--- a/doc/lispref/strings.texi
+++ b/doc/lispref/strings.texi
@@ -560,6 +560,11 @@ Representations}.
@code{string-equal} is another name for @code{string=}.
@end defun
+@defun string-equal-ignore-case string1 string2
+@code{string-equal-ignore-case} compares strings ignoring case
+differences, like @code{char-equal} when @code{case-fold-search} is
+@code{t}.
+
@cindex locale-dependent string equivalence
@defun string-collate-equalp string1 string2 &optional locale ignore-case
This function returns @code{t} if @var{string1} and @var{string2} are
diff --git a/etc/NEWS b/etc/NEWS
index a31c50a850..7c1462ee57 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -2502,6 +2502,9 @@ abbrevs. This has been generalized via the
'save-some-buffers-functions' variable, and packages can now register
things to be saved.
+** New function 'string-equal-ignore-case'.
+This compares strings ignoring case differences.
+
** Themes
---
diff --git a/lisp/cedet/semantic/complete.el b/lisp/cedet/semantic/complete.el
index cd04cf8643..436ad08c5f 100644
--- a/lisp/cedet/semantic/complete.el
+++ b/lisp/cedet/semantic/complete.el
@@ -1011,20 +1011,14 @@ Output must be in semanticdb Find result format."
(oref obj last-prefix)))
(completionlist
(cond ((or same-prefix-p
- (and last-prefix (eq (compare-strings
- last-prefix 0 nil
- prefix 0 (length last-prefix))
- t)))
+ (and last-prefix (string-prefix-p last-prefix prefix t)))
;; We have the same prefix, or last-prefix is a
;; substring of the of new prefix, in which case we are
;; refining our symbol so just re-use cache.
(oref obj last-all-completions))
((and last-prefix
(> (length prefix) 1)
- (eq (compare-strings
- prefix 0 nil
- last-prefix 0 (length prefix))
- t))
+ (string-prefix-p prefix last-prefix t))
;; The new prefix is a substring of the old
;; prefix, and it's longer than one character.
;; Perform a full search to pull in additional
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index 5705b2a8fd..3f4af44051 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -1451,7 +1451,7 @@ See Info node `(elisp) Integer Basics'."
radians-to-degrees rassq rassoc read-from-string regexp-opt
regexp-quote region-beginning region-end reverse round
sin sqrt string string< string= string-equal string-lessp
- string> string-greaterp string-empty-p
+ string> string-greaterp string-empty-p string-equal-ignore-case
string-prefix-p string-suffix-p string-blank-p
string-search string-to-char
string-to-number string-to-syntax substring
diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el
index 8e38df43c8..607810ee14 100644
--- a/lisp/emacs-lisp/cl-extra.el
+++ b/lisp/emacs-lisp/cl-extra.el
@@ -71,8 +71,7 @@ numbers of different types (float vs. integer), and also
compares
strings case-insensitively."
(cond ((eq x y) t)
((stringp x)
- (and (stringp y) (= (length x) (length y))
- (eq (compare-strings x nil nil y nil nil t) t)))
+ (and (stringp y) (string-equal-ignore-case x y)))
((numberp x)
(and (numberp y) (= x y)))
((consp x)
diff --git a/lisp/emacs-lisp/shadow.el b/lisp/emacs-lisp/shadow.el
index 2343a9b589..da32e4564f 100644
--- a/lisp/emacs-lisp/shadow.el
+++ b/lisp/emacs-lisp/shadow.el
@@ -128,11 +128,8 @@ See the documentation for `list-load-path-shadows' for
further information."
(if (setq orig-dir
(assoc file files
- (when dir-case-insensitive
- (lambda (f1 f2)
- (eq (compare-strings f1 nil nil
- f2 nil nil t)
- t)))))
+ (and dir-case-insensitive
+ #'string-equal-ignore-case)))
;; This file was seen before, we have a shadowing.
;; Report it unless the files are identical.
(let ((base1 (concat (cdr orig-dir) "/" (car orig-dir)))
diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el
index 05b3361cb3..315afd4312 100644
--- a/lisp/emacs-lisp/shortdoc.el
+++ b/lisp/emacs-lisp/shortdoc.el
@@ -243,6 +243,8 @@ A FUNC form can have any number of `:no-eval' (or
`:no-value'),
"Predicates for Strings"
(string-equal
:eval (string-equal "foo" "foo"))
+ (string-equal-ignore-case
+ :eval (string-equal-ignore-case "foo" "FOO"))
(eq
:eval (eq "foo" "foo"))
(eql
diff --git a/lisp/files.el b/lisp/files.el
index bc74dfa738..37ed796a68 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -1428,7 +1428,7 @@ containing it, until no links are left at any level.
;; If these are equal, we have the (or a) root directory.
(or (string= dir dirfile)
(and (file-name-case-insensitive-p dir)
- (eq (compare-strings dir 0 nil dirfile 0 nil t) t))
+ (string-equal-ignore-case dir dirfile))
;; If this is the same dir we last got the truename for,
;; save time--don't recalculate.
(if (assoc dir (car prev-dirs))
@@ -5459,21 +5459,17 @@ on a DOS/Windows machine, it returns FILENAME in
expanded form."
;; Test for different drive letters
(not (eq t (compare-strings filename 0 2 directory 0 2 fold-case)))
;; Test for UNCs on different servers
- (not (eq t (compare-strings
- (progn
- (if (string-match "\\`//\\([^:/]+\\)/" filename)
- (match-string 1 filename)
- ;; Windows file names cannot have ? in
- ;; them, so use that to detect when
- ;; neither FILENAME nor DIRECTORY is a
- ;; UNC.
- "?"))
- 0 nil
- (progn
- (if (string-match "\\`//\\([^:/]+\\)/" directory)
- (match-string 1 directory)
- "?"))
- 0 nil t)))))
+ (not (string-equal-ignore-case
+ (if (string-match "\\`//\\([^:/]+\\)/" filename)
+ (match-string 1 filename)
+ ;; Windows file names cannot have ? in
+ ;; them, so use that to detect when
+ ;; neither FILENAME nor DIRECTORY is a
+ ;; UNC.
+ "?")
+ (if (string-match "\\`//\\([^:/]+\\)/" directory)
+ (match-string 1 directory)
+ "?")))))
;; Test for different remote file system identification
(not (equal fremote dremote)))
filename
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index 4b68a54ce8..e28d84e06f 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -1939,8 +1939,8 @@ always hide."
'boring-headers)))
;; Hide boring Newsgroups header.
((eq elem 'newsgroups)
- (when (gnus-string-equal
- (gnus-fetch-field "newsgroups")
+ (when (string-equal-ignore-case
+ (or (gnus-fetch-field "newsgroups") "")
(gnus-group-real-name
(if (boundp 'gnus-newsgroup-name)
gnus-newsgroup-name
@@ -1954,7 +1954,7 @@ always hide."
gnus-newsgroup-name ""))))
(when (and to to-address
(ignore-errors
- (gnus-string-equal
+ (string-equal-ignore-case
;; only one address in To
(nth 1 (mail-extract-address-components to))
to-address)))
@@ -1967,7 +1967,7 @@ always hide."
gnus-newsgroup-name ""))))
(when (and to to-list
(ignore-errors
- (gnus-string-equal
+ (string-equal-ignore-case
;; only one address in To
(nth 1 (mail-extract-address-components to))
to-list)))
@@ -1980,13 +1980,13 @@ always hide."
gnus-newsgroup-name ""))))
(when (and cc to-list
(ignore-errors
- (gnus-string-equal
+ (string-equal-ignore-case
;; only one address in Cc
(nth 1 (mail-extract-address-components cc))
to-list)))
(gnus-article-hide-header "cc"))))
((eq elem 'followup-to)
- (when (gnus-string-equal
+ (when (string-equal-ignore-case
(message-fetch-field "followup-to")
(message-fetch-field "newsgroups"))
(gnus-article-hide-header "followup-to")))
diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el
index 218a4d242b..31a275c7d0 100644
--- a/lisp/gnus/gnus-util.el
+++ b/lisp/gnus/gnus-util.el
@@ -1073,15 +1073,6 @@ ARG is passed to the first function."
s)
(error string)))
-;; This might use `compare-strings' to reduce consing in the
-;; case-insensitive case, but it has to cope with null args.
-;; (`string-equal' uses symbol print names.)
-(defun gnus-string-equal (x y)
- "Like `string-equal', except it compares case-insensitively."
- (and (= (length x) (length y))
- (or (string-equal x y)
- (string-equal (downcase x) (downcase y)))))
-
(defcustom gnus-use-byte-compile t
"If non-nil, byte-compile crucial run-time code."
:type 'boolean
diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el
index df1c06ec27..12896cc4b0 100644
--- a/lisp/international/mule-cmds.el
+++ b/lisp/international/mule-cmds.el
@@ -2199,8 +2199,7 @@ See `set-language-info-alist' for use in programs."
first nil))
(dolist (elt l)
(when (or (eq input-method elt)
- (eq t (compare-strings language-name nil nil
- (nth 1 elt) nil nil t)))
+ (string-equal-ignore-case language-name (nth 1 elt)))
(when first
(insert "Input methods:\n")
(setq first nil))
@@ -2599,7 +2598,7 @@ Matching is done ignoring case and any hyphens and
underscores in the
names. E.g. `ISO_8859-1' and `iso88591' both match `iso-8859-1'."
(setq charset1 (replace-regexp-in-string "[-_]" "" charset1))
(setq charset2 (replace-regexp-in-string "[-_]" "" charset2))
- (eq t (compare-strings charset1 nil nil charset2 nil nil t)))
+ (string-equal-ignore-case charset1 charset2))
(defvar locale-charset-alist nil
"Coding system alist keyed on locale-style charset name.
diff --git a/lisp/man.el b/lisp/man.el
index 951e0ef9ad..d66f63972a 100644
--- a/lisp/man.el
+++ b/lisp/man.el
@@ -1241,8 +1241,7 @@ See the variable `Man-notify-method' for the different
notification behaviors."
(defun Man-softhyphen-to-minus ()
;; \255 is SOFT HYPHEN in Latin-N. Versions of Debian man, at
;; least, emit it even when not in a Latin-N locale.
- (unless (eq t (compare-strings "latin-" 0 nil
- current-language-environment 0 6 t))
+ (unless (string-prefix-p "latin-" current-language-environment t)
(goto-char (point-min))
(while (search-forward "" nil t) (replace-match "-"))))
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index bdf6d852a9..3daab8a1e8 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -634,9 +634,6 @@ for use at QPOS."
(let ((qstr (funcall qfun completion)))
(cons qstr (length qstr))))))
-(defun completion--string-equal-p (s1 s2)
- (eq t (compare-strings s1 nil nil s2 nil nil 'ignore-case)))
-
(defun completion--twq-all (string ustring completions boundary
_unquote requote)
(when completions
@@ -650,7 +647,7 @@ for use at QPOS."
(qfullprefix (substring string 0 qfullpos))
;; FIXME: This assertion can be wrong, e.g. in Cygwin, where
;; (unquote "c:\bin") => "/usr/bin" but (unquote "c:\") => "/".
- ;;(cl-assert (completion--string-equal-p
+ ;;(cl-assert (string-equal-ignore-case
;; (funcall unquote qfullprefix)
;; (concat (substring ustring 0 boundary) prefix))
;; t))
@@ -688,7 +685,7 @@ for use at QPOS."
(let* ((rest (substring completion
0 (length prefix)))
(qrest (funcall qfun rest)))
- (if (completion--string-equal-p qprefix qrest)
+ (if (string-equal-ignore-case qprefix qrest)
(propertize qrest 'face
'completions-common-part)
qprefix))))
@@ -696,7 +693,7 @@ for use at QPOS."
;; FIXME: Similarly here, Cygwin's mapping trips this
;; assertion.
;;(cl-assert
- ;; (completion--string-equal-p
+ ;; (string-equal-ignore-case
;; (funcall unquote
;; (concat (substring string 0 qboundary)
;; qcompletion))
@@ -1309,10 +1306,8 @@ when the buffer's text is already an exact match."
;; for appearance, the string is rewritten if the case changes.
(let* ((comp-pos (cdr comp))
(completion (car comp))
- (completed (not (eq t (compare-strings completion nil nil
- string nil nil t))))
- (unchanged (eq t (compare-strings completion nil nil
- string nil nil nil))))
+ (completed (not (string-equal-ignore-case completion string)))
+ (unchanged (string-equal completion string)))
(if unchanged
(goto-char end)
;; Insert in minibuffer the chars we got.
diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el
index a55aec76bf..6713208d26 100644
--- a/lisp/net/browse-url.el
+++ b/lisp/net/browse-url.el
@@ -981,8 +981,7 @@ The optional NEW-WINDOW argument is not used."
;; quotes in the MAILTO URLs, so we prefer
;; to leave the URL with its embedded %nn
;; encoding intact.
- (if (eq t (compare-strings url nil 7
- "file://" nil nil))
+ (if (string-prefix-p "file://" url)
(url-unhex-string url)
url)))))
diff --git a/lisp/org/ob-core.el b/lisp/org/ob-core.el
index 04af84d2e4..3d159ed38a 100644
--- a/lisp/org/ob-core.el
+++ b/lisp/org/ob-core.el
@@ -136,8 +136,7 @@ used."
:type 'string
:safe (lambda (v)
(and (stringp v)
- (eq (compare-strings "RESULTS" nil nil v nil nil t)
- t))))
+ (string-equal-ignore-case "RESULTS" v))))
(defcustom org-babel-noweb-wrap-start "<<"
"String used to begin a noweb reference in a code block.
@@ -2435,7 +2434,7 @@ INFO may provide the values of these header arguments (in
the
;; Escape contents from "export" wrap. Wrap
;; inline results within an export snippet with
;; appropriate value.
- ((eq t (compare-strings type nil nil "export" nil nil t))
+ ((string-equal-ignore-case type "export")
(let ((backend (pcase split
(`(,_) "none")
(`(,_ ,b . ,_) b))))
@@ -2446,14 +2445,14 @@ INFO may provide the values of these header arguments
(in the
backend) "@@)}}}")))
;; Escape contents from "example" wrap. Mark
;; inline results as verbatim.
- ((eq t (compare-strings type nil nil "example" nil nil
t))
+ ((string-equal-ignore-case type "example")
(funcall wrap
opening-line closing-line
nil nil
"{{{results(=" "=)}}}"))
;; Escape contents from "src" wrap. Mark
;; inline results as inline source code.
- ((eq t (compare-strings type nil nil "src" nil nil t))
+ ((string-equal-ignore-case type "src")
(let ((inline-open
(pcase split
(`(,_)
diff --git a/lisp/org/org-compat.el b/lisp/org/org-compat.el
index a65bf6f677..085e32d677 100644
--- a/lisp/org/org-compat.el
+++ b/lisp/org/org-compat.el
@@ -934,6 +934,14 @@ Implements `define-error' for older emacsen."
(put name 'error-conditions
(copy-sequence (cons name (get 'error 'error-conditions))))))
+(unless (fboundp 'string-equal-ignore-case)
+ ;; From Emacs subr.el.
+ (defun string-equal-ignore-case (string1 string2)
+ "Like `string-equal', but case-insensitive.
+Upper-case and lower-case letters are treated as equal.
+Unibyte strings are converted to multibyte for comparison."
+ (eq t (compare-strings string1 0 nil string2 0 nil t))))
+
(unless (fboundp 'string-suffix-p)
;; From Emacs subr.el.
(defun string-suffix-p (suffix string &optional ignore-case)
@@ -1125,10 +1133,8 @@ ELEMENT is the element at point."
(and log
(let ((drawer (org-element-lineage element '(drawer))))
(and drawer
- (eq (compare-strings
- log nil nil
- (org-element-property :drawer-name drawer) nil nil t)
- t)))))
+ (string-equal-ignore-case
+ log (org-element-property :drawer-name drawer))))))
nil)
(t
(cl-case (org-element-type element)
diff --git a/lisp/org/org-lint.el b/lisp/org/org-lint.el
index 83c2d08a90..6d8cf3f237 100644
--- a/lisp/org/org-lint.el
+++ b/lisp/org/org-lint.el
@@ -334,10 +334,8 @@ called with one argument, the key used for comparison."
ast
'node-property
(lambda (property)
- (and (eq (compare-strings "CUSTOM_ID" nil nil
- (org-element-property :key property) nil nil
- t)
- t)
+ (and (string-equal-ignore-case
+ "CUSTOM_ID" (org-element-property :key property))
(org-element-property :value property)))
(lambda (property _) (org-element-property :begin property))
(lambda (key) (format "Duplicate CUSTOM_ID property \"%s\"" key))))
diff --git a/lisp/org/ox.el b/lisp/org/ox.el
index 55258bc79d..1bdf4dead8 100644
--- a/lisp/org/ox.el
+++ b/lisp/org/ox.el
@@ -80,6 +80,7 @@
(require 'org-element)
(require 'org-macro)
(require 'tabulated-list)
+(require 'subr-x)
(declare-function org-src-coderef-format "org-src" (&optional element))
(declare-function org-src-coderef-regexp "org-src" (fmt &optional label))
@@ -4436,15 +4437,12 @@ INFO is a plist used as a communication channel.
Return value can be a radio-target object or nil. Assume LINK
has type \"radio\"."
- (let ((path (replace-regexp-in-string
- "[ \r\t\n]+" " " (org-element-property :path link))))
+ (let ((path (string-clean-whitespace (org-element-property :path link))))
(org-element-map (plist-get info :parse-tree) 'radio-target
(lambda (radio)
- (and (eq (compare-strings
- (replace-regexp-in-string
- "[ \r\t\n]+" " " (org-element-property :value radio))
- nil nil path nil nil t)
- t)
+ (and (string-equal-ignore-case
+ (string-clean-whitespace (org-element-property :value radio))
+ path)
radio))
info 'first-match)))
diff --git a/lisp/progmodes/flymake-proc.el b/lisp/progmodes/flymake-proc.el
index 4ab16831bc..249ae9dff2 100644
--- a/lisp/progmodes/flymake-proc.el
+++ b/lisp/progmodes/flymake-proc.el
@@ -399,10 +399,7 @@ instead of reading master file from disk."
(not (string-match (format "\\.%s\\'" source-file-extension)
inc-name))
(setq inc-name (concat inc-name "." source-file-extension)))
- (when (eq t (compare-strings
- source-file-nondir nil nil
- inc-name (- (length inc-name)
- (length source-file-nondir)) nil))
+ (when (string-suffix-p source-file-nondir inc-name)
(flymake-log 3 "inc-name=%s" inc-name)
(when (flymake-proc--check-include source-file-name inc-name
include-dirs)
diff --git a/lisp/progmodes/idlwave.el b/lisp/progmodes/idlwave.el
index a2061fde76..b3dc3cac76 100644
--- a/lisp/progmodes/idlwave.el
+++ b/lisp/progmodes/idlwave.el
@@ -7528,7 +7528,7 @@ associated TAG, if any."
(setq cl (pop sclasses))
(let ((tags (idlwave-class-tags cl)))
(while tags
- (if (eq t (compare-strings tag 0 nil (car tags) 0 nil t))
+ (if (string-equal-ignore-case tag (car tags))
(throw 'exit cl))
(setq tags (cdr tags))))))))
diff --git a/lisp/subr.el b/lisp/subr.el
index a0ad967533..c82b33bba5 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -868,7 +868,7 @@ Non-strings in LIST are ignored."
(declare (side-effect-free t))
(while (and list
(not (and (stringp (car list))
- (eq t (compare-strings elt 0 nil (car list) 0 nil t)))))
+ (string-equal-ignore-case elt (car list)))))
(setq list (cdr list)))
list)
@@ -5302,6 +5302,12 @@ and replace a sub-expression, e.g.
(setq matches (cons (substring string start l) matches)) ; leftover
(apply #'concat (nreverse matches)))))
+(defun string-equal-ignore-case (string1 string2)
+ "Like `string-equal', but case-insensitive.
+Upper-case and lower-case letters are treated as equal.
+Unibyte strings are converted to multibyte for comparison."
+ (eq t (compare-strings string1 0 nil string2 0 nil t)))
+
(defun string-prefix-p (prefix string &optional ignore-case)
"Return non-nil if PREFIX is a prefix of STRING.
If IGNORE-CASE is non-nil, the comparison is done without paying attention
diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el
index 333cfa5169..64cb0dc0fe 100644
--- a/lisp/textmodes/bibtex.el
+++ b/lisp/textmodes/bibtex.el
@@ -2213,10 +2213,6 @@ Point must be at beginning of preamble. Do not move
point."
;; Helper Functions
-(defsubst bibtex-string= (str1 str2)
- "Return t if STR1 and STR2 are equal, ignoring case."
- (eq t (compare-strings str1 0 nil str2 0 nil t)))
-
(defun bibtex-delete-whitespace ()
"Delete all whitespace starting at point."
(if (looking-at "[ \t\n]+")
@@ -2657,7 +2653,7 @@ Formats current entry according to variable
`bibtex-entry-format'."
;; update page dashes
(if (and (memq 'page-dashes format)
- (bibtex-string= field-name "pages")
+ (string-equal-ignore-case field-name "pages")
(progn (goto-char beg-text)
(looking-at
"\\([\"{][0-9]+\\)[ \t\n]*--?[
\t\n]*\\([0-9]+[\"}]\\)")))
@@ -2710,7 +2706,7 @@ Formats current entry according to variable
`bibtex-entry-format'."
;; use book title of crossref'd entry
(if (and (memq 'inherit-booktitle format)
empty-field
- (bibtex-string= field-name "booktitle")
+ (string-equal-ignore-case field-name "booktitle")
crossref-key)
(let ((title (save-excursion
(save-restriction
@@ -3503,7 +3499,7 @@ If NO-BUTTON is non-nil do not generate buttons."
(let ((lst bibtex-generate-url-list) url)
(while (and (not found) (setq url (car (pop lst))))
(goto-char start)
- (setq found (and (bibtex-string= name (car url))
+ (setq found (and (string-equal-ignore-case name (car url))
(re-search-forward (cdr url) end t))))))
(unless found (goto-char end)))
(if (and found (not no-button))
@@ -3954,7 +3950,7 @@ entry (for example, the year parts of the keys)."
(goto-char (1- (match-beginning 0)))
(bibtex-beginning-of-entry)
(if (and (looking-at bibtex-entry-head)
- (bibtex-string= type (bibtex-type-in-head))
+ (string-equal-ignore-case type (bibtex-type-in-head))
;; In case we found ourselves :-(
(not (equal key (setq tmp (bibtex-key-in-head)))))
(setq other-key tmp
@@ -3963,7 +3959,7 @@ entry (for example, the year parts of the keys)."
(bibtex-end-of-entry)
(bibtex-skip-to-valid-entry)
(if (and (looking-at bibtex-entry-head)
- (bibtex-string= type (bibtex-type-in-head))
+ (string-equal-ignore-case type (bibtex-type-in-head))
;; In case we found ourselves :-(
(not (equal key (setq tmp (bibtex-key-in-head))))
(or (not other-key)
@@ -4004,9 +4000,9 @@ interactive calls."
(interactive (list nil t))
(unless field (setq field (car (bibtex-find-text-internal nil nil comma))))
(if (string-search "@" field)
- (cond ((bibtex-string= field "@string")
+ (cond ((string-equal-ignore-case field "@string")
(message "String definition"))
- ((bibtex-string= field "@preamble")
+ ((string-equal-ignore-case field "@preamble")
(message "Preamble definition"))
(t (message "Entry key")))
(let* ((case-fold-search t)
@@ -4588,7 +4584,7 @@ Return t if test was successful, nil otherwise."
bounds field idx)
(while (setq bounds (bibtex-parse-field))
(let ((field-name (bibtex-name-in-field bounds)))
- (if (and (bibtex-string= field-name "month")
+ (if (and (string-equal-ignore-case field-name "month")
;; Check only abbreviated month fields.
(let ((month (bibtex-text-in-field-bounds
bounds)))
(not (or (string-match "\\`[\"{].+[\"}]\\'"
month)
@@ -4669,7 +4665,7 @@ Return t if test was successful, nil otherwise."
(while (re-search-forward bibtex-entry-head nil t)
(setq entry-type (bibtex-type-in-head)
key (bibtex-key-in-head))
- (if (or (and strings (bibtex-string= entry-type "string"))
+ (if (or (and strings (string-equal-ignore-case entry-type
"string"))
(assoc-string entry-type bibtex-entry-alist t))
(if (member key key-list)
(push (format-message
@@ -5046,10 +5042,10 @@ At end of the cleaning process, the functions in
(user-error "Not inside a BibTeX entry")))
(entry-type (bibtex-type-in-head))
(key (bibtex-key-in-head)))
- (cond ((bibtex-string= entry-type "preamble")
+ (cond ((string-equal-ignore-case entry-type "preamble")
;; (bibtex-format-preamble)
(user-error "No clean up of @Preamble entries"))
- ((bibtex-string= entry-type "string")
+ ((string-equal-ignore-case entry-type "string")
(setq entry-type 'string))
;; (bibtex-format-string)
(t (bibtex-format-entry)))
@@ -5326,10 +5322,10 @@ entries from minibuffer."
(>= pnt (bibtex-start-of-text-in-field bounds))
(<= pnt (bibtex-end-of-text-in-field bounds)))
(setq name (bibtex-name-in-field bounds t)
- compl (cond ((bibtex-string= name "crossref")
+ compl (cond ((string-equal-ignore-case name "crossref")
;; point is in crossref field
'crossref-key)
- ((bibtex-string= name "month")
+ ((string-equal-ignore-case name "month")
;; point is in month field
bibtex-predefined-month-strings)
;; point is in other field
@@ -5488,7 +5484,7 @@ Return the URL or nil if none can be generated."
(while (and (not url) (setq scheme (pop lst)))
;; Verify the match of `bibtex-font-lock-url' by
;; comparing with TEXT.
- (when (and (bibtex-string= (caar scheme) name)
+ (when (and (string-equal-ignore-case (caar scheme) name)
(string-match (cdar scheme) text))
(setq url t scheme (cdr scheme)))))))
diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el
index 8f9b603ef5..ba0a94b4a1 100644
--- a/lisp/textmodes/sgml-mode.el
+++ b/lisp/textmodes/sgml-mode.el
@@ -1536,8 +1536,7 @@ not the case, the first tag returned is the one inside
which we are."
;; [ Well, actually it depends, but we don't have the info about
;; when it doesn't and when it does. --Stef ]
(setq ignore nil)))
- ((eq t (compare-strings (sgml-tag-name tag-info) nil nil
- (car stack) nil nil t))
+ ((string-equal-ignore-case (sgml-tag-name tag-info) (car stack))
(setq stack (cdr stack)))
(t
;; The open and close tags don't match.
@@ -1549,9 +1548,8 @@ not the case, the first tag returned is the one inside
which we are."
;; but it's a bad assumption when tags *are* closed but
;; not properly nested.
(while (and (cdr tmp)
- (not (eq t (compare-strings
- (sgml-tag-name tag-info) nil nil
- (cadr tmp) nil nil t))))
+ (not (string-equal-ignore-case
+ (sgml-tag-name tag-info) (cadr tmp))))
(setq tmp (cdr tmp)))
(if (cdr tmp) (setcdr tmp (cddr tmp)))))
(message "Unmatched tags <%s> and </%s>"
@@ -1701,9 +1699,8 @@ LCON is the lexical context, if any."
(there (point)))
;; Ignore previous unclosed start-tag in context.
(while (and context unclosed
- (eq t (compare-strings
- (sgml-tag-name (car context)) nil nil
- unclosed nil nil t)))
+ (string-equal-ignore-case
+ (sgml-tag-name (car context)) unclosed))
(setq context (cdr context)))
;; Indent to reflect nesting.
(cond
diff --git a/lisp/vc/vc-dispatcher.el b/lisp/vc/vc-dispatcher.el
index f50d45217c..e2a490092b 100644
--- a/lisp/vc/vc-dispatcher.el
+++ b/lisp/vc/vc-dispatcher.el
@@ -761,8 +761,7 @@ the buffer contents as a comment."
;; (while (and (not member) fileset)
;; (let ((elem (pop fileset)))
;; (if (if (file-directory-p elem)
-;; (eq t (compare-strings buffer-file-name nil (length elem)
-;; elem nil nil))
+;; (string-prefix-p elem buffer-file-name)
;; (eq (current-buffer) (get-file-buffer elem)))
;; (setq member t))))
;; member))
diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el
index 84f3e41148..d45f409e85 100644
--- a/test/lisp/subr-tests.el
+++ b/test/lisp/subr-tests.el
@@ -368,6 +368,13 @@
2)))
(ert-deftest string-comparison-test ()
+ (should (string-equal-ignore-case "abc" "abc"))
+ (should (string-equal-ignore-case "abc" "ABC"))
+ (should (string-equal-ignore-case "abc" "abC"))
+ (should-not (string-equal-ignore-case "abc" "abCD"))
+ (should (string-equal-ignore-case "S" "s"))
+ ;; not yet: (should (string-equal-ignore-case "SS" "ß"))
+
(should (string-lessp "abc" "acb"))
(should (string-lessp "aBc" "abc"))
(should (string-lessp "abc" "abcd"))
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- master 70341cab3e: string-equal-ignore-case: new function,
Sam Steingold <=