[Emacs-diffs] Changes to emacs/lisp/info.el

[Richard M . Stallman]

Index: emacs/lisp/info.el
diff -c emacs/lisp/info.el:1.429 emacs/lisp/info.el:1.430
*** emacs/lisp/info.el:1.429    Mon Jun  6 12:26:07 2005
--- emacs/lisp/info.el  Mon Jun  6 12:47:51 2005
***************
*** 1379,1384 ****
--- 1379,1421 ----
  
  (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,1403 ****
      (let ((file (substring string 1)))
        (cond
         ((eq code nil)
!       (let ((comp (try-completion file 'locate-file-completion
                                    (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))))
         (t nil))))
     ;; If a file name was given, then any node is fair game.
     ((string-match "\\`(" string)
--- 1426,1441 ----
      (let ((file (substring string 1)))
        (cond
         ((eq code nil)
!       (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 '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,1418 ****
--- 1451,1460 ----
     (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))