=== modified file 'lisp/progmodes/etags.el' --- trunk/lisp/progmodes/etags.el 2010-05-01 01:08:43 +0000 +++ patched/lisp/progmodes/etags.el 2010-05-24 18:27:14 +0000 @@ -45,9 +45,25 @@ :group 'tools) ;;;###autoload +(defcustom etags-case-fold-major-modes nil + "Major modes where etags should use case fold search. +See `tags-case-fold-search' for more info." + :group 'etags) + +(defun etags-use-case-fold-search (major) + "Return t for case fold search, otherwise nil." + (cond ((memq tags-case-fold-search '(nil t)) + tags-case-fold-search) + ((eq 'default tags-case-fold-search) + (when (memq major etags-case-fold-major-modes) t)) + (t case-fold-search))) + +;;;###autoload (defcustom tags-case-fold-search 'default "*Whether tags operations should be case-sensitive. A value of t means case-insensitive, a value of nil means case-sensitive. +A value of 'default means use case-sensitive search unless the buffers +major modes is in `etags-case-fold-major-modes'. Any other value means use the setting of `case-fold-search'." :group 'etags :type '(choice (const :tag "Case-sensitive" nil) @@ -798,9 +814,7 @@ "Using tags, return a completion table for the text around point. If no tags table is loaded, do nothing and return nil." (when (or tags-table-list tags-file-name) - (let ((completion-ignore-case (if (memq tags-case-fold-search '(t nil)) - tags-case-fold-search - case-fold-search)) + (let ((completion-ignore-case (etags-use-case-fold-search major-mode)) (pattern (funcall (or find-tag-default-function (get major-mode 'find-tag-default-function) 'find-tag-default))) @@ -814,9 +828,7 @@ (defun find-tag-tag (string) "Read a tag name, with defaulting and completion." - (let* ((completion-ignore-case (if (memq tags-case-fold-search '(t nil)) - tags-case-fold-search - case-fold-search)) + (let* ((completion-ignore-case (etags-use-case-fold-search major-mode)) (default (funcall (or find-tag-default-function (get major-mode 'find-tag-default-function) 'find-tag-default))) @@ -1079,23 +1091,21 @@ Arg MATCHING is a string, an English `-ing' word, to be used in an error message." -;; Algorithm is as follows: -;; For each qualifier-func in ORDER, go to beginning of tags file, and -;; perform inner loop: for each naive match for PATTERN found using -;; SEARCH-FORWARD-FUNC, qualify the naive match using qualifier-func. If -;; it qualifies, go to the specified line in the specified source file -;; and return. Qualified matches are remembered to avoid repetition. -;; State is saved so that the loop can be continued. + ;; Algorithm is as follows: + ;; For each qualifier-func in ORDER, go to beginning of tags file, and + ;; perform inner loop: for each naive match for PATTERN found using + ;; SEARCH-FORWARD-FUNC, qualify the naive match using qualifier-func. If + ;; it qualifies, go to the specified line in the specified source file + ;; and return. Qualified matches are remembered to avoid repetition. + ;; State is saved so that the loop can be continued. (let (file ;name of file containing tag tag-info ;where to find the tag in FILE (first-table t) (tag-order order) (match-marker (make-marker)) goto-func - (case-fold-search (if (memq tags-case-fold-search '(nil t)) - tags-case-fold-search - case-fold-search)) - ) + (case-fold (etags-use-case-fold-search major-mode)) + (start-point-at-bol (point-at-bol))) (save-excursion (if first-search @@ -1114,6 +1124,8 @@ ;; Get a qualified match. (catch 'qualified-match-found + ;; If case fold search try no-fold if failure + (dolist (case-fold-search (if case-fold '(t nil) '(nil))) ;; Iterate over the list of tags tables. (while (or first-table (visit-tags-table-buffer t)) @@ -1129,6 +1141,15 @@ (while (funcall search-forward-func pattern nil t) ;; Naive match found. Qualify the match. (and (funcall (car order) pattern) + ;; On the line where we started? + (or (not (= (point-at-bol) start-point-at-bol)) + ;; Accept it if it really is what we asked for. + (let ((here (point)) + (case-fold-search nil)) + (goto-char start-point-at-bol) + (prog1 + (funcall search-forward-func pattern (point-at-eol) t) + (goto-char here)))) ;; Make sure it is not a previous qualified match. (not (member (set-marker match-marker (save-excursion (beginning-of-line) @@ -1140,7 +1161,9 @@ ;; Try the next flavor of match. (setq order (cdr order)) (goto-char (point-min))) - (setq order tag-order)) + (setq order tag-order))) + + ;; We throw out on match, so only get here if there were no matches. ;; Clear out the markers we use to avoid duplicate matches so they ;; don't slow down editting and are immediately available for GC. @@ -1781,9 +1804,7 @@ "Evaluate FORM and return its result. Bind `case-fold-search' during the evaluation, depending on the value of `tags-case-fold-search'." - (let ((case-fold-search (if (memq tags-case-fold-search '(t nil)) - tags-case-fold-search - case-fold-search))) + (let ((case-fold (etags-use-case-fold-search major-mode))) (eval form)))