changeset 63065:58dcb71db77b

(Info-read-node-name-2): New function. (Info-read-node-name-1): Use that. Add a completion-base-size-function property.

--- a/lisp/info.el	Mon Jun 06 12:47:19 2005 +0000
+++ b/lisp/info.el	Mon Jun 06 12:47:51 2005 +0000
@@ -1379,6 +1379,43 @@
 
 (defvar Info-read-node-completion-table)
 
+(defun Info-read-node-name-2 (string path-and-suffixes action)
+  "Virtual completion table for file names input in Info node names.
+PATH-AND-SUFFIXES is a pair of lists, (DIRECTORIES . SUFFIXES)."
+  (let* ((names nil)
+	 (suffixes (remove "" (cdr path-and-suffixes)))
+	 (suffix (concat (regexp-opt suffixes t) "\\'"))
+	 (string-dir (file-name-directory string))
+	 (dirs
+	  (if (file-name-absolute-p string)
+	      (list (file-name-directory string))
+	    (car path-and-suffixes))))
+    (dolist (dir dirs)
+      (unless dir
+	(setq dir default-directory))
+      (if string-dir (setq dir (expand-file-name string-dir dir)))
+      (when (file-directory-p dir)
+	(dolist (file (file-name-all-completions
+		       (file-name-nondirectory string) dir))
+	  ;; If the file name has no suffix or a standard suffix,
+	  ;; include it.
+	  (and (or (null (file-name-extension file))
+		   (string-match suffix file))
+	       ;; But exclude subfiles of split info files.
+	       (not (string-match "-[0-9]+\\'" file))
+	       ;; And exclude backup files.
+	       (not (string-match "~\\'" file))
+	       (push (if string-dir (concat string-dir file) file) names))
+	  ;; If the file name ends in a standard suffix,
+	  ;; add the unsuffixed name as a completion option.
+	  (when (string-match suffix file)
+	    (setq file (substring file 0 (match-beginning 0)))
+	    (push (if string-dir (concat string-dir file) file) names)))))
+    (cond
+     ((eq action t) (all-completions string names))
+     ((null action) (try-completion string names))
+     (t (test-completion string names)))))
+
 ;; This function is used as the "completion table" while reading a node name.
 ;; It does completion using the alist in Info-read-node-completion-table
 ;; unless STRING starts with an open-paren.
@@ -1389,15 +1426,16 @@
     (let ((file (substring string 1)))
       (cond
        ((eq code nil)
-	(let ((comp (try-completion file 'locate-file-completion
+	(let ((comp (try-completion file 'Info-read-node-name-2
 				    (cons Info-directory-list
 					  (mapcar 'car Info-suffix-list)))))
 	  (cond
 	   ((eq comp t) (concat string ")"))
 	   (comp (concat "(" comp)))))
-       ((eq code t) (all-completions file 'locate-file-completion
-				     (cons Info-directory-list
-					   (mapcar 'car Info-suffix-list))))
+       ((eq code t)
+	(all-completions file 'Info-read-node-name-2
+			 (cons Info-directory-list
+			       (mapcar 'car Info-suffix-list))))
        (t nil))))
    ;; If a file name was given, then any node is fair game.
    ((string-match "\\`(" string)
@@ -1413,6 +1451,10 @@
    (t
     (test-completion string Info-read-node-completion-table predicate))))
 
+;; Arrange to highlight the proper letters in the completion list buffer.
+(put 'Info-read-node-name-1 'completion-base-size-function
+     (lambda () 1))
+
 (defun Info-read-node-name (prompt &optional default)
   (let* ((completion-ignore-case t)
 	 (Info-read-node-completion-table (Info-build-node-completions))