(Info-insert-dir): Make menu items in Top node

pointing each of the other nodes.

(Info-insert-dir): New function.
(Info-find-node): Use Info-insert-dir to visit dir file.

1 files changed, 125 insertions, 24 deletions

diff --git a/lisp/info.el b/lisp/info.el
index 5ed08baab28..5c273913da6 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -105,27 +105,29 @@ to read a file name from the minibuffer."
   (if filename
       (let (temp temp-downcase found)
 	(setq filename (substitute-in-file-name filename))
-	(let ((dirs (if (string-match "^\\./" filename)
-			;; If specified name starts with `./'
-			;; then just try current directory.
-			'("./")
-		      Info-directory-list)))
-	  ;; Search the directory list for file FILENAME.
-	  (while (and dirs (not found))
-	    (setq temp (expand-file-name filename (car dirs)))
-	    (setq temp-downcase
-		  (expand-file-name (downcase filename) (car dirs)))
-	    ;; Try several variants of specified name.
-	    ;; Try downcasing, appending `.info', or both.
-	    (cond ((file-exists-p temp)
-		   (setq found temp))
-		  ((file-exists-p temp-downcase)
-		   (setq found temp-downcase))
-		  ((file-exists-p (concat temp ".info"))
-		   (setq found (concat temp ".info")))
-		  ((file-exists-p (concat temp-downcase ".info"))
-		   (setq found (concat temp-downcase ".info"))))
-	    (setq dirs (cdr dirs))))
+	(if (string= (downcase (file-name-nondirectory filename)) "dir")
+	    (setq found t)
+	  (let ((dirs (if (string-match "^\\./" filename)
+			  ;; If specified name starts with `./'
+			  ;; then just try current directory.
+			  '("./")
+			Info-directory-list)))
+	    ;; Search the directory list for file FILENAME.
+	    (while (and dirs (not found))
+	      (setq temp (expand-file-name filename (car dirs)))
+	      (setq temp-downcase
+		    (expand-file-name (downcase filename) (car dirs)))
+	      ;; Try several variants of specified name.
+	      ;; Try downcasing, appending `.info', or both.
+	      (cond ((file-exists-p temp)
+		     (setq found temp))
+		    ((file-exists-p temp-downcase)
+		     (setq found temp-downcase))
+		    ((file-exists-p (concat temp ".info"))
+		     (setq found (concat temp ".info")))
+		    ((file-exists-p (concat temp-downcase ".info"))
+		     (setq found (concat temp-downcase ".info"))))
+	      (setq dirs (cdr dirs)))))
 	(if found
 	    (setq filename found)
 	  (error "Info file %s does not exist" filename))))
@@ -151,9 +153,12 @@ to read a file name from the minibuffer."
 		    Info-current-subfile nil
 		    buffer-file-name nil)
 	      (erase-buffer)
-	      (insert-file-contents filename t)
+	      (setq default-directory Info-directory)
+	      (if (eq filename t)
+		  (Info-insert-dir)
+		(insert-file-contents filename t)
+		(setq default-directory (file-name-directory filename)))
 	      (set-buffer-modified-p nil)
-	      (setq default-directory (file-name-directory filename))
 	      ;; See whether file has a tag table.  Record the location if yes.
 	      (set-marker Info-tag-table-marker nil)
 	      (goto-char (point-max))
@@ -181,7 +186,8 @@ to read a file name from the minibuffer."
 					(match-end 0))))
 		      (set-marker Info-tag-table-marker pos))))
 	      (setq Info-current-file
-		    (file-name-sans-versions buffer-file-name))))
+		    (if (eq filename t) "dir"
+		      (file-name-sans-versions buffer-file-name)))))
 	(if (equal nodename "*")
 	    (progn (setq Info-current-node nodename)
 		   (Info-set-mode-line))
@@ -226,6 +232,98 @@ to read a file name from the minibuffer."
 	  (goto-char (nth 2 hist)))))
   (goto-char (point-min)))
 
+;; Record the contents of the (virtual) dir file,
+;; once we have merged it for the first time,
+;; so we can save time subsequently.
+(defvar Info-dir-contents nil)
+
+;; Construct the Info directory node by merging the files named `dir'
+;; from various directories.
+(defun Info-insert-dir ()
+  (if Info-dir-contents
+      (insert Info-dir-contents)
+    (let ((dirs Info-directory-list)
+	  buffers buffer others nodes)
+      ;; Search the directory list for file FILENAME.
+      (while dirs
+	(setq temp (expand-file-name "dir" (car dirs)))
+	;; Try several variants of specified name.
+	;; Try downcasing, appending `.info', or both.
+	(cond ((file-exists-p temp)
+	       (setq buffers (cons (find-file-noselect temp) buffers)))
+	      ((file-exists-p (concat temp ".info"))
+	       (setq buffers (cons (find-file-noselect (concat temp ".info"))
+				   buffers))))
+	(setq dirs (cdr dirs)))
+      ;; Distinguish the dir file that comes with Emacs
+      ;; from all the others.
+      (setq buffer (car buffers)
+	    others (cdr buffers))
+      ;; Insert the entire original dir file as a start.
+      (insert-buffer buffer)
+      ;; Look at each of the other buffers one by one.
+      (while others
+	(let ((other (car others)))
+	  ;; In each, find all the menus.
+	  (save-excursion
+	    (set-buffer other)
+	    (goto-char (point-min))
+	    ;; Find each menu, and add an elt to NODES for it.
+	    (while (re-search-forward "^\\* Menu:" nil t)
+	      (let (beg nodename end)
+		(forward-line 1)
+		(setq beg (point))
+		(search-backward "\n")
+		(search-forward "Node: ")
+		(setq nodename (Info-following-node-name))
+		(search-forward "\n" nil 'move)
+		(beginning-of-line)
+		(setq end (point))
+		(setq nodes (cons (list nodename other beg end) nodes))))))
+	(setq others (cdr others)))
+      ;; Add to the main menu a menu item for each other node.
+      (re-search-forward "^\\* Menu:")
+      (forward-line 1)
+      (let ((menu-items '("top"))
+	    (nodes nodes)
+	    (case-fold-search t)
+	    (end (save-excursion (search-forward "" nil t) (point))))
+	(while nodes
+	  (let ((nodename (car (car nodes))))
+	    (or (member (downcase nodename) menu-items)
+		(re-search-forward (concat "^\\* " (regexp-quote nodename) ":")
+				   end t)
+		(progn
+		  (insert "* " nodename "\n")
+		  (setq menu-items (cons nodename menu-item)))))
+	  (setq nodes (cdr nodes))))
+      ;; Now take each node of each of the other buffers
+      ;; and merge it into the main buffer.
+      (while nodes
+	(let ((nodename (car (car nodes))))
+	  (goto-char (point-min))
+	  ;; Find the like-named node in the main buffer.
+	  (if (re-search-forward (concat "\n.*\n.*Node: "
+					 (regexp-quote nodename)
+					 "[,\n\t]")
+				 nil t)
+	      (progn
+		(search-forward "\n" nil 'move)
+		(beginning-of-line))
+	    ;; If none exists, add one.
+	    (goto-char (point-max))
+	    (insert "\nFile: dir\tnode: " nodename "\n\n* Menu:\n\n"))
+	  ;; Merge the text from the other buffer's menu
+	  ;; into the menu in the like-named node in the main buffer.
+	  (apply 'insert-buffer-substring (cdr (car nodes)))
+	  (insert "\n"))
+	(setq nodes (cdr nodes)))
+      ;; Kill all the buffers we just made.
+      (while buffers
+	(kill-buffer (car buffers))
+	(setq buffers (cdr buffers))))
+    (setq Info-dir-contents (buffer-string))))
+
 (defun Info-read-subfile (nodepos)
   (set-buffer (marker-buffer Info-tag-table-marker))
   (goto-char (point-min))
@@ -412,6 +510,9 @@ to read a file name from the minibuffer."
 	 nil
        (error (concat "Node has no " (capitalize (or errorname name))))))))
 
+;; Return the node name in the buffer following point.
+;; ALLOWEDCHARS, if non-nil, goes within [...] to make a regexp
+;; saying which chas may appear in the node name.
 (defun Info-following-node-name (&optional allowedchars)
   (skip-chars-forward " \t")
   (buffer-substring