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
@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
'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
---
(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
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
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)
(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)))
"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
;; 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))
;; 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
'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
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)))
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)))
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")))
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
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))
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.
(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 "-"))))
(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
(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))
(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))))
;; 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))
;; 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.
;; 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)))))
: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.
;; 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))))
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
(`(,_)
(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)
(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)
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))))
(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))
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)))
(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)
(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))))))))
(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)
(setq matches (cons (substring string start l) matches)) ; leftover
(apply #'concat (nreverse matches)))))
\f
+(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
;; 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]+")
;; 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]+[\"}]\\)")))
;; 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
(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))
(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
(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)
(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)
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)
(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
(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)))
(>= 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
(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)))))))
;; [ 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.
;; 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>"
(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
;; (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))
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"))
projects / emacs.git / commitdiff