mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2025-01-13 16:38:14 +00:00
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
parent
015cf7824e
commit
70341cab3e
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
3
etc/NEWS
3
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
|
||||
|
||||
---
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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)))
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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")))
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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.
|
||||
|
||||
@ -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 "-"))))
|
||||
|
||||
|
||||
@ -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.
|
||||
|
||||
@ -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)))))
|
||||
|
||||
|
||||
@ -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
|
||||
(`(,_)
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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))))
|
||||
|
||||
@ -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)))
|
||||
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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))))))))
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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)))))))
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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))
|
||||
|
||||
@ -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"))
|
||||
|
||||
Loading…
Reference in New Issue
Block a user