+;; Could be this, if we make symbol-file do the work below.
+;; (defun help-C-file-name (subr-or-var kind)
+;; "Return the name of the C file where SUBR-OR-VAR is defined.
+;; KIND should be `var' for a variable or `subr' for a subroutine."
+;; (symbol-file (if (symbolp subr-or-var) subr-or-var
+;; (subr-name subr-or-var))
+;; (if (eq kind 'var) 'defvar 'defun)))
+;;;###autoload
+(defun help-C-file-name (subr-or-var kind)
+ "Return the name of the C file where SUBR-OR-VAR is defined.
+KIND should be `var' for a variable or `subr' for a subroutine."
+ (let ((docbuf (get-buffer-create " *DOC*"))
+ (name (if (eq 'var kind)
+ (concat "V" (symbol-name subr-or-var))
+ (concat "F" (subr-name subr-or-var)))))
+ (with-current-buffer docbuf
+ (goto-char (point-min))
+ (if (eobp)
+ (insert-file-contents-literally
+ (expand-file-name internal-doc-file-name doc-directory)))
+ (let ((file (catch 'loop
+ (while t
+ (let ((pnt (search-forward (concat "\1f" name "\n"))))
+ (re-search-backward "\1fS\\(.*\\)")
+ (let ((file (match-string 1)))
+ (if (member file build-files)
+ (throw 'loop file)
+ (goto-char pnt))))))))
+ (if (string-match "\\.\\(o\\|obj\\)\\'" file)
+ (setq file (replace-match ".c" t t file)))
+ (if (string-match "\\.c\\'" file)
+ (concat "src/" file)
+ file)))))
+
+;;;###autoload
+(defface help-argument-name '((((supports :slant italic)) :inherit italic))
+ "Face to highlight argument names in *Help* buffers."
+ :group 'help)
+
+(defun help-default-arg-highlight (arg)
+ "Default function to highlight arguments in *Help* buffers.
+It returns ARG in face `help-argument-name'; ARG is also
+downcased if it displays differently than the default
+face (according to `face-differs-from-default-p')."
+ (propertize (if (face-differs-from-default-p 'help-argument-name)
+ (downcase arg)
+ arg)
+ 'face 'help-argument-name))
+
+(defun help-do-arg-highlight (doc args)
+ (with-syntax-table (make-syntax-table emacs-lisp-mode-syntax-table)
+ (modify-syntax-entry ?\- "w")
+ (while args
+ (let ((arg (prog1 (car args) (setq args (cdr args)))))
+ (setq doc (replace-regexp-in-string
+ ;; This is heuristic, but covers all common cases
+ ;; except ARG1-ARG2
+ (concat "\\<" ; beginning of word
+ "\\(?:[a-z-]*-\\)?" ; for xxx-ARG
+ "\\("
+ (regexp-quote arg)
+ "\\)"
+ "\\(?:es\\|s\\|th\\)?" ; for ARGth, ARGs
+ "\\(?:-[a-z-]+\\)?" ; for ARG-xxx
+ "\\>") ; end of word
+ (help-default-arg-highlight arg)
+ doc t t 1))))
+ doc))
+
+(defun help-highlight-arguments (usage doc &rest args)
+ (when usage
+ (with-temp-buffer
+ (insert usage)
+ (goto-char (point-min))
+ (let ((case-fold-search nil)
+ (next (not (or args (looking-at "\\["))))
+ (opt nil))
+ ;; Make a list of all arguments
+ (skip-chars-forward "^ ")
+ (while next
+ (or opt (not (looking-at " &")) (setq opt t))
+ (if (not (re-search-forward " \\([\\[(]*\\)\\([^] &)\.]+\\)" nil t))
+ (setq next nil)
+ (setq args (cons (match-string 2) args))
+ (when (and opt (string= (match-string 1) "("))
+ ;; A pesky CL-style optional argument with default value,
+ ;; so let's skip over it
+ (search-backward "(")
+ (goto-char (scan-sexps (point) 1)))))
+ ;; Highlight aguments in the USAGE string
+ (setq usage (help-do-arg-highlight (buffer-string) args))
+ ;; Highlight arguments in the DOC string
+ (setq doc (and doc (help-do-arg-highlight doc args))))))
+ ;; Return value is like the one from help-split-fundoc, but highlighted
+ (cons usage doc))
+