Mercurial > emacs

--- a/lisp/info.el	Thu Jul 02 15:27:37 2009 +0000
+++ b/lisp/info.el	Thu Jul 02 22:47:33 2009 +0000
@@ -328,6 +328,54 @@

 (defvar Info-standalone nil
   "Non-nil if Emacs was started solely as an Info browser.")
+
+(defvar Info-virtual-files nil
+  "List of definitions of virtual Info files.
+Each element of the list has the format (FILENAME (OPERATION . HANDLER) ...)
+where FILENAME is a regexp that matches a class of virtual Info file names.
+It should be carefully chosen to not cause file name clashes with
+existing file names.  OPERATION is one of the following operation
+symbols `find-file', `find-node', `toc-nodes' that define what HANDLER
+function to call instead of calling the default corresponding function
+to override it.")
+
+(defvar Info-virtual-nodes nil
+  "List of definitions of virtual Info nodes.
+Each element of the list has the format (NODENAME (OPERATION . HANDLER) ...)
+where NODENAME is a regexp that matches a class of virtual Info node names.
+It should be carefully chosen to not cause node name clashes with
+existing node names.  OPERATION is one of the following operation
+symbols `find-node' that define what HANDLER
+function to call instead of calling the default corresponding function
+to override it.")
+
+(defvar Info-current-node-virtual nil
+  "Non-nil if the current Info node is virtual.")
+
+(defun Info-virtual-file-p (filename)
+  "Check if Info file FILENAME is virtual."
+  (Info-virtual-fun 'find-file filename nil))
+
+(defun Info-virtual-fun (op filename nodename)
+  "Find a function that handles operations on virtual manuals.
+OP is an operation symbol (`find-file', `find-node' or `toc-nodes'),
+FILENAME is a virtual Info file name, NODENAME is a virtual Info
+node name.  Return a function found either in `Info-virtual-files'
+or `Info-virtual-nodes'."
+  (or (and (stringp filename) ; some legacy code can still use a symbol
+	   (cdr-safe (assoc op (assoc-default filename
+					      Info-virtual-files
+					      'string-match))))
+      (and (stringp nodename) ; some legacy code can still use a symbol
+	   (cdr-safe (assoc op (assoc-default nodename
+					      Info-virtual-nodes
+					      'string-match))))))
+
+(defun Info-virtual-call (virtual-fun &rest args)
+  "Call a function that handles operations on virtual manuals."
+  (when (functionp virtual-fun)
+    (or (apply virtual-fun args) t)))
+

 (defvar Info-suffix-list
   ;; The MS-DOS list should work both when long file names are
@@ -481,7 +529,7 @@
   (or (assoc file Info-file-supports-index-cookies-list)
       ;; Skip virtual Info files
       (and (or (not (stringp file))
-	       (member file '("dir" apropos history toc)))
+	       (Info-virtual-file-p file))
            (setq Info-file-supports-index-cookies-list
 		 (cons (cons file nil) Info-file-supports-index-cookies-list)))
       (save-excursion
@@ -660,59 +708,58 @@
 just return nil (no error)."
   ;; Convert filename to lower case if not found as specified.
   ;; Expand it.
-  (if (stringp filename)
-      (let (temp temp-downcase found)
-        (setq filename (substitute-in-file-name filename))
-	(cond
-	 ((string= (downcase filename) "dir")
-	  (setq found t))
-	 (t
-	  (let ((dirs (if (string-match "^\\./" filename)
-                          ;; If specified name starts with `./'
-                          ;; then just try current directory.
-                          '("./")
-                        (if (file-name-absolute-p filename)
-                            ;; No point in searching for an
-                            ;; absolute file name
-                            '(nil)
-                          (if Info-additional-directory-list
-                              (append Info-directory-list
-                                      Info-additional-directory-list)
-                            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.
-              (let ((suffix-list Info-suffix-list)
-		    (lfn (if (fboundp 'msdos-long-file-names)
-			     (msdos-long-file-names)
-			   t)))
-                (while (and suffix-list (not found))
-                  (cond ((info-file-exists-p
-                          (info-insert-file-contents-1
-                           temp (car (car suffix-list)) lfn))
-                         (setq found temp))
-                        ((info-file-exists-p
-                          (info-insert-file-contents-1
-                           temp-downcase (car (car suffix-list)) lfn))
-                         (setq found temp-downcase))
-			((and (fboundp 'msdos-long-file-names)
-			      lfn
-			      (info-file-exists-p
-			       (info-insert-file-contents-1
-				temp (car (car suffix-list)) nil)))
-			 (setq found temp)))
-                  (setq suffix-list (cdr suffix-list))))
-              (setq dirs (cdr dirs))))))
-        (if found
-            (setq filename found)
-          (if noerror
-              (setq filename nil)
-            (error "Info file %s does not exist" filename)))
-        filename)
-    (and (member filename '(apropos history toc)) filename)))
+  (cond
+   ((Info-virtual-call
+     (Info-virtual-fun 'find-file filename nil)
+     filename noerror))
+   ((stringp 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.
+		      '("./")
+		    (if (file-name-absolute-p filename)
+			;; No point in searching for an
+			;; absolute file name
+			'(nil)
+		      (if Info-additional-directory-list
+			  (append Info-directory-list
+				  Info-additional-directory-list)
+			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.
+	  (let ((suffix-list Info-suffix-list)
+		(lfn (if (fboundp 'msdos-long-file-names)
+			 (msdos-long-file-names)
+		       t)))
+	    (while (and suffix-list (not found))
+	      (cond ((info-file-exists-p
+		      (info-insert-file-contents-1
+		       temp (car (car suffix-list)) lfn))
+		     (setq found temp))
+		    ((info-file-exists-p
+		      (info-insert-file-contents-1
+		       temp-downcase (car (car suffix-list)) lfn))
+		     (setq found temp-downcase))
+		    ((and (fboundp 'msdos-long-file-names)
+			  lfn
+			  (info-file-exists-p
+			   (info-insert-file-contents-1
+			    temp (car (car suffix-list)) nil)))
+		     (setq found temp)))
+	      (setq suffix-list (cdr suffix-list))))
+	  (setq dirs (cdr dirs))))
+      (if found
+	  (setq filename found)
+	(if noerror
+	    (setq filename nil)
+	  (error "Info file %s does not exist" filename)))
+      filename))))

 (defun Info-find-node (filename nodename &optional no-going-back)
   "Go to an Info node specified as separate FILENAME and NODENAME.
@@ -862,68 +909,76 @@
   (setq Info-current-node nil)
   (unwind-protect
       (let ((case-fold-search t)
+	    (virtual-fun (Info-virtual-fun 'find-node
+					   (or filename Info-current-file)
+					   nodename))
 	    anchorpos)
-        ;; Switch files if necessary
-        (or (null filename)
-            (equal Info-current-file filename)
-            (let ((inhibit-read-only t))
-              (setq Info-current-file nil
-                    Info-current-subfile nil
-                    Info-current-file-completions nil
-                    buffer-file-name nil)
-              (erase-buffer)
-	      (cond
-	       ((eq filename t)
-		(Info-insert-dir))
-	       ((eq filename 'apropos)
-		(insert-buffer-substring " *info-apropos*"))
-	       ((eq filename 'history)
-		(insert-buffer-substring " *info-history*"))
-	       ((eq filename 'toc)
-		(insert-buffer-substring " *info-toc*"))
-	       (t
-                (info-insert-file-contents filename nil)
-                (setq default-directory (file-name-directory filename))))
-              (set-buffer-modified-p nil)
-	      (set (make-local-variable 'Info-file-supports-index-cookies)
-		   (Info-file-supports-index-cookies filename))
-
-              ;; See whether file has a tag table.  Record the location if yes.
-              (goto-char (point-max))
-              (forward-line -8)
-              ;; Use string-equal, not equal, to ignore text props.
-              (if (not (or (string-equal nodename "*")
-                           (not
-                            (search-forward "\^_\nEnd tag table\n" nil t))))
-                  (let (pos)
-                    ;; We have a tag table.  Find its beginning.
-                    ;; Is this an indirect file?
-                    (search-backward "\nTag table:\n")
-                    (setq pos (point))
-                    (if (save-excursion
-                          (forward-line 2)
-                          (looking-at "(Indirect)\n"))
-                        ;; It is indirect.  Copy it to another buffer
-                        ;; and record that the tag table is in that buffer.
-                        (let ((buf (current-buffer))
-                              (tagbuf
-                               (or Info-tag-table-buffer
-                                   (generate-new-buffer " *info tag table*"))))
-                          (setq Info-tag-table-buffer tagbuf)
-                          (with-current-buffer tagbuf
-                            (buffer-disable-undo (current-buffer))
-                            (setq case-fold-search t)
-                            (erase-buffer)
-                            (insert-buffer-substring buf))
-                          (set-marker Info-tag-table-marker
-                                      (match-end 0) tagbuf))
-                      (set-marker Info-tag-table-marker pos)))
-                (set-marker Info-tag-table-marker nil))
-              (setq Info-current-file
-		    (cond
-		     ((eq filename t) "dir")
-		     (t filename)))
-	      ))
+	(cond
+	 ((functionp virtual-fun)
+	  (let ((filename (or filename Info-current-file)))
+	    (setq buffer-file-name nil)
+	    (setq buffer-read-only nil)
+	    (erase-buffer)
+	    (setq Info-current-file filename)
+	    (Info-virtual-call virtual-fun filename nodename no-going-back)
+	    (set-marker Info-tag-table-marker nil)
+	    (setq buffer-read-only t)
+	    (set-buffer-modified-p nil)
+	    (set (make-local-variable 'Info-current-node-virtual) t)))
+	 ((not (and
+		;; Reread a file when moving from a virtual node.
+		(not Info-current-node-virtual)
+		(or (null filename)
+		    (equal Info-current-file filename))))
+	  ;; Switch files if necessary
+	  (let ((inhibit-read-only t))
+	    (if (and Info-current-node-virtual (null filename))
+		(setq filename Info-current-file))
+	    (setq Info-current-file nil
+		  Info-current-subfile nil
+		  Info-current-file-completions nil
+		  buffer-file-name nil)
+	    (erase-buffer)
+	    (info-insert-file-contents filename nil)
+	    (setq default-directory (file-name-directory filename))
+	    (set-buffer-modified-p nil)
+	    (set (make-local-variable 'Info-file-supports-index-cookies)
+		 (Info-file-supports-index-cookies filename))
+
+	    ;; See whether file has a tag table.  Record the location if yes.
+	    (goto-char (point-max))
+	    (forward-line -8)
+	    ;; Use string-equal, not equal, to ignore text props.
+	    (if (not (or (string-equal nodename "*")
+			 (not
+			  (search-forward "\^_\nEnd tag table\n" nil t))))
+		(let (pos)
+		  ;; We have a tag table.  Find its beginning.
+		  ;; Is this an indirect file?
+		  (search-backward "\nTag table:\n")
+		  (setq pos (point))
+		  (if (save-excursion
+			(forward-line 2)
+			(looking-at "(Indirect)\n"))
+		      ;; It is indirect.  Copy it to another buffer
+		      ;; and record that the tag table is in that buffer.
+		      (let ((buf (current-buffer))
+			    (tagbuf
+			     (or Info-tag-table-buffer
+				 (generate-new-buffer " *info tag table*"))))
+			(setq Info-tag-table-buffer tagbuf)
+			(with-current-buffer tagbuf
+			  (buffer-disable-undo (current-buffer))
+			  (setq case-fold-search t)
+			  (erase-buffer)
+			  (insert-buffer-substring buf))
+			(set-marker Info-tag-table-marker
+				    (match-end 0) tagbuf))
+		    (set-marker Info-tag-table-marker pos)))
+	      (set-marker Info-tag-table-marker nil))
+	    (setq Info-current-file filename)
+	    )))
+
         ;; Use string-equal, not equal, to ignore text props.
         (if (string-equal nodename "*")
             (progn (setq Info-current-node nodename)
@@ -1998,6 +2053,26 @@
     (Info-find-node filename nodename)
     (setq Info-history-forward history-forward)
     (goto-char opoint)))
+
+(add-to-list 'Info-virtual-files
+	     '("\\`dir\\'"
+	       (toc-nodes . Info-directory-toc-nodes)
+	       (find-file . Info-directory-find-file)
+	       (find-node . Info-directory-find-node)
+	       ))
+
+(defun Info-directory-toc-nodes (filename)
+  "Directory-specific implementation of Info-directory-toc-nodes."
+  `(,filename
+    ("Top" nil nil nil)))
+
+(defun Info-directory-find-file (filename &optional noerror)
+  "Directory-specific implementation of Info-find-file."
+  filename)
+
+(defun Info-directory-find-node (filename nodename &optional no-going-back)
+  "Directory-specific implementation of Info-find-node-2."
+  (Info-insert-dir))

 ;;;###autoload
 (defun Info-directory ()
@@ -2005,72 +2080,88 @@
   (interactive)
   (Info-find-node "dir" "top"))

+(add-to-list 'Info-virtual-files
+	     '("\\`\\*History\\*\\'"
+	       (toc-nodes . Info-history-toc-nodes)
+	       (find-file . Info-history-find-file)
+	       (find-node . Info-history-find-node)
+	       ))
+
+(defun Info-history-toc-nodes (filename)
+  "History-specific implementation of Info-history-toc-nodes."
+  `(,filename
+    ("Top" nil nil nil)))
+
+(defun Info-history-find-file (filename &optional noerror)
+  "History-specific implementation of Info-find-file."
+  filename)
+
+(defun Info-history-find-node (filename nodename &optional no-going-back)
+  "History-specific implementation of Info-find-node-2."
+  (insert (format "\n\^_\nFile: %s,  Node: %s,  Up: (dir)\n\n"
+		  (or filename Info-current-file) nodename))
+  (insert "Recently Visited Nodes\n")
+  (insert "**********************\n\n")
+  (insert "* Menu:\n\n")
+  (let ((hl (delete '("*History*" "Top") Info-history-list)))
+    (while hl
+      (let ((file (nth 0 (car hl)))
+	    (node (nth 1 (car hl))))
+	(if (stringp file)
+	    (insert "* " node ": ("
+		    (propertize (or (file-name-directory file) "") 'invisible t)
+		    (file-name-nondirectory file)
+		    ")" node ".\n")))
+      (setq hl (cdr hl)))))
+
 (defun Info-history ()
   "Go to a node with a menu of visited nodes."
   (interactive)
-  (let ((curr-file Info-current-file)
-        (curr-node Info-current-node)
-        p)
-    (with-current-buffer (get-buffer-create " *info-history*")
-      (let ((inhibit-read-only t))
-        (erase-buffer)
-        (goto-char (point-min))
-        (insert "\n\^_\nFile: history,  Node: Top,  Up: (dir)\n\n")
-        (insert "Recently Visited Nodes\n**********************\n\n")
-        (insert "* Menu:\n\n")
-        (let ((hl (delete '("history" "Top") Info-history-list)))
-          (while hl
-            (let ((file (nth 0 (car hl)))
-                  (node (nth 1 (car hl))))
-              (if (and (equal file curr-file)
-                       (equal node curr-node))
-                  (setq p (point)))
-              (if (stringp file)
-		  (insert "* " node ": ("
-			  (propertize (or (file-name-directory file) "") 'invisible t)
-			  (file-name-nondirectory file)
-			  ")" node ".\n")))
-            (setq hl (cdr hl))))))
-    (Info-find-node 'history "Top")
-    (goto-char (or p (point-min)))))
+  (Info-find-node "*History*" "Top")
+  (Info-next-reference)
+  (Info-next-reference))
+
+(add-to-list 'Info-virtual-nodes
+	     '("\\`\\*TOC\\*\\'"
+	       (find-node . Info-toc-find-node)
+	       ))
+
+(defun Info-toc-find-node (filename nodename &optional no-going-back)
+  "Toc-specific implementation of Info-find-node-2."
+  (let* ((curr-file (substring-no-properties (or filename Info-current-file)))
+	 (curr-node (substring-no-properties (or nodename Info-current-node)))
+	 (node-list (Info-toc-nodes curr-file)))
+    (insert (format "\n\^_\nFile: %s,  Node: %s,  Up: Top\n\n"
+		    curr-file curr-node))
+    (insert "Table of Contents\n")
+    (insert "*****************\n\n")
+    (insert "*Note Top::\n")
+    (Info-toc-insert
+     (nth 3 (assoc "Top" node-list))	; get Top nodes
+     node-list 0 curr-file)
+    (unless (bobp)
+      (let ((Info-hide-note-references 'hide)
+	    (Info-fontify-visited-nodes nil))
+	(setq Info-current-file filename Info-current-node "*TOC*")
+	(goto-char (point-min))
+	(narrow-to-region (or (re-search-forward "\n[\^_\f]\n" nil t)
+			      (point-min))
+			  (point-max))
+	(Info-fontify-node)
+	(widen)))))

 (defun Info-toc ()
   "Go to a node with table of contents of the current Info file.
 Table of contents is created from the tree structure of menus."
   (interactive)
-  (if (stringp Info-current-file)
-      (let ((curr-file (substring-no-properties Info-current-file))
-	    (curr-node (substring-no-properties Info-current-node))
-	    p)
-	(with-current-buffer (get-buffer-create " *info-toc*")
-	  (let ((inhibit-read-only t)
-		(node-list (Info-toc-nodes curr-file)))
-	    (erase-buffer)
-	    (goto-char (point-min))
-	    (insert "\n\^_\nFile: toc,  Node: Top,  Up: (dir)\n\n")
-	    (insert "Table of Contents\n*****************\n\n")
-	    (insert "*Note Top: (" curr-file ")Top.\n")
-	    (Info-insert-toc
-	     (nth 3 (assoc "Top" node-list)) ; get Top nodes
-	     node-list 0 curr-file))
-	  (if (not (bobp))
-	      (let ((Info-hide-note-references 'hide)
-		    (Info-fontify-visited-nodes nil))
-		(Info-mode)
-		(setq Info-current-file 'toc Info-current-node "Top")
-		(goto-char (point-min))
-		(narrow-to-region (or (re-search-forward "\n[\^_\f]\n" nil t)
-				      (point-min))
-				  (point-max))
-		(Info-fontify-node)
-		(widen)))
-	  (goto-char (point-min))
-	  (if (setq p (search-forward (concat "*Note " curr-node ":") nil t))
-	      (setq p (- p (length curr-node) 2))))
-	(Info-find-node 'toc "Top")
-	(goto-char (or p (point-min))))))
-
-(defun Info-insert-toc (nodes node-list level curr-file)
+  (Info-find-node Info-current-file "*TOC*")
+  (let ((prev-node (nth 1 (car Info-history))) p)
+    (goto-char (point-min))
+    (if (setq p (search-forward (concat "*Note " prev-node ":") nil t))
+	(setq p (- p (length prev-node) 2)))
+    (goto-char (or p (point-min)))))
+
+(defun Info-toc-insert (nodes node-list level curr-file)
   "Insert table of contents with references to nodes."
   (let ((section "Top"))
     (while nodes
@@ -2078,11 +2169,11 @@
         (unless (member (nth 2 node) (list nil section))
           (insert (setq section (nth 2 node)) "\n"))
         (insert (make-string level ?\t))
-        (insert "*Note " (car nodes) ": (" curr-file ")" (car nodes) ".\n")
-        (Info-insert-toc (nth 3 node) node-list (1+ level) curr-file)
+        (insert "*Note " (car nodes) ":: \n")
+        (Info-toc-insert (nth 3 node) node-list (1+ level) curr-file)
         (setq nodes (cdr nodes))))))

-(defun Info-build-toc (file)
+(defun Info-toc-build (file)
   "Build table of contents from menus of Info FILE and its subfiles."
   (with-temp-buffer
     (let* ((file (and (stringp file) (Info-find-file file)))
@@ -2162,23 +2253,28 @@
 SECTION is the section name in the Top node where this node is placed,
 CHILDREN is a list of child nodes extracted from the node menu.")

-(defun Info-toc-nodes (file)
-  "Return a node list of Info FILE with parent-children information.
+(defun Info-toc-nodes (filename)
+  "Return a node list of Info FILENAME with parent-children information.
 This information is cached in the variable `Info-toc-nodes' with the help
-of the function `Info-build-toc'."
-  (or file (setq file Info-current-file))
-  (or (assoc file Info-toc-nodes)
-      ;; Skip virtual Info files
-      (and (or (not (stringp file))
-	       (member file '("dir" apropos history toc)))
-           (push (cons file nil) Info-toc-nodes))
-      ;; Scan the entire manual and cache the result in Info-toc-nodes
-      (let ((nodes (Info-build-toc file)))
-	(push (cons file nodes) Info-toc-nodes)
-	nodes)
-      ;; If there is an error, still add nil to the cache
-      (push (cons file nil) Info-toc-nodes))
-  (cdr (assoc file Info-toc-nodes)))
+of the function `Info-toc-build'."
+  (cond
+   ((Info-virtual-call
+     (Info-virtual-fun 'toc-nodes (or filename Info-current-file) nil)
+     filename))
+   (t
+    (or filename (setq filename Info-current-file))
+    (or (assoc filename Info-toc-nodes)
+	;; Skip virtual Info files
+	(and (or (not (stringp filename))
+		 (Info-virtual-file-p filename))
+	     (push (cons filename nil) Info-toc-nodes))
+	;; Scan the entire manual and cache the result in Info-toc-nodes
+	(let ((nodes (Info-toc-build filename)))
+	  (push (cons filename nodes) Info-toc-nodes)
+	  nodes)
+	;; If there is an error, still add nil to the cache
+	(push (cons filename nil) Info-toc-nodes))
+    (cdr (assoc filename Info-toc-nodes)))))


 (defun Info-follow-reference (footnotename &optional fork)
@@ -2792,7 +2888,7 @@
   (or (assoc file Info-index-nodes)
       ;; Skip virtual Info files
       (and (or (not (stringp file))
-	       (member file '("dir" apropos history toc)))
+	       (Info-virtual-file-p file))
            (setq Info-index-nodes (cons (cons file nil) Info-index-nodes)))
       (if (Info-file-supports-index-cookies file)
 	  ;; Find nodes with index cookie
@@ -2860,21 +2956,22 @@
 If NODE is nil, check the current Info node.
 If FILE is nil, check the current Info file."
   (or file (setq file Info-current-file))
-  (if (or (and node (not (equal node Info-current-node)))
-          (assoc file Info-index-nodes))
+  (if (and (or (and node (not (equal node Info-current-node)))
+	       (assoc file Info-index-nodes))
+	   (not Info-current-node-virtual))
       (member (or node Info-current-node) (Info-index-nodes file))
     ;; Don't search all index nodes if request is only for the current node
     ;; and file is not in the cache of index nodes
-    (if (Info-file-supports-index-cookies file)
-	(save-excursion
-	  (goto-char (+ (or (save-excursion
-			      (search-backward "\n\^_" nil t))
-			    (point-min)) 2))
-	  (search-forward "\0\b[index\0\b]"
-			  (or (save-excursion
-				(search-forward "\n\^_" nil t))
-			      (point-max)) t))
-      (save-match-data
+    (save-match-data
+      (if (Info-file-supports-index-cookies file)
+	  (save-excursion
+	    (goto-char (+ (or (save-excursion
+				(search-backward "\n\^_" nil t))
+			      (point-min)) 2))
+	    (search-forward "\0\b[index\0\b]"
+			    (or (save-excursion
+				  (search-forward "\n\^_" nil t))
+				(point-max)) t))
 	(string-match "\\<Index\\>" (or node Info-current-node ""))))))

 (defun Info-goto-index ()
@@ -3000,11 +3097,163 @@
                  (Info-find-index-name (match-string 1 name))))
 	(progn (beginning-of-line) t)  ;; non-nil for recursive call
       (goto-char (point-min)))))
-
-;;;###autoload
-(defun info-apropos (string)
-  "Grovel indices of all known Info files on your system for STRING.
-Build a menu of the possible matches."
+
+(add-to-list 'Info-virtual-nodes
+	     '("\\`\\*Index.*\\*\\'"
+	       (find-node . Info-virtual-index-find-node)
+	       ))
+
+(defvar Info-virtual-index-nodes nil
+  "Alist of cached matched index search nodes.
+Each element is ((FILENAME . TOPIC) MATCHES) where
+FILENAME is the file name of the manual,
+TOPIC is the search string given as an argument to `Info-virtual-index',
+MATCHES is a list of index matches found by `Info-index'.")
+
+(defun Info-virtual-index-find-node (filename nodename &optional no-going-back)
+  "Index-specific implementation of Info-find-node-2."
+  ;; Generate Index-like menu of matches
+  (if (string-match "^\\*Index for `\\(.+\\)'\\*$" nodename)
+      ;; Generate Index-like menu of matches
+      (let* ((topic (match-string 1 nodename))
+	     (matches (cdr (assoc (cons (or filename Info-current-file) topic)
+				  Info-virtual-index-nodes))))
+	(insert (format "\n\^_\nFile: %s,  Node: %s,  Up: *Index*\n\n"
+			(or filename Info-current-file) nodename))
+	(insert "Info Virtual Index\n")
+	(insert "******************\n\n")
+	(insert "Index entries that match `" topic "':\n\n")
+	(insert "\0\b[index\0\b]\n")
+	(if (null matches)
+	    (insert "No matches found.\n")
+	  (insert "* Menu:\n\n")
+	  (dolist (entry matches)
+	    (insert (format "* %-38s %s.%s\n"
+			    (format "%s [%s]:" (nth 0 entry) (nth 2 entry))
+			    (nth 1 entry)
+			    (if (nth 3 entry)
+				(format " (line %s)" (nth 3 entry))
+			      ""))))))
+    ;; Else, Generate a list of previous search results
+    (let ((nodes (reverse Info-virtual-index-nodes)))
+      (insert (format "\n\^_\nFile: %s,  Node: %s,  Up: Top\n\n"
+		      (or filename Info-current-file) nodename))
+      (insert "Info Virtual Index\n")
+      (insert "******************\n\n")
+      (insert "This is a list of search results produced by\n"
+	      "`Info-virtual-index' for the current manual.\n\n")
+      (insert "* Menu:\n\n")
+      (dolist (nodeinfo nodes)
+	(when (equal (car (nth 0 nodeinfo)) (or filename Info-current-file))
+	  (insert
+	   (format "* %-20s %s.\n"
+		   (format "*Index for `%s'*::" (cdr (nth 0 nodeinfo)))
+		   (cdr (nth 0 nodeinfo)))))))))
+
+(defun Info-virtual-index (topic)
+  "Show a node with all lines in the index containing a string TOPIC.
+Like `Info-index' but displays a node with index search results.
+Give an empty topic name to go to the node with links to previous
+search results."
+  ;; `interactive' is a copy from `Info-index'
+  (interactive
+   (list
+    (let ((completion-ignore-case t)
+	  (Info-complete-menu-buffer (clone-buffer))
+	  (Info-complete-nodes (Info-index-nodes))
+	  (Info-history-list nil))
+      (if (equal Info-current-file "dir")
+	  (error "The Info directory node has no index; use m to select a manual"))
+      (unwind-protect
+	  (with-current-buffer Info-complete-menu-buffer
+	    (Info-goto-index)
+	    (completing-read "Index topic: " 'Info-complete-menu-item))
+	(kill-buffer Info-complete-menu-buffer)))))
+  (if (equal topic "")
+      (Info-find-node Info-current-file "*Index*")
+    (unless (assoc (cons Info-current-file topic) Info-virtual-index-nodes)
+      (let ((orignode Info-current-node)
+	    (ohist-list Info-history-list)
+	    nodename)
+	;; Reuse `Info-index' to set `Info-index-alternatives'.
+	(Info-index topic)
+	(push (cons (cons Info-current-file topic) Info-index-alternatives)
+	      Info-virtual-index-nodes)
+	;; Clean up unneccessary side-effects of `Info-index'.
+	(setq Info-history-list ohist-list)
+	(Info-goto-node orignode)
+	(message "")))
+    (Info-find-node Info-current-file (format "*Index for `%s'*" topic))))
+
+(add-to-list 'Info-virtual-files
+	     '("\\`\\*Apropos\\*\\'"
+	       (toc-nodes . Info-apropos-toc-nodes)
+	       (find-file . Info-apropos-find-file)
+	       (find-node . Info-apropos-find-node)
+	       ))
+
+(defvar Info-apropos-file "*Apropos*"
+  "Info file name of the virtual manual for matches of `info-apropos'.")
+
+(defvar Info-apropos-nodes nil
+  "Alist of cached apropos matched nodes.
+Each element is (NODENAME STRING MATCHES) where
+NODENAME is the name of the node that holds the search result,
+STRING is the search string given as an argument to `info-apropos',
+MATCHES is a list of index matches found by `Info-apropos-matches'.")
+
+(defun Info-apropos-toc-nodes (filename)
+  "Apropos-specific implementation of Info-apropos-toc-nodes."
+  (let ((nodes (mapcar 'car (reverse Info-apropos-nodes))))
+    `(,filename
+      ("Top" nil nil ,nodes)
+      ,@(mapcar (lambda (node) `(,node "Top" nil nil)) nodes))))
+
+(defun Info-apropos-find-file (filename &optional noerror)
+  "Apropos-specific implementation of Info-find-file."
+  filename)
+
+(defun Info-apropos-find-node (filename nodename &optional no-going-back)
+  "Apropos-specific implementation of Info-find-node-2."
+  (if (equal nodename "Top")
+      ;; Generate Top menu
+      (let ((nodes (reverse Info-apropos-nodes)))
+	(insert (format "\n\^_\nFile: %s,  Node: %s,  Up: (dir)\n\n"
+			Info-apropos-file nodename))
+	(insert "Apropos Index\n")
+	(insert "*************\n\n")
+	(insert "This is a list of search results produced by `info-apropos'.\n\n")
+	(insert "* Menu:\n\n")
+	(dolist (nodeinfo nodes)
+	  (insert (format "* %-20s %s.\n"
+			  (format "%s::" (nth 0 nodeinfo))
+			  (nth 1 nodeinfo)))))
+    ;; Else, Generate Index-like menu of matches
+    (let* ((nodeinfo (assoc nodename Info-apropos-nodes))
+	   (matches (nth 2 nodeinfo)))
+      (when matches
+	(insert (format "\n\^_\nFile: %s,  Node: %s,  Up: Top\n\n"
+			Info-apropos-file nodename))
+	(insert "Apropos Index\n")
+	(insert "*************\n\n")
+	(insert "Index entries that match `" (nth 1 nodeinfo) "':\n\n")
+	(insert "\0\b[index\0\b]\n")
+	(if (eq matches t)
+	    (insert "No matches found.\n")
+	  (insert "* Menu:\n\n")
+	  (dolist (entry matches)
+	    (insert (format "* %-38s (%s)%s.%s\n"
+			    (format "%s [%s]:" (nth 1 entry) (nth 0 entry))
+			    (nth 0 entry)
+			    (nth 2 entry)
+			    (if (nth 3 entry)
+				(format " (line %s)" (nth 3 entry))
+			      "")))))))))
+
+(defun Info-apropos-matches (string)
+  "Collect STRING matches from all known Info files on your system.
+Return a list of matches where each element is in the format
+\((FILENAME INDEXTEXT NODENAME LINENUMBER))."
   (interactive "sIndex apropos: ")
   (unless (string= string "")
     (let ((pattern (format "\n\\* +\\([^\n]*%s[^\n]*\\):[ \t]+\\([^\n]+\\)\\.\\(?:[ \t\n]*(line +\\([0-9]+\\))\\)?"
@@ -3056,24 +3305,25 @@
       (setq Info-history ohist
 	    Info-history-list ohist-list)
       (message "Searching indices...done")
-      (if (null matches)
-	  (message "No matches found")
-	(with-current-buffer (get-buffer-create " *info-apropos*")
-	  (erase-buffer)
-	  (insert "\n\^_\nFile: apropos, Node: Index, Up: (dir)\n")
-	  (insert "* Menu: \nNodes whose indices contain `" string "':\n\n")
-	  (dolist (entry (nreverse matches))
-	    (insert
-	     (format "* %-38s (%s)%s.%s\n"
-		     (concat (nth 1 entry) " [" (nth 0 entry) "]:")
-		     (nth 0 entry)
-		     (nth 2 entry)
-		     (if (nth 3 entry)
-			 (concat " (line " (nth 3 entry) ")")
-		       "")))))
-	(Info-find-node 'apropos "Index")
-	(setq Info-complete-cache nil)))))
-
+      (or (nreverse matches) t))))
+
+;;;###autoload
+(defun info-apropos (string)
+  "Grovel indices of all known Info files on your system for STRING.
+Build a menu of the possible matches."
+  (interactive "sIndex apropos: ")
+  (if (equal string "")
+      (Info-find-node Info-apropos-file "Top")
+    (let* ((nodes Info-apropos-nodes) nodename)
+      (while (and nodes (not (equal string (nth 1 (car nodes)))))
+	(setq nodes (cdr nodes)))
+      (if nodes
+	  (Info-find-node Info-apropos-file (car (car nodes)))
+	(setq nodename (format "Index for `%s'" string))
+	(push (list nodename string (Info-apropos-matches string))
+	      Info-apropos-nodes)
+	(Info-find-node Info-apropos-file nodename)))))
+
 (defun Info-undefined ()
   "Make command be undefined in Info."
   (interactive)
@@ -3248,6 +3498,7 @@
     (define-key map "g" 'Info-goto-node)
     (define-key map "h" 'Info-help)
     (define-key map "i" 'Info-index)
+    (define-key map "I" 'Info-virtual-index)
     (define-key map "l" 'Info-history-back)
     (define-key map "L" 'Info-history)
     (define-key map "m" 'Info-menu)
@@ -3830,7 +4081,7 @@
 		 (format "(%s)Top"
 			 (if (stringp Info-current-file)
 			     (file-name-nondirectory Info-current-file)
-			   ;; Can be `toc', `apropos', or even `history'.
+			   ;; Some legacy code can still use a symbol.
 			   Info-current-file)))))
 	  (insert (if (bolp) "" " > ")
 		  (cond
@@ -4414,7 +4665,7 @@

 (defun Info-desktop-buffer-misc-data (desktop-dirname)
   "Auxiliary information to be saved in desktop file."
-  (unless (member Info-current-file '(apropos history toc nil))
+  (unless (Info-virtual-file-p Info-current-file)
     (list Info-current-file Info-current-node)))

 (defun Info-restore-desktop-buffer (desktop-buffer-file-name