(Info-read-node-name-2): New function.

(Info-read-node-name-1): Use that.
Add a completion-base-size-function property.
This commit is contained in:
Richard M. Stallman 2005-06-06 12:47:51 +00:00
parent 9c7f6bb391
commit a89da416f5

View file

@ -1379,6 +1379,43 @@ If FORK is a string, it is the name to use for the new buffer."
(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 @@ If FORK is a string, it is the name to use for the new buffer."
(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 @@ If FORK is a string, it is the name to use for the new buffer."
(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))