comparison lisp/info.el @ 63065:58dcb71db77b

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

63064:7e053d892401

    (Info-find-node (if (equal filename "") nil filename)
		    (if (equal nodename "") "Top" nodename))))

(defvar Info-read-node-completion-table)

;; 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.
(defun Info-read-node-name-1 (string predicate code)
  (cond
   ;; First complete embedded file names.
   ((string-match "\\`([^)]*\\'" string)
    (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)
    (cond
     ((eq code nil) string)

    (try-completion string Info-read-node-completion-table predicate))
   ((eq code t)
    (all-completions string Info-read-node-completion-table predicate))
   (t
    (test-completion string Info-read-node-completion-table predicate))))

(defun Info-read-node-name (prompt &optional default)
  (let* ((completion-ignore-case t)
	 (Info-read-node-completion-table (Info-build-node-completions))
	 (nodename (completing-read prompt 'Info-read-node-name-1 nil t)))

63065:58dcb71db77b

    (Info-find-node (if (equal filename "") nil filename)
		    (if (equal nodename "") "Top" nodename))))

(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.
(defun Info-read-node-name-1 (string predicate code)
  (cond
   ;; First complete embedded file names.
   ((string-match "\\`([^)]*\\'" string)
    (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)
    (cond
     ((eq code nil) string)

    (try-completion string Info-read-node-completion-table predicate))
   ((eq code t)
    (all-completions string Info-read-node-completion-table predicate))
   (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))
	 (nodename (completing-read prompt 'Info-read-node-name-1 nil t)))