From xemacs-m  Sun Mar 23 17:05:23 1997
Received: from mecca.spd.louisville.edu (mecca.spd.louisville.edu [136.165.40.148])
	by xemacs.org (8.8.5/8.8.5) with SMTP id RAA09162
	for <xemacs-beta@xemacs.org>; Sun, 23 Mar 1997 17:05:22 -0600 (CST)
Received: (from tjchol01@localhost) by mecca.spd.louisville.edu (950413.SGI.8.6.12/8.6.12) id XAA06287; Sun, 23 Mar 1997 23:05:29 GMT
Date: Sun, 23 Mar 1997 23:05:29 GMT
Message-Id: <199703232305.XAA06287@mecca.spd.louisville.edu>
From: "Tomasz J. Cholewo" <tjchol01@mecca.spd.louisville.edu>
MIME-Version: 1.0
Content-Type: text/plain; charset=us-ascii
Content-Transfer-Encoding: 7bit
To: XEmacs-Beta Mailing List <xemacs-beta@xemacs.org>
Subject: [patch] etags.el: tags-query-replace fails with uppercase strings
X-Mailer: VM 6.21 under 20.1 XEmacs Lucid (beta9)

Hi,

`tags-query-replace' fails when the match string contains upper case
letters, `case-fold-search' and `search-caps-disable-folding' are both t
(default) and a lower case version of the match string is found in one
of tagged files.  The source of problems is an evil interaction with
`perform-replace' which uses `search-caps-disable-folding' while etags.el
does not.

This patch corrects this problem and adds support for caps-disabling to
etags queries.  It is so long mostly because of indentation changes.

Tom

[1] Probably a better place for `with-caps-disable-folding' macro would
be prim/isearch-mode.el so that more packages could use it.
=================
Sun Mar 23 16:58:08 1997  Tomasz J. Cholewo  <t.cholewo@ieee.org>

	* packages/etags.el (with-caps-disable-folding): New macro.
	(find-tag-internal): Use it.
	(tags-search): Use it.
	(tags-query-replace): Use it.  Case bug corrected.

diff -urd xemacs-20.1-b9-orig/lisp/packages/etags.el xemacs-20.1-b9/lisp/packages/etags.el
--- xemacs-20.1-b9-orig/lisp/packages/etags.el	Wed Dec 18 17:42:50 1996
+++ xemacs-20.1-b9-x/lisp/packages/etags.el	Sun Mar 23 16:54:10 1997
@@ -815,6 +815,19 @@
 
 (autoload 'get-symbol-syntax-table "symbol-syntax")
 
+(require 'backquote)
+
+(defmacro with-caps-disable-folding (string &rest body) "\
+Eval BODY with `case-fold-search' let to nil if STRING contains
+uppercase letters and `search-caps-disable-folding' is t."
+  `(let ((case-fold-search
+          (if (and case-fold-search search-caps-disable-folding)
+              (isearch-no-upper-case-p ,string)
+            case-fold-search)))
+     ,@body))
+(put 'with-caps-disable-folding 'lisp-indent-function 1)
+(put 'with-caps-disable-folding 'edebug-form-spec '(form body))
+
 (defun find-tag-internal (tagname)
   (let ((next (null tagname))
 	(exact (or tags-always-exact (consp tagname)))
@@ -853,60 +866,61 @@
 	  (t
 	   (setq tag-target tagname)
 	   (setq syn-tab (syntax-table))))
-    (save-excursion
-      (catch 'found
-	(while tag-tables
-	  (set-buffer (get-tag-table-buffer (car tag-tables)))
-	  (bury-buffer (current-buffer))
-	  (goto-char (or tag-table-point (point-min)))
-	  (setq tag-table-point nil)
-	  (let ((osyn (syntax-table))
-		case-fold-search)
-	    (set-syntax-table syn-tab)
-	    (unwind-protect
-		;; **** should there be support for non-regexp tag searches?
-		(while (re-search-forward tag-target nil t)
-		  (if (looking-at "[^\n\C-?]*\C-?")
-		      (throw 'found t)))
-	      (set-syntax-table osyn)))
-	  (setq tag-tables (cdr tag-tables)))
-	(error "No %sentries %s %s"
-	       (if next "more " "")
-	       (if exact "matching" "containing")
-	       tagname))
-      (search-forward "\C-?")
-      (setq file (expand-file-name (file-of-tag)
-				   ;; XEmacs change: this needs to be
-				   ;; relative to the 
-				   (or (file-name-directory (car tag-tables))
-				       "./")))
-      (setq linebeg
-	    (buffer-substring (1- (point))
-			      (save-excursion (beginning-of-line) (point))))
-      (search-forward ",")
-      (setq startpos (read (current-buffer)))
-      (setq last-tag-data (nconc (list tagname (point)) tag-tables)))
-    (setq buf (find-file-noselect file))
-    (save-excursion
-      (set-buffer buf)
+    (with-caps-disable-folding tag-target
       (save-excursion
-	(save-restriction
-	  (widen)
-	  (setq offset 1000)
-	  (setq pat (concat "^" (regexp-quote linebeg)))
-	  (or startpos (setq startpos (point-min)))
-	  (while (and (not found)
-		      (progn
-			(goto-char (- startpos offset))
-			(not (bobp))))
-	    (setq found (re-search-forward pat (+ startpos offset) t))
-	    (setq offset (* 3 offset)))
-	  (or found
-	      (re-search-forward pat nil t)
-	      (error "%s not found in %s" pat file))
-	  (beginning-of-line)
-	  (setq startpos (point)))))
-    (cons buf startpos)))
+        (catch 'found
+          (while tag-tables
+            (set-buffer (get-tag-table-buffer (car tag-tables)))
+            (bury-buffer (current-buffer))
+            (goto-char (or tag-table-point (point-min)))
+            (setq tag-table-point nil)
+            (let ((osyn (syntax-table))
+                  case-fold-search)
+              (set-syntax-table syn-tab)
+              (unwind-protect
+                  ;; **** should there be support for non-regexp tag searches?
+                  (while (re-search-forward tag-target nil t)
+                    (if (looking-at "[^\n\C-?]*\C-?")
+                        (throw 'found t)))
+                (set-syntax-table osyn)))
+            (setq tag-tables (cdr tag-tables)))
+          (error "No %sentries %s %s"
+                 (if next "more " "")
+                 (if exact "matching" "containing")
+                 tagname))
+        (search-forward "\C-?")
+        (setq file (expand-file-name (file-of-tag)
+                                     ;; XEmacs change: this needs to be
+                                     ;; relative to the 
+                                     (or (file-name-directory (car tag-tables))
+                                         "./")))
+        (setq linebeg
+              (buffer-substring (1- (point))
+                                (save-excursion (beginning-of-line) (point))))
+        (search-forward ",")
+        (setq startpos (read (current-buffer)))
+        (setq last-tag-data (nconc (list tagname (point)) tag-tables)))
+      (setq buf (find-file-noselect file))
+      (save-excursion
+        (set-buffer buf)
+        (save-excursion
+          (save-restriction
+            (widen)
+            (setq offset 1000)
+            (setq pat (concat "^" (regexp-quote linebeg)))
+            (or startpos (setq startpos (point-min)))
+            (while (and (not found)
+                        (progn
+                          (goto-char (- startpos offset))
+                          (not (bobp))))
+              (setq found (re-search-forward pat (+ startpos offset) t))
+              (setq offset (* 3 offset)))
+            (or found
+                (re-search-forward pat nil t)
+                (error "%s not found in %s" pat file))
+            (beginning-of-line)
+            (setq startpos (point)))))
+      (cons buf startpos))))
 
 ;;;###autoload
 (defun find-tag (tagname &optional other-window)
@@ -1176,6 +1190,7 @@
          (null tags-loop-operate)
          (message "Scanning file %s...found" buffer-file-name))))
 
+
 ;;;###autoload
 (defun tags-search (regexp &optional file-list-form)
   "Search through all files listed in tags table for match for REGEXP.
@@ -1185,16 +1200,15 @@
 See documentation of variable `tag-table-alist'."
   (interactive "sTags search (regexp): ")
   (if (and (equal regexp "")
-           (eq (car tags-loop-scan) 're-search-forward)
+           (eq (car tags-loop-scan) 'with-caps-disable-folding)
            (null tags-loop-operate))
       ;; Continue last tags-search as if by M-,.
       (tags-loop-continue nil)
-    (setq tags-loop-scan
-          (list 're-search-forward regexp nil t)
+    (setq tags-loop-scan `(with-caps-disable-folding ,regexp
+                            (re-search-forward ,regexp nil t))
           tags-loop-operate nil)
     (tags-loop-continue (or file-list-form t))))
-
-
+  
 ;;;###autoload
 (defun tags-query-replace (from to &optional delimited file-list-form)
   "Query-replace-regexp FROM with TO through all files listed in tags table.
@@ -1205,14 +1219,14 @@
 See documentation of variable `tag-table-alist'."
   (interactive
    "sTags query replace (regexp): \nsTags query replace %s by: \nP")
-  (setq tags-loop-scan (list 'prog1
-                             (list 'if (list 're-search-forward from nil t)
-                                   ;; When we find a match, move back
-                                   ;; to the beginning of it so perform-replace
-                                   ;; will see it.
-                                   '(goto-char (match-beginning 0))))
+  (setq tags-loop-scan `(with-caps-disable-folding ,from
+                          (if (re-search-forward ,from nil t)
+                              ;; When we find a match, move back
+                              ;; to the beginning of it so perform-replace
+                              ;; will see it.
+                              (progn (goto-char (match-beginning 0)) t)))
         tags-loop-operate (list 'perform-replace from to t t delimited))
-  (tags-loop-continue (or file-list-form t)))
+   (tags-loop-continue (or file-list-form t)))
 
 ;; Miscellaneous
 

