+(defvar Man-completion-cache nil
+ ;; On my machine, "man -k" is so fast that a cache makes no sense,
+ ;; but apparently that's not the case in all cases, so let's add a cache.
+ "Cache of completion table of the form (PREFIX . TABLE).")
+
+(defun Man-completion-table (string pred action)
+ (cond
+ ((eq action 'lambda)
+ (not (string-match "([^)]*\\'" string)))
+ ((equal string "-k")
+ ;; Let SPC (minibuffer-complete-word) insert the space.
+ (complete-with-action action '("-k ") string pred))
+ (t
+ (let ((table (cdr Man-completion-cache))
+ (section nil)
+ (prefix string))
+ (when (string-match "\\`\\([[:digit:]].*?\\) " string)
+ (setq section (match-string 1 string))
+ (setq prefix (substring string (match-end 0))))
+ (unless (and Man-completion-cache
+ (string-prefix-p (car Man-completion-cache) prefix))
+ (with-temp-buffer
+ (setq default-directory "/") ;; in case inherited doesn't exist
+ ;; Actually for my `man' the arg is a regexp.
+ ;; POSIX says it must be ERE and "man-db" seems to agree,
+ ;; whereas under MacOSX it seems to be BRE-style and doesn't
+ ;; accept backslashes at all. Let's not bother to
+ ;; quote anything.
+ (let ((process-environment (copy-sequence process-environment)))
+ (setenv "COLUMNS" "999") ;; don't truncate long names
+ ;; manual-program might not even exist. And since it's
+ ;; run differently in Man-getpage-in-background, an error
+ ;; here may not necessarily mean that we'll also get an
+ ;; error later.
+ (ignore-errors
+ (call-process manual-program nil '(t nil) nil
+ "-k" (concat "^" prefix))))
+ (goto-char (point-min))
+ (while (re-search-forward "^\\([^ \t\n]+\\)\\(?: ?\\((.+?)\\)\\(?:[ \t]+- \\(.*\\)\\)?\\)?" nil t)
+ (push (propertize (concat (match-string 1) (match-string 2))
+ 'help-echo (match-string 3))
+ table)))
+ ;; Cache the table for later reuse.
+ (setq Man-completion-cache (cons prefix table)))
+ ;; The table may contain false positives since the match is made
+ ;; by "man -k" not just on the manpage's name.
+ (if section
+ (let ((re (concat "(" (regexp-quote section) ")\\'")))
+ (dolist (comp (prog1 table (setq table nil)))
+ (if (string-match re comp)
+ (push (substring comp 0 (match-beginning 0)) table)))
+ (completion-table-with-context (concat section " ") table
+ prefix pred action))
+ ;; If the current text looks like a possible section name,
+ ;; then add a completion entry that just adds a space so SPC
+ ;; can be used to insert a space.
+ (if (string-match "\\`[[:digit:]]" string)
+ (push (concat string " ") table))
+ (let ((res (complete-with-action action table string pred)))
+ ;; In case we're completing to a single name that exists in
+ ;; several sections, the longest prefix will look like "foo(".
+ (if (and (stringp res)
+ (string-match "([^(]*\\'" res)
+ ;; In case the paren was already in `prefix', don't
+ ;; remove it.
+ (> (match-beginning 0) (length prefix)))
+ (substring res 0 (match-beginning 0))
+ res)))))))