Mercurial > emacs

changeset 7211:b2485e94101a

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(tags-table-parent-pointer-list): Doc fix; elts are now 3-elt lists. (tags-next-table): Save tags-table-list in tags-table-parent-pointer-list and then set it to tags-included-tables. Restore tags-table-list from tags-table-parent-pointer-list. (tags-find-table-in-list): Renamed from tags-table-list-member. Search included tables. Take new arg MOVE-TO; if t, frob list pointers. (tags-table-including): Save tags-table-list in tags-table-parent-pointer-list. Set tags-table-list to the passed TABLES value. (visit-tags-table-buffer): When CONT is nil, pop all tags-table-parent-pointer-list state before doing anything else. Don't do list frobnication when CONT is 'same. Call tags-find-table-in-list instead of tags-table-list-member; let it do list frobnication when it succeeds.
author Roland McGrath <roland@gnu.org>
date Sat, 30 Apr 1994 00:51:52 +0000
parents 682ff6213c36
children 2f1305fcecf6
files lisp/progmodes/etags.el
diffstat 1 files changed, 133 insertions(+), 59 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/progmodes/etags.el	Sat Apr 30 00:15:20 1994 +0000
+++ b/lisp/progmodes/etags.el	Sat Apr 30 00:51:52 1994 +0000
@@ -59,9 +59,9 @@
 
 (defvar tags-table-parent-pointer-list nil
   "Saved state of the tags table that included this one.
-Each element is (POINTER . STARTED-AT), giving the values of
- `tags-table-list-pointer' and `tags-table-list-started-at' from
- before we moved into the current table.")
+Each element is (LIST POINTER STARTED-AT), giving the values of
+ `tags-table-list', `tags-table-list-pointer' and
+ `tags-table-list-started-at' from before we moved into the current table.")
 
 (defvar tags-table-set-list nil
   "List of sets of tags table which have been used together in the past.
@@ -213,9 +213,12 @@
       ;; Move into the included tags tables.
       (setq tags-table-parent-pointer-list
 	    ;; Save the current state of what table we are in.
-	    (cons (cons tags-table-list-pointer tags-table-list-started-at)
+	    (cons (list tags-table-list
+			tags-table-list-pointer
+			tags-table-list-started-at)
 		  tags-table-parent-pointer-list)
 	    ;; Start the pointer in the list of included tables.
+	    tags-table-list tags-included-tables
 	    tags-table-list-pointer tags-included-tables
 	    tags-table-list-started-at tags-included-tables)
 
@@ -232,10 +235,12 @@
 	    ;; Pop back to the tags table which includes this one.
 	    (progn
 	      ;; Restore the state variables.
-	      (setq tags-table-list-pointer
-		    (car (car tags-table-parent-pointer-list))
+	      (setq tags-table-list
+		    (nth 0 (car tags-table-parent-pointer-list))
+		    tags-table-list-pointer
+		    (nth 1 (car tags-table-parent-pointer-list))
 		    tags-table-list-started-at
-		    (cdr (car tags-table-parent-pointer-list))
+		    (nth 2 (car tags-table-parent-pointer-list))
 		    tags-table-parent-pointer-list
 		    (cdr tags-table-parent-pointer-list))
 	      ;; Recurse to skip to the next table after the parent.
@@ -255,18 +260,72 @@
       (expand-file-name "TAGS" file)
     file))
 
-;; Return the cdr of LIST (default: tags-table-list) whose car
-;; is equal to FILE after tags-expand-table-name on both sides.
-(defun tags-table-list-member (file &optional list)
+;; Search for FILE in LIST (default: tags-table-list); also search
+;; tables that are already in core for FILE being included by them.  Return t
+;; if we find it, nil if not.  Comparison is done after tags-expand-table-name
+;; on both sides.  If MOVE-TO is non-nil, update tags-table-list and the list
+;; pointers to point to the table found.  In recursive calls, MOVE-TO is a list
+;; value for tags-table-parent-pointer-list describing the position of the
+;; caller's search.
+(defun tags-find-table-in-list (file move-to &optional list)
   (or list
       (setq list tags-table-list))
   (setq file (tags-expand-table-name file))
-  (while (and list
-	      (not (string= file (tags-expand-table-name (car list)))))
-    (setq list (cdr list)))
+  (let (;; Set up the MOVE-TO argument used for the recursive calls we will do
+	;; for included tables.  This is a list value for
+	;; tags-table-parent-pointer-list describing the included tables we are
+	;; descending; we cons our position onto the list from our recursive
+	;; caller (which is searching a list that contains the table whose
+	;; included tables we are searching).  The atom `in-progress' is a
+	;; placeholder; when a recursive call locates FILE, we replace
+	;; 'in-progress with the tail of LIST whose car contained FILE.
+	(recursing-move-to (if move-to
+			       (cons (list list 'in-progress 'in-progress)
+				     (if (eq move-to t) nil move-to))))
+	this-file)
+    (while (and (consp list)		; We set LIST to t when we locate FILE.
+		(not (string= file
+			      (setq this-file
+				    (tags-expand-table-name (car list))))))
+      (if (get-file-buffer this-file)
+	  ;; This table is already in core.  Visit it and recurse to check
+	  ;; its included tables.
+	  (save-excursion
+	    (let ((tags-file-name this-file)
+		  found)
+	      (visit-tags-table-buffer 'same)
+	      (if (tags-find-table-in-list file recursing-move-to
+					   (tags-included-tables))
+		  (progn
+		    ;; We found FILE in the included table.
+		    (if move-to
+			(progn
+			  ;; The recursive call has already frobbed the list
+			  ;; pointers.  It set tags-table-parent-pointer-list
+			  ;; to a list including RECURSING-MOVE-TO.  Now we
+			  ;; must mutate that cons so its list pointers show
+			  ;; the position where we found this included table.
+			  (setcar (cdr (car recursing-move-to)) list)
+			  (setcar (cdr (cdr (car recursing-move-to))) list)
+			  ;; Don't do further list frobnication below.
+			  (setq move-to nil)))
+		    (setq list t))))))
+      (if (consp list)
+	  (setq list (cdr list))))
+    (and list move-to
+	 (progn
+	   ;; We have located FILE in the list.
+	   ;; Now frobnicate the list pointers to point to it.
+	   (setq tags-table-list-started-at list
+		 tags-table-list-pointer list)
+	   (if (consp move-to)
+	       ;; We are in a recursive call.  MOVE-TO is the value for
+	       ;; tags-table-parent-pointer-list that describes the tables
+	       ;; descended by the caller (and its callers, recursively).
+	       (setq tags-table-parent-pointer-list move-to)))))
   list)
 
-;; Local var in visit-tags-table-buffer-cont
+;; Local var in visit-tags-table-buffer
 ;; which is set by tags-table-including.
 (defvar visit-tags-table-buffer-cont)
 
@@ -277,7 +336,8 @@
 ;; CORE-ONLY is non-nil, check only tags tables that are already in
 ;; buffers--don't visit any new files.
 (defun tags-table-including (this-file tables core-only &optional recursing)
-  (let ((found nil))
+  (let ((starting-tables tables)
+	(found nil))
     ;; Loop over TABLES, looking for one containing tags for THIS-FILE.
     (while (and (not found)
 		tables)
@@ -318,9 +378,11 @@
 				 ;; us inside the list of included tables.
 				 (setq tags-table-parent-pointer-list
 				       (cons
-					(cons tags-table-list-pointer
+					(list tags-table-list
+					      tags-table-list-pointer
 					      tags-table-list-started-at)
 					tags-table-parent-pointer-list)
+				       tags-table-list starting-tables
 				       tags-table-list-pointer found
 				       tags-table-list-started-at found
 				       ;; Set a local variable of
@@ -375,6 +437,15 @@
 		   (tags-next-table)))))
 
 	  (t
+	   ;; We are visiting a table anew, so throw away the previous
+	   ;; context of what included tables we were inside of.
+	   (while tags-table-parent-pointer-list
+	     ;; Set the pointer as if we had iterated through all the
+	     ;; tables in the list.
+	     (setq tags-table-list-pointer tags-table-list-started-at)
+	     ;; Fetching the next table will pop the included-table state.
+	     (tags-next-table))
+
 	   ;; Pick a table out of our hat.
 	   (setq tags-file-name
 		 (or
@@ -398,10 +469,10 @@
 			(save-excursion (tags-table-including buffer-file-name
 							      tags-table-list
 							      nil))))
-		  ;; Fourth, use the user variable tags-file-name, if it is not
-		  ;; already in tags-table-list.
+		  ;; Fourth, use the user variable tags-file-name, if it is
+		  ;; not already in tags-table-list.
 		  (and tags-file-name
-		       (not (tags-table-list-member tags-file-name))
+		       (not (tags-find-table-in-list tags-file-name nil))
 		       tags-file-name)
 		  ;; Fifth, use the user variable giving the table list.
 		  ;; Find the first element of the list that actually exists.
@@ -458,52 +529,55 @@
 	    ;; doesn't get in the user's way.
 	    (bury-buffer (current-buffer))
 
-	    (if (memq visit-tags-table-buffer-cont '(same nil))
+	    ;; If this was a new table selection (CONT is nil), make sure
+	    ;; tags-table-list includes the chosen table, and update the
+	    ;; list pointer variables.
+	    (or visit-tags-table-buffer-cont
 		;; Look in the list for the table we chose.
-		(let ((elt (tags-table-list-member tags-file-name)))
-		  (or elt
-		      ;; The table is not in the current set.
-		      ;; Try to find it in another previously used set.
-		      (let ((sets tags-table-set-list))
-			(while (and sets
-				    (not (setq elt
-					       (tags-table-list-member
-						tags-file-name (car sets)))))
-			  (setq sets (cdr sets)))
-			(if sets
-			    ;; Found in some other set.  Switch to that set.
-			    (progn
-			      (or (memq tags-table-list tags-table-set-list)
-				  ;; Save the current list.
-				  (setq tags-table-set-list
-					(cons tags-table-list
-					      tags-table-set-list)))
-			      (setq tags-table-list (car sets)))
-
-			  ;; Not found in any existing set.
-			  (if (and tags-table-list
-				   (or (eq t tags-add-tables)
-				       (and tags-add-tables
-					    (y-or-n-p
-					     (concat "Keep current list of "
-						     "tags tables also? ")))))
-			      ;; Add it to the current list.
-			      (setq tags-table-list (cons tags-file-name
-							  tags-table-list))
-			    ;; Make a fresh list, and store the old one.
-			    (message "Starting a new list of tags tables")
+		;; This updates the list pointers if it finds the table.
+		(or (tags-find-table-in-list tags-file-name t)
+		    ;; The table is not in the current set.
+		    ;; Try to find it in another previously used set.
+		    (let ((sets tags-table-set-list))
+		      (while (and sets
+				  (not (tags-find-table-in-list tags-file-name
+								t (car sets))))
+			(setq sets (cdr sets)))
+		      (if sets
+			  ;; Found in some other set.  Switch to that set.
+			  (progn
 			    (or (memq tags-table-list tags-table-set-list)
+				;; Save the current list.
 				(setq tags-table-set-list
 				      (cons tags-table-list
 					    tags-table-set-list)))
-			    (setq tags-table-list (list tags-file-name)))
-			  (setq elt tags-table-list))))
+			    ;; The list pointers are already up to date;
+			    ;; we need only set tags-table-list.
+			    (setq tags-table-list (car sets)))
 
-		  (or visit-tags-table-buffer-cont
-		      ;; Set the tags table list state variables to point
-		      ;; at the table we want to use first.
-		      (setq tags-table-list-started-at elt
-			    tags-table-list-pointer elt))))
+			;; Not found in any existing set.
+			(if (and tags-table-list
+				 (or (eq t tags-add-tables)
+				     (and tags-add-tables
+					  (y-or-n-p
+					   (concat "Keep current list of "
+						   "tags tables also? ")))))
+			    ;; Add it to the current list.
+			    (setq tags-table-list (cons tags-file-name
+							tags-table-list))
+			  ;; Make a fresh list, and store the old one.
+			  (message "Starting a new list of tags tables")
+			  (or (null tags-table-list)
+			      (memq tags-table-list tags-table-set-list)
+			      (setq tags-table-set-list
+				    (cons tags-table-list
+					  tags-table-set-list)))
+			  (setq tags-table-list (list tags-file-name)))
+
+			;; Set the tags table list state variables to point
+			;; at the table we want to use first.
+			(setq tags-table-list-started-at tags-table-list
+			      tags-table-list-pointer tags-table-list)))))
 
 	    ;; Return of t says the tags table is valid.
 	    t)