(Info-complete-menu-item): New function.

(Info-menu): Use it to speed completion.

1 files changed, 58 insertions, 20 deletions

diff --git a/lisp/info.el b/lisp/info.el
index b12278056a..212ca311b0 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -833,12 +833,56 @@ NAME may be an abbreviation of the reference name."
       (aset str i ?\ ))
     str))
 
-;; No one calls this and Info-menu-item doesn't exist.
+;; No one calls this.
 ;;(defun Info-menu-item-sequence (list)
 ;;  (while list
-;;    (Info-menu-item (car list))
+;;    (Info-menu (car list))
 ;;    (setq list (cdr list))))
 
+(defun Info-complete-menu-item (string predicate action)
+  (let ((case-fold-search t))
+    (cond ((eq action nil)
+	   (let (completions
+		 (pattern (concat "\n\\* \\("
+				  (regexp-quote string)
+				  "[^:\t\n]*\\):")))
+	     (save-excursion
+	       (set-buffer Info-complete-menu-buffer)
+	       (goto-char (point-min))
+	       (while (re-search-forward pattern nil t)
+		 (setq completions (cons (cons (format "%s"
+						       (buffer-substring
+							(match-beginning 1)
+							(match-end 1)))
+					       (match-beginning 1))
+					 completions))))
+	     (try-completion string completions predicate)))
+	  ((eq action t)
+	   (let (completions
+		 (pattern (concat "\n\\* \\("
+				  (regexp-quote string)
+				  "[^:\t\n]*\\):")))
+	     (save-excursion
+	       (set-buffer Info-complete-menu-buffer)
+	       (goto-char (point-min))
+	       (while (re-search-forward pattern nil t)
+		 (setq completions (cons (cons (format "%s"
+						       (buffer-substring
+							(match-beginning 1)
+							(match-end 1)))
+					       (match-beginning 1))
+					 completions))))
+	     (all-completions string completions predicate)))
+	  (t
+	   (save-excursion
+	     (set-buffer Info-complete-menu-buffer)
+	     (goto-char (point-min))
+	     (re-search-forward (concat "\n\\* "
+					(regexp-quote string)
+					":")
+				nil t))))))
+
+
 (defun Info-menu (menu-item)
   "Go to node for menu item named (or abbreviated) NAME.
 Completion is allowed, and the menu item point is on is the default."
@@ -852,30 +896,24 @@ Completion is allowed, and the menu item point is on is the default."
        (goto-char (point-min))
        (if (not (search-forward "\n* menu:" nil t))
 	   (error "No menu in this node"))
-       (while (re-search-forward
-		"\n\\* \\([^:\t\n]*\\):" nil t)
-	 (if (and (null default)
-		  (prog1 (if last (< last p) nil)
-		    (setq last (match-beginning 0)))
-		  (<= p last))
-	     (setq default (car (car completions))))
-	 (setq completions (cons (cons (buffer-substring
-					 (match-beginning 1)
-					 (match-end 1))
-				       (match-beginning 1))
-				 completions)))
-       (if (and (null default) last
-		(< last p)
-		(<= p (progn (end-of-line) (point))))
-	   (setq default (car (car completions)))))
+       (setq beg (point))
+       (and (< (point) p)
+	    (save-excursion
+	      (goto-char p)
+	      (end-of-line)
+	      (re-search-backward "\n\\* \\([^:\t\n]*\\):" beg t)
+	      (setq default (format "%s" (buffer-substring
+					  (match-beginning 1)
+					  (match-end 1)))))))
      (let ((item nil))
        (while (null item)
-	 (setq item (let ((completion-ignore-case t))
+	 (setq item (let ((completion-ignore-case t)
+			  (Info-complete-menu-buffer (current-buffer)))
 		      (completing-read (if default
 					   (format "Menu item (default %s): "
 						   default)
 					   "Menu item: ")
-				       completions nil t)))
+				       'Info-complete-menu-item nil t)))
 	 ;; we rely on the fact that completing-read accepts an input
 	 ;; of "" even when the require-match argument is true and ""
 	 ;; is not a valid possibility