From: Sam Steingold Date: Tue, 26 Jul 2022 17:47:03 +0000 (-0400) Subject: string-equal-ignore-case: new function X-Git-Tag: emacs-29.0.90~1447^2~742 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=70341cab3eb26e2f49bbc13d6bca247ab9403abc;p=emacs.git 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'. --- diff --git a/doc/lispref/hash.texi b/doc/lispref/hash.texi index d3ae673d44d..25a56bd7151 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 cb9019daa9b..bf61bb7c479 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 a31c50a850c..7c1462ee573 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 cd04cf86434..436ad08c5fc 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 5705b2a8fd7..3f4af44051c 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 8e38df43c87..607810ee141 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 2343a9b589f..da32e4564f6 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 05b3361cb3d..315afd4312b 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 bc74dfa7381..37ed796a687 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 4b68a54ce81..e28d84e06fe 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 218a4d242b2..31a275c7d05 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 df1c06ec272..12896cc4b0e 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 951e0ef9add..d66f63972ae 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 bdf6d852a95..3daab8a1e8d 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 a55aec76bfc..6713208d268 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 04af84d2e44..3d159ed38a9 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 a65bf6f677a..085e32d6774 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 83c2d08a907..6d8cf3f2374 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 55258bc79da..1bdf4dead89 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 4ab16831bc1..249ae9dff2f 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 a2061fde762..b3dc3cac763 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 a0ad967533d..c82b33bba53 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 333cfa51695..64cb0dc0fe6 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 8f9b603ef5f..ba0a94b4a1f 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 " @@ -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 f50d45217c7..e2a490092b5 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 84f3e41148d..d45f409e85b 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"))