Virtual Info files and nodes.

(Info-virtual-files, Info-virtual-nodes): New variables.
(Info-current-node-virtual): New variable.
(Info-virtual-file-p, Info-virtual-fun, Info-virtual-call):
New functions.
(Info-file-supports-index-cookies): Use Info-virtual-file-p
to check for a virtual file instead of checking a fixed list
of node names.
(Info-find-file): Use Info-virtual-fun and Info-virtual-call
instead of ad-hoc processing of "dir" and (apropos history toc).
(Info-find-node-2): Use Info-virtual-fun and Info-virtual-call
instead of ad-hoc processing of "dir" and (apropos history toc).
Reread a file when moving from a virtual node.
(add-to-list)<Info-virtual-files>: Add "\\`dir\\'".
(Info-directory-toc-nodes, Info-directory-find-file)
(Info-directory-find-node): New functions.
(add-to-list)<Info-virtual-files>: Add "\\`\\*History\\*\\'".
(Info-history): Move part of code to
`Info-history-find-node'.
(Info-history-toc-nodes, Info-history-find-file)
(Info-history-find-node): New functions.
(add-to-list)<Info-virtual-nodes>: Add "\\`\\*TOC\\*\\'".
(Info-toc): Move part of code to `Info-toc-find-node'.
(Info-toc-find-node): New function.
(Info-toc-insert): Renamed from `Info-insert-toc'.  Don't insert
the current Info file name to references because now the node
"*TOC*" belongs to the same Info manual.
(Info-toc-build): Renamed from `Info-build-toc'.
(Info-toc-nodes): Rename input argument `file' to `filename'.
Use Info-virtual-fun, Info-virtual-call and Info-virtual-file-p
instead of ad-hoc processing of ("dir" apropos history toc).
(Info-index-nodes): Use Info-virtual-file-p
to check for a virtual file instead of checking a fixed list
of node names.
(Info-index-node): Add check for `Info-current-node-virtual'.
Raise `save-match-data' higher up the tree to contain
`search-forward' too (bug fix).
(add-to-list)<Info-virtual-nodes>: Add "\\`\\*Index.*\\*\\'".
(Info-virtual-index-nodes): New variable.
(Info-virtual-index-find-node, Info-virtual-index): New functions.
(add-to-list)<Info-virtual-files>: Add "\\`\\*Apropos\\*\\'".
(Info-apropos-file, Info-apropos-nodes): New variables.
(Info-apropos-toc-nodes, Info-apropos-find-file)
(Info-apropos-find-node, Info-apropos-matches): New functions.
(info-apropos): Move part of code to `Info-apropos-find-node' and
`Info-apropos-matches'.
(Info-mode-map): Bind "I" to `Info-virtual-index'.
(Info-desktop-buffer-misc-data): Use Info-virtual-file-p to check
for a virtual file instead of checking a fixed list of node names.

1 files changed, 479 insertions, 228 deletions

diff --git a/lisp/info.el b/lisp/info.el
index e9e2b4225f3..03618cc098d 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -328,6 +328,54 @@ If number, the point is moved to the corresponding line.")
 
 (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 @@ in `Info-file-supports-index-cookies-list'."
   (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 @@ Optional second argument NOERROR, if t, means if file is not found
 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 @@ a case-insensitive match is tried."
   (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 @@ If SAME-FILE is non-nil, do not move to a different Info file."
     (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 @@ If SAME-FILE is non-nil, do not move to a different Info file."
   (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))))))
+  (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-insert-toc (nodes node-list level curr-file)
+(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 @@ Table of contents is created from the tree structure of menus."
         (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 @@ where PARENT is the parent node extracted from the Up pointer,
 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 @@ following nodes whose names also contain the word \"Index\"."
   (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 @@ following nodes whose names also contain the word \"Index\"."
 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 @@ Give an empty topic name to go to the Index node itself."
                  (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 @@ Build a menu of the possible matches."
       (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 @@ If FORK is non-nil, it is passed to `Info-goto-node'."
     (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 @@ the variable `Info-file-list-for-emacs'."
                  (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 @@ BUFFER is the buffer speedbar is requesting buttons for."
 
 (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