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'.
This commit is contained in:
Sam Steingold 2022-07-26 13:47:03 -04:00
parent 015cf7824e
commit 70341cab3e
26 changed files with 104 additions and 124 deletions

View file

@ -324,15 +324,13 @@ the same integer.
compared case-insensitively. compared case-insensitively.
@example @example
(defun case-fold-string= (a b) (defun string-hash-ignore-case (a)
(eq t (compare-strings a nil nil b nil nil t)))
(defun case-fold-string-hash (a)
(sxhash-equal (upcase a))) (sxhash-equal (upcase a)))
(define-hash-table-test 'case-fold (define-hash-table-test 'ignore-case
'case-fold-string= 'case-fold-string-hash) 'string-equal-ignore-case 'string-hash-ignore-case)
(make-hash-table :test 'case-fold) (make-hash-table :test 'ignore-case)
@end example @end example
Here is how you could define a hash table test equivalent to the Here is how you could define a hash table test equivalent to the

View file

@ -560,6 +560,11 @@ Representations}.
@code{string-equal} is another name for @code{string=}. @code{string-equal} is another name for @code{string=}.
@end defun @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 @cindex locale-dependent string equivalence
@defun string-collate-equalp string1 string2 &optional locale ignore-case @defun string-collate-equalp string1 string2 &optional locale ignore-case
This function returns @code{t} if @var{string1} and @var{string2} are This function returns @code{t} if @var{string1} and @var{string2} are

View file

@ -2502,6 +2502,9 @@ abbrevs. This has been generalized via the
'save-some-buffers-functions' variable, and packages can now register 'save-some-buffers-functions' variable, and packages can now register
things to be saved. things to be saved.
** New function 'string-equal-ignore-case'.
This compares strings ignoring case differences.
** Themes ** Themes
--- ---

View file

@ -1011,20 +1011,14 @@ Output must be in semanticdb Find result format."
(oref obj last-prefix))) (oref obj last-prefix)))
(completionlist (completionlist
(cond ((or same-prefix-p (cond ((or same-prefix-p
(and last-prefix (eq (compare-strings (and last-prefix (string-prefix-p last-prefix prefix t)))
last-prefix 0 nil
prefix 0 (length last-prefix))
t)))
;; We have the same prefix, or last-prefix is a ;; We have the same prefix, or last-prefix is a
;; substring of the of new prefix, in which case we are ;; substring of the of new prefix, in which case we are
;; refining our symbol so just re-use cache. ;; refining our symbol so just re-use cache.
(oref obj last-all-completions)) (oref obj last-all-completions))
((and last-prefix ((and last-prefix
(> (length prefix) 1) (> (length prefix) 1)
(eq (compare-strings (string-prefix-p prefix last-prefix t))
prefix 0 nil
last-prefix 0 (length prefix))
t))
;; The new prefix is a substring of the old ;; The new prefix is a substring of the old
;; prefix, and it's longer than one character. ;; prefix, and it's longer than one character.
;; Perform a full search to pull in additional ;; Perform a full search to pull in additional

View file

@ -1451,7 +1451,7 @@ See Info node `(elisp) Integer Basics'."
radians-to-degrees rassq rassoc read-from-string regexp-opt radians-to-degrees rassq rassoc read-from-string regexp-opt
regexp-quote region-beginning region-end reverse round regexp-quote region-beginning region-end reverse round
sin sqrt string string< string= string-equal string-lessp 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-prefix-p string-suffix-p string-blank-p
string-search string-to-char string-search string-to-char
string-to-number string-to-syntax substring string-to-number string-to-syntax substring

View file

@ -71,8 +71,7 @@ numbers of different types (float vs. integer), and also compares
strings case-insensitively." strings case-insensitively."
(cond ((eq x y) t) (cond ((eq x y) t)
((stringp x) ((stringp x)
(and (stringp y) (= (length x) (length y)) (and (stringp y) (string-equal-ignore-case x y)))
(eq (compare-strings x nil nil y nil nil t) t)))
((numberp x) ((numberp x)
(and (numberp y) (= x y))) (and (numberp y) (= x y)))
((consp x) ((consp x)

View file

@ -128,11 +128,8 @@ See the documentation for `list-load-path-shadows' for further information."
(if (setq orig-dir (if (setq orig-dir
(assoc file files (assoc file files
(when dir-case-insensitive (and dir-case-insensitive
(lambda (f1 f2) #'string-equal-ignore-case)))
(eq (compare-strings f1 nil nil
f2 nil nil t)
t)))))
;; This file was seen before, we have a shadowing. ;; This file was seen before, we have a shadowing.
;; Report it unless the files are identical. ;; Report it unless the files are identical.
(let ((base1 (concat (cdr orig-dir) "/" (car orig-dir))) (let ((base1 (concat (cdr orig-dir) "/" (car orig-dir)))

View file

@ -243,6 +243,8 @@ A FUNC form can have any number of `:no-eval' (or `:no-value'),
"Predicates for Strings" "Predicates for Strings"
(string-equal (string-equal
:eval (string-equal "foo" "foo")) :eval (string-equal "foo" "foo"))
(string-equal-ignore-case
:eval (string-equal-ignore-case "foo" "FOO"))
(eq (eq
:eval (eq "foo" "foo")) :eval (eq "foo" "foo"))
(eql (eql

View file

@ -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. ;; If these are equal, we have the (or a) root directory.
(or (string= dir dirfile) (or (string= dir dirfile)
(and (file-name-case-insensitive-p dir) (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, ;; If this is the same dir we last got the truename for,
;; save time--don't recalculate. ;; save time--don't recalculate.
(if (assoc dir (car prev-dirs)) (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 ;; Test for different drive letters
(not (eq t (compare-strings filename 0 2 directory 0 2 fold-case))) (not (eq t (compare-strings filename 0 2 directory 0 2 fold-case)))
;; Test for UNCs on different servers ;; Test for UNCs on different servers
(not (eq t (compare-strings (not (string-equal-ignore-case
(progn (if (string-match "\\`//\\([^:/]+\\)/" filename)
(if (string-match "\\`//\\([^:/]+\\)/" filename) (match-string 1 filename)
(match-string 1 filename) ;; Windows file names cannot have ? in
;; Windows file names cannot have ? in ;; them, so use that to detect when
;; them, so use that to detect when ;; neither FILENAME nor DIRECTORY is a
;; neither FILENAME nor DIRECTORY is a ;; UNC.
;; UNC. "?")
"?")) (if (string-match "\\`//\\([^:/]+\\)/" directory)
0 nil (match-string 1 directory)
(progn "?")))))
(if (string-match "\\`//\\([^:/]+\\)/" directory)
(match-string 1 directory)
"?"))
0 nil t)))))
;; Test for different remote file system identification ;; Test for different remote file system identification
(not (equal fremote dremote))) (not (equal fremote dremote)))
filename filename

View file

@ -1939,8 +1939,8 @@ always hide."
'boring-headers))) 'boring-headers)))
;; Hide boring Newsgroups header. ;; Hide boring Newsgroups header.
((eq elem 'newsgroups) ((eq elem 'newsgroups)
(when (gnus-string-equal (when (string-equal-ignore-case
(gnus-fetch-field "newsgroups") (or (gnus-fetch-field "newsgroups") "")
(gnus-group-real-name (gnus-group-real-name
(if (boundp 'gnus-newsgroup-name) (if (boundp 'gnus-newsgroup-name)
gnus-newsgroup-name gnus-newsgroup-name
@ -1954,7 +1954,7 @@ always hide."
gnus-newsgroup-name "")))) gnus-newsgroup-name ""))))
(when (and to to-address (when (and to to-address
(ignore-errors (ignore-errors
(gnus-string-equal (string-equal-ignore-case
;; only one address in To ;; only one address in To
(nth 1 (mail-extract-address-components to)) (nth 1 (mail-extract-address-components to))
to-address))) to-address)))
@ -1967,7 +1967,7 @@ always hide."
gnus-newsgroup-name "")))) gnus-newsgroup-name ""))))
(when (and to to-list (when (and to to-list
(ignore-errors (ignore-errors
(gnus-string-equal (string-equal-ignore-case
;; only one address in To ;; only one address in To
(nth 1 (mail-extract-address-components to)) (nth 1 (mail-extract-address-components to))
to-list))) to-list)))
@ -1980,13 +1980,13 @@ always hide."
gnus-newsgroup-name "")))) gnus-newsgroup-name ""))))
(when (and cc to-list (when (and cc to-list
(ignore-errors (ignore-errors
(gnus-string-equal (string-equal-ignore-case
;; only one address in Cc ;; only one address in Cc
(nth 1 (mail-extract-address-components cc)) (nth 1 (mail-extract-address-components cc))
to-list))) to-list)))
(gnus-article-hide-header "cc")))) (gnus-article-hide-header "cc"))))
((eq elem 'followup-to) ((eq elem 'followup-to)
(when (gnus-string-equal (when (string-equal-ignore-case
(message-fetch-field "followup-to") (message-fetch-field "followup-to")
(message-fetch-field "newsgroups")) (message-fetch-field "newsgroups"))
(gnus-article-hide-header "followup-to"))) (gnus-article-hide-header "followup-to")))

View file

@ -1073,15 +1073,6 @@ ARG is passed to the first function."
s) s)
(error string))) (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 (defcustom gnus-use-byte-compile t
"If non-nil, byte-compile crucial run-time code." "If non-nil, byte-compile crucial run-time code."
:type 'boolean :type 'boolean

View file

@ -2199,8 +2199,7 @@ See `set-language-info-alist' for use in programs."
first nil)) first nil))
(dolist (elt l) (dolist (elt l)
(when (or (eq input-method elt) (when (or (eq input-method elt)
(eq t (compare-strings language-name nil nil (string-equal-ignore-case language-name (nth 1 elt)))
(nth 1 elt) nil nil t)))
(when first (when first
(insert "Input methods:\n") (insert "Input methods:\n")
(setq first nil)) (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'." names. E.g. `ISO_8859-1' and `iso88591' both match `iso-8859-1'."
(setq charset1 (replace-regexp-in-string "[-_]" "" charset1)) (setq charset1 (replace-regexp-in-string "[-_]" "" charset1))
(setq charset2 (replace-regexp-in-string "[-_]" "" charset2)) (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 (defvar locale-charset-alist nil
"Coding system alist keyed on locale-style charset name. "Coding system alist keyed on locale-style charset name.

View file

@ -1241,8 +1241,7 @@ See the variable `Man-notify-method' for the different notification behaviors."
(defun Man-softhyphen-to-minus () (defun Man-softhyphen-to-minus ()
;; \255 is SOFT HYPHEN in Latin-N. Versions of Debian man, at ;; \255 is SOFT HYPHEN in Latin-N. Versions of Debian man, at
;; least, emit it even when not in a Latin-N locale. ;; least, emit it even when not in a Latin-N locale.
(unless (eq t (compare-strings "latin-" 0 nil (unless (string-prefix-p "latin-" current-language-environment t)
current-language-environment 0 6 t))
(goto-char (point-min)) (goto-char (point-min))
(while (search-forward "­" nil t) (replace-match "-")))) (while (search-forward "­" nil t) (replace-match "-"))))

View file

@ -634,9 +634,6 @@ for use at QPOS."
(let ((qstr (funcall qfun completion))) (let ((qstr (funcall qfun completion)))
(cons qstr (length qstr)))))) (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 (defun completion--twq-all (string ustring completions boundary
_unquote requote) _unquote requote)
(when completions (when completions
@ -650,7 +647,7 @@ for use at QPOS."
(qfullprefix (substring string 0 qfullpos)) (qfullprefix (substring string 0 qfullpos))
;; FIXME: This assertion can be wrong, e.g. in Cygwin, where ;; FIXME: This assertion can be wrong, e.g. in Cygwin, where
;; (unquote "c:\bin") => "/usr/bin" but (unquote "c:\") => "/". ;; (unquote "c:\bin") => "/usr/bin" but (unquote "c:\") => "/".
;;(cl-assert (completion--string-equal-p ;;(cl-assert (string-equal-ignore-case
;; (funcall unquote qfullprefix) ;; (funcall unquote qfullprefix)
;; (concat (substring ustring 0 boundary) prefix)) ;; (concat (substring ustring 0 boundary) prefix))
;; t)) ;; t))
@ -688,7 +685,7 @@ for use at QPOS."
(let* ((rest (substring completion (let* ((rest (substring completion
0 (length prefix))) 0 (length prefix)))
(qrest (funcall qfun rest))) (qrest (funcall qfun rest)))
(if (completion--string-equal-p qprefix qrest) (if (string-equal-ignore-case qprefix qrest)
(propertize qrest 'face (propertize qrest 'face
'completions-common-part) 'completions-common-part)
qprefix)))) qprefix))))
@ -696,7 +693,7 @@ for use at QPOS."
;; FIXME: Similarly here, Cygwin's mapping trips this ;; FIXME: Similarly here, Cygwin's mapping trips this
;; assertion. ;; assertion.
;;(cl-assert ;;(cl-assert
;; (completion--string-equal-p ;; (string-equal-ignore-case
;; (funcall unquote ;; (funcall unquote
;; (concat (substring string 0 qboundary) ;; (concat (substring string 0 qboundary)
;; qcompletion)) ;; 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. ;; for appearance, the string is rewritten if the case changes.
(let* ((comp-pos (cdr comp)) (let* ((comp-pos (cdr comp))
(completion (car comp)) (completion (car comp))
(completed (not (eq t (compare-strings completion nil nil (completed (not (string-equal-ignore-case completion string)))
string nil nil t)))) (unchanged (string-equal completion string)))
(unchanged (eq t (compare-strings completion nil nil
string nil nil nil))))
(if unchanged (if unchanged
(goto-char end) (goto-char end)
;; Insert in minibuffer the chars we got. ;; Insert in minibuffer the chars we got.

View file

@ -981,8 +981,7 @@ The optional NEW-WINDOW argument is not used."
;; quotes in the MAILTO URLs, so we prefer ;; quotes in the MAILTO URLs, so we prefer
;; to leave the URL with its embedded %nn ;; to leave the URL with its embedded %nn
;; encoding intact. ;; encoding intact.
(if (eq t (compare-strings url nil 7 (if (string-prefix-p "file://" url)
"file://" nil nil))
(url-unhex-string url) (url-unhex-string url)
url))))) url)))))

View file

@ -136,8 +136,7 @@ used."
:type 'string :type 'string
:safe (lambda (v) :safe (lambda (v)
(and (stringp v) (and (stringp v)
(eq (compare-strings "RESULTS" nil nil v nil nil t) (string-equal-ignore-case "RESULTS" v))))
t))))
(defcustom org-babel-noweb-wrap-start "<<" (defcustom org-babel-noweb-wrap-start "<<"
"String used to begin a noweb reference in a code block. "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 ;; Escape contents from "export" wrap. Wrap
;; inline results within an export snippet with ;; inline results within an export snippet with
;; appropriate value. ;; appropriate value.
((eq t (compare-strings type nil nil "export" nil nil t)) ((string-equal-ignore-case type "export")
(let ((backend (pcase split (let ((backend (pcase split
(`(,_) "none") (`(,_) "none")
(`(,_ ,b . ,_) b)))) (`(,_ ,b . ,_) b))))
@ -2446,14 +2445,14 @@ INFO may provide the values of these header arguments (in the
backend) "@@)}}}"))) backend) "@@)}}}")))
;; Escape contents from "example" wrap. Mark ;; Escape contents from "example" wrap. Mark
;; inline results as verbatim. ;; inline results as verbatim.
((eq t (compare-strings type nil nil "example" nil nil t)) ((string-equal-ignore-case type "example")
(funcall wrap (funcall wrap
opening-line closing-line opening-line closing-line
nil nil nil nil
"{{{results(=" "=)}}}")) "{{{results(=" "=)}}}"))
;; Escape contents from "src" wrap. Mark ;; Escape contents from "src" wrap. Mark
;; inline results as inline source code. ;; 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 (let ((inline-open
(pcase split (pcase split
(`(,_) (`(,_)

View file

@ -934,6 +934,14 @@ Implements `define-error' for older emacsen."
(put name 'error-conditions (put name 'error-conditions
(copy-sequence (cons name (get 'error '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) (unless (fboundp 'string-suffix-p)
;; From Emacs subr.el. ;; From Emacs subr.el.
(defun string-suffix-p (suffix string &optional ignore-case) (defun string-suffix-p (suffix string &optional ignore-case)
@ -1125,10 +1133,8 @@ ELEMENT is the element at point."
(and log (and log
(let ((drawer (org-element-lineage element '(drawer)))) (let ((drawer (org-element-lineage element '(drawer))))
(and drawer (and drawer
(eq (compare-strings (string-equal-ignore-case
log nil nil log (org-element-property :drawer-name drawer))))))
(org-element-property :drawer-name drawer) nil nil t)
t)))))
nil) nil)
(t (t
(cl-case (org-element-type element) (cl-case (org-element-type element)

View file

@ -334,10 +334,8 @@ called with one argument, the key used for comparison."
ast ast
'node-property 'node-property
(lambda (property) (lambda (property)
(and (eq (compare-strings "CUSTOM_ID" nil nil (and (string-equal-ignore-case
(org-element-property :key property) nil nil "CUSTOM_ID" (org-element-property :key property))
t)
t)
(org-element-property :value property))) (org-element-property :value property)))
(lambda (property _) (org-element-property :begin property)) (lambda (property _) (org-element-property :begin property))
(lambda (key) (format "Duplicate CUSTOM_ID property \"%s\"" key)))) (lambda (key) (format "Duplicate CUSTOM_ID property \"%s\"" key))))

View file

@ -80,6 +80,7 @@
(require 'org-element) (require 'org-element)
(require 'org-macro) (require 'org-macro)
(require 'tabulated-list) (require 'tabulated-list)
(require 'subr-x)
(declare-function org-src-coderef-format "org-src" (&optional element)) (declare-function org-src-coderef-format "org-src" (&optional element))
(declare-function org-src-coderef-regexp "org-src" (fmt &optional label)) (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 Return value can be a radio-target object or nil. Assume LINK
has type \"radio\"." has type \"radio\"."
(let ((path (replace-regexp-in-string (let ((path (string-clean-whitespace (org-element-property :path link))))
"[ \r\t\n]+" " " (org-element-property :path link))))
(org-element-map (plist-get info :parse-tree) 'radio-target (org-element-map (plist-get info :parse-tree) 'radio-target
(lambda (radio) (lambda (radio)
(and (eq (compare-strings (and (string-equal-ignore-case
(replace-regexp-in-string (string-clean-whitespace (org-element-property :value radio))
"[ \r\t\n]+" " " (org-element-property :value radio)) path)
nil nil path nil nil t)
t)
radio)) radio))
info 'first-match))) info 'first-match)))

View file

@ -399,10 +399,7 @@ instead of reading master file from disk."
(not (string-match (format "\\.%s\\'" source-file-extension) (not (string-match (format "\\.%s\\'" source-file-extension)
inc-name)) inc-name))
(setq inc-name (concat inc-name "." source-file-extension))) (setq inc-name (concat inc-name "." source-file-extension)))
(when (eq t (compare-strings (when (string-suffix-p source-file-nondir inc-name)
source-file-nondir nil nil
inc-name (- (length inc-name)
(length source-file-nondir)) nil))
(flymake-log 3 "inc-name=%s" inc-name) (flymake-log 3 "inc-name=%s" inc-name)
(when (flymake-proc--check-include source-file-name inc-name (when (flymake-proc--check-include source-file-name inc-name
include-dirs) include-dirs)

View file

@ -7528,7 +7528,7 @@ associated TAG, if any."
(setq cl (pop sclasses)) (setq cl (pop sclasses))
(let ((tags (idlwave-class-tags cl))) (let ((tags (idlwave-class-tags cl)))
(while tags (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)) (throw 'exit cl))
(setq tags (cdr tags)))))))) (setq tags (cdr tags))))))))

View file

@ -868,7 +868,7 @@ Non-strings in LIST are ignored."
(declare (side-effect-free t)) (declare (side-effect-free t))
(while (and list (while (and list
(not (and (stringp (car 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))) (setq list (cdr list)))
list) list)
@ -5302,6 +5302,12 @@ and replace a sub-expression, e.g.
(setq matches (cons (substring string start l) matches)) ; leftover (setq matches (cons (substring string start l) matches)) ; leftover
(apply #'concat (nreverse matches))))) (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) (defun string-prefix-p (prefix string &optional ignore-case)
"Return non-nil if PREFIX is a prefix of STRING. "Return non-nil if PREFIX is a prefix of STRING.
If IGNORE-CASE is non-nil, the comparison is done without paying attention If IGNORE-CASE is non-nil, the comparison is done without paying attention

View file

@ -2213,10 +2213,6 @@ Point must be at beginning of preamble. Do not move point."
;; Helper Functions ;; 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 () (defun bibtex-delete-whitespace ()
"Delete all whitespace starting at point." "Delete all whitespace starting at point."
(if (looking-at "[ \t\n]+") (if (looking-at "[ \t\n]+")
@ -2657,7 +2653,7 @@ Formats current entry according to variable `bibtex-entry-format'."
;; update page dashes ;; update page dashes
(if (and (memq 'page-dashes format) (if (and (memq 'page-dashes format)
(bibtex-string= field-name "pages") (string-equal-ignore-case field-name "pages")
(progn (goto-char beg-text) (progn (goto-char beg-text)
(looking-at (looking-at
"\\([\"{][0-9]+\\)[ \t\n]*--?[ \t\n]*\\([0-9]+[\"}]\\)"))) "\\([\"{][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 ;; use book title of crossref'd entry
(if (and (memq 'inherit-booktitle format) (if (and (memq 'inherit-booktitle format)
empty-field empty-field
(bibtex-string= field-name "booktitle") (string-equal-ignore-case field-name "booktitle")
crossref-key) crossref-key)
(let ((title (save-excursion (let ((title (save-excursion
(save-restriction (save-restriction
@ -3503,7 +3499,7 @@ If NO-BUTTON is non-nil do not generate buttons."
(let ((lst bibtex-generate-url-list) url) (let ((lst bibtex-generate-url-list) url)
(while (and (not found) (setq url (car (pop lst)))) (while (and (not found) (setq url (car (pop lst))))
(goto-char start) (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)))))) (re-search-forward (cdr url) end t))))))
(unless found (goto-char end))) (unless found (goto-char end)))
(if (and found (not no-button)) (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))) (goto-char (1- (match-beginning 0)))
(bibtex-beginning-of-entry) (bibtex-beginning-of-entry)
(if (and (looking-at bibtex-entry-head) (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 :-( ;; In case we found ourselves :-(
(not (equal key (setq tmp (bibtex-key-in-head))))) (not (equal key (setq tmp (bibtex-key-in-head)))))
(setq other-key tmp (setq other-key tmp
@ -3963,7 +3959,7 @@ entry (for example, the year parts of the keys)."
(bibtex-end-of-entry) (bibtex-end-of-entry)
(bibtex-skip-to-valid-entry) (bibtex-skip-to-valid-entry)
(if (and (looking-at bibtex-entry-head) (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 :-( ;; In case we found ourselves :-(
(not (equal key (setq tmp (bibtex-key-in-head)))) (not (equal key (setq tmp (bibtex-key-in-head))))
(or (not other-key) (or (not other-key)
@ -4004,9 +4000,9 @@ interactive calls."
(interactive (list nil t)) (interactive (list nil t))
(unless field (setq field (car (bibtex-find-text-internal nil nil comma)))) (unless field (setq field (car (bibtex-find-text-internal nil nil comma))))
(if (string-search "@" field) (if (string-search "@" field)
(cond ((bibtex-string= field "@string") (cond ((string-equal-ignore-case field "@string")
(message "String definition")) (message "String definition"))
((bibtex-string= field "@preamble") ((string-equal-ignore-case field "@preamble")
(message "Preamble definition")) (message "Preamble definition"))
(t (message "Entry key"))) (t (message "Entry key")))
(let* ((case-fold-search t) (let* ((case-fold-search t)
@ -4588,7 +4584,7 @@ Return t if test was successful, nil otherwise."
bounds field idx) bounds field idx)
(while (setq bounds (bibtex-parse-field)) (while (setq bounds (bibtex-parse-field))
(let ((field-name (bibtex-name-in-field bounds))) (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. ;; Check only abbreviated month fields.
(let ((month (bibtex-text-in-field-bounds bounds))) (let ((month (bibtex-text-in-field-bounds bounds)))
(not (or (string-match "\\`[\"{].+[\"}]\\'" month) (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) (while (re-search-forward bibtex-entry-head nil t)
(setq entry-type (bibtex-type-in-head) (setq entry-type (bibtex-type-in-head)
key (bibtex-key-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)) (assoc-string entry-type bibtex-entry-alist t))
(if (member key key-list) (if (member key key-list)
(push (format-message (push (format-message
@ -5046,10 +5042,10 @@ At end of the cleaning process, the functions in
(user-error "Not inside a BibTeX entry"))) (user-error "Not inside a BibTeX entry")))
(entry-type (bibtex-type-in-head)) (entry-type (bibtex-type-in-head))
(key (bibtex-key-in-head))) (key (bibtex-key-in-head)))
(cond ((bibtex-string= entry-type "preamble") (cond ((string-equal-ignore-case entry-type "preamble")
;; (bibtex-format-preamble) ;; (bibtex-format-preamble)
(user-error "No clean up of @Preamble entries")) (user-error "No clean up of @Preamble entries"))
((bibtex-string= entry-type "string") ((string-equal-ignore-case entry-type "string")
(setq entry-type 'string)) (setq entry-type 'string))
;; (bibtex-format-string) ;; (bibtex-format-string)
(t (bibtex-format-entry))) (t (bibtex-format-entry)))
@ -5326,10 +5322,10 @@ entries from minibuffer."
(>= pnt (bibtex-start-of-text-in-field bounds)) (>= pnt (bibtex-start-of-text-in-field bounds))
(<= pnt (bibtex-end-of-text-in-field bounds))) (<= pnt (bibtex-end-of-text-in-field bounds)))
(setq name (bibtex-name-in-field bounds t) (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 ;; point is in crossref field
'crossref-key) 'crossref-key)
((bibtex-string= name "month") ((string-equal-ignore-case name "month")
;; point is in month field ;; point is in month field
bibtex-predefined-month-strings) bibtex-predefined-month-strings)
;; point is in other field ;; 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))) (while (and (not url) (setq scheme (pop lst)))
;; Verify the match of `bibtex-font-lock-url' by ;; Verify the match of `bibtex-font-lock-url' by
;; comparing with TEXT. ;; comparing with TEXT.
(when (and (bibtex-string= (caar scheme) name) (when (and (string-equal-ignore-case (caar scheme) name)
(string-match (cdar scheme) text)) (string-match (cdar scheme) text))
(setq url t scheme (cdr scheme))))))) (setq url t scheme (cdr scheme)))))))

View file

@ -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 ;; [ Well, actually it depends, but we don't have the info about
;; when it doesn't and when it does. --Stef ] ;; when it doesn't and when it does. --Stef ]
(setq ignore nil))) (setq ignore nil)))
((eq t (compare-strings (sgml-tag-name tag-info) nil nil ((string-equal-ignore-case (sgml-tag-name tag-info) (car stack))
(car stack) nil nil t))
(setq stack (cdr stack))) (setq stack (cdr stack)))
(t (t
;; The open and close tags don't match. ;; 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 ;; but it's a bad assumption when tags *are* closed but
;; not properly nested. ;; not properly nested.
(while (and (cdr tmp) (while (and (cdr tmp)
(not (eq t (compare-strings (not (string-equal-ignore-case
(sgml-tag-name tag-info) nil nil (sgml-tag-name tag-info) (cadr tmp))))
(cadr tmp) nil nil t))))
(setq tmp (cdr tmp))) (setq tmp (cdr tmp)))
(if (cdr tmp) (setcdr tmp (cddr tmp))))) (if (cdr tmp) (setcdr tmp (cddr tmp)))))
(message "Unmatched tags <%s> and </%s>" (message "Unmatched tags <%s> and </%s>"
@ -1701,9 +1699,8 @@ LCON is the lexical context, if any."
(there (point))) (there (point)))
;; Ignore previous unclosed start-tag in context. ;; Ignore previous unclosed start-tag in context.
(while (and context unclosed (while (and context unclosed
(eq t (compare-strings (string-equal-ignore-case
(sgml-tag-name (car context)) nil nil (sgml-tag-name (car context)) unclosed))
unclosed nil nil t)))
(setq context (cdr context))) (setq context (cdr context)))
;; Indent to reflect nesting. ;; Indent to reflect nesting.
(cond (cond

View file

@ -761,8 +761,7 @@ the buffer contents as a comment."
;; (while (and (not member) fileset) ;; (while (and (not member) fileset)
;; (let ((elem (pop fileset))) ;; (let ((elem (pop fileset)))
;; (if (if (file-directory-p elem) ;; (if (if (file-directory-p elem)
;; (eq t (compare-strings buffer-file-name nil (length elem) ;; (string-prefix-p elem buffer-file-name)
;; elem nil nil))
;; (eq (current-buffer) (get-file-buffer elem))) ;; (eq (current-buffer) (get-file-buffer elem)))
;; (setq member t)))) ;; (setq member t))))
;; member)) ;; member))

View file

@ -368,6 +368,13 @@
2))) 2)))
(ert-deftest string-comparison-test () (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" "acb"))
(should (string-lessp "aBc" "abc")) (should (string-lessp "aBc" "abc"))
(should (string-lessp "abc" "abcd")) (should (string-lessp "abc" "abcd"))