mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-12-26 10:49:33 +00:00
(help-C-source-directory): New var.
(help-subr-name, help-C-file-name, help-find-C-source): New funs. (describe-function-1, describe-variable): Use them.
This commit is contained in:
parent
0728ab1196
commit
154ee9b737
@ -1,6 +1,6 @@
|
|||||||
;;; help-fns.el --- Complex help functions
|
;;; help-fns.el --- Complex help functions
|
||||||
|
|
||||||
;; Copyright (C) 1985, 1986, 1993, 1994, 1998, 1999, 2000, 2001, 2002, 2003
|
;; Copyright (C) 1985, 86, 93, 94, 98, 1999, 2000, 01, 02, 03, 2004
|
||||||
;; Free Software Foundation, Inc.
|
;; Free Software Foundation, Inc.
|
||||||
|
|
||||||
;; Maintainer: FSF
|
;; Maintainer: FSF
|
||||||
@ -215,6 +215,61 @@ ARGLIST can also be t or a string of the form \"(fun ARG1 ARG2 ...)\"."
|
|||||||
(intern (upcase name))))))
|
(intern (upcase name))))))
|
||||||
arglist)))
|
arglist)))
|
||||||
|
|
||||||
|
(defvar help-C-source-directory
|
||||||
|
(let ((dir (expand-file-name "src" source-directory)))
|
||||||
|
(when (and (file-directory-p dir) (file-readable-p dir))
|
||||||
|
dir))
|
||||||
|
"Directory where the C source files of Emacs can be found.
|
||||||
|
If nil, do not try to find the source code of functions and variables
|
||||||
|
defined in C.")
|
||||||
|
|
||||||
|
(defun help-subr-name (subr)
|
||||||
|
(let ((name (prin1-to-string subr)))
|
||||||
|
(if (string-match "\\`#<subr \\(.*\\)>\\'" name)
|
||||||
|
(match-string 1 name)
|
||||||
|
(error "Unexpected subroutine print name: %s" name))))
|
||||||
|
|
||||||
|
(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" (help-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)))
|
||||||
|
(search-forward (concat "" name "\n"))
|
||||||
|
(re-search-backward "S\\(.*\\)")
|
||||||
|
(let ((file (match-string 1)))
|
||||||
|
(if (string-match "\\.\\(o\\|obj\\)\\'" file)
|
||||||
|
(replace-match ".c" t t file)
|
||||||
|
file)))))
|
||||||
|
|
||||||
|
(defun help-find-C-source (fun-or-var file kind)
|
||||||
|
"Find the source location where SUBR-OR-VAR is defined in FILE.
|
||||||
|
KIND should be `var' for a variable or `subr' for a subroutine."
|
||||||
|
(setq file (expand-file-name file help-C-source-directory))
|
||||||
|
(unless (file-readable-p file)
|
||||||
|
(error "The C source file %s is not available"
|
||||||
|
(file-name-nondirectory file)))
|
||||||
|
(if (eq 'fun kind)
|
||||||
|
(setq fun-or-var (indirect-function fun-or-var)))
|
||||||
|
(with-current-buffer (find-file-noselect file)
|
||||||
|
(goto-char (point-min))
|
||||||
|
(unless (re-search-forward
|
||||||
|
(if (eq 'fun kind)
|
||||||
|
(concat "DEFUN[ \t\n]*([ \t\n]*\""
|
||||||
|
(regexp-quote (help-subr-name fun-or-var))
|
||||||
|
"\"")
|
||||||
|
(concat "DEFVAR[A-Z_]*[ \t\n]*([ \t\n]*\""
|
||||||
|
(regexp-quote (symbol-name fun-or-var))))
|
||||||
|
nil t)
|
||||||
|
(error "Can't find source for %s" fun))
|
||||||
|
(cons (current-buffer) (match-beginning 0))))
|
||||||
|
|
||||||
;;;###autoload
|
;;;###autoload
|
||||||
(defun describe-function-1 (function)
|
(defun describe-function-1 (function)
|
||||||
(let* ((def (if (symbolp function)
|
(let* ((def (if (symbolp function)
|
||||||
@ -280,8 +335,10 @@ ARGLIST can also be t or a string of the form \"(fun ARG1 ARG2 ...)\"."
|
|||||||
(when (re-search-backward
|
(when (re-search-backward
|
||||||
"^;;; Generated autoloads from \\(.*\\)" nil t)
|
"^;;; Generated autoloads from \\(.*\\)" nil t)
|
||||||
(setq file-name (match-string 1)))))))
|
(setq file-name (match-string 1)))))))
|
||||||
(cond
|
(when (and (null file-name) (subrp def) help-C-source-directory)
|
||||||
(file-name
|
;; Find the C source file name.
|
||||||
|
(setq file-name (concat "src/" (help-C-file-name def 'subr))))
|
||||||
|
(when file-name
|
||||||
(princ " in `")
|
(princ " in `")
|
||||||
;; We used to add .el to the file name,
|
;; We used to add .el to the file name,
|
||||||
;; but that's completely wrong when the user used load-file.
|
;; but that's completely wrong when the user used load-file.
|
||||||
@ -289,9 +346,9 @@ ARGLIST can also be t or a string of the form \"(fun ARG1 ARG2 ...)\"."
|
|||||||
(princ "'")
|
(princ "'")
|
||||||
;; Make a hyperlink to the library.
|
;; Make a hyperlink to the library.
|
||||||
(with-current-buffer standard-output
|
(with-current-buffer standard-output
|
||||||
(save-excursion
|
(save-excursion
|
||||||
(re-search-backward "`\\([^`']+\\)'" nil t)
|
(re-search-backward "`\\([^`']+\\)'" nil t)
|
||||||
(help-xref-button 1 'help-function-def function file-name)))))
|
(help-xref-button 1 'help-function-def function file-name))))
|
||||||
(princ ".")
|
(princ ".")
|
||||||
(terpri)
|
(terpri)
|
||||||
(when (commandp function)
|
(when (commandp function)
|
||||||
@ -500,6 +557,13 @@ it is displayed along with the global value."
|
|||||||
(when (re-search-backward
|
(when (re-search-backward
|
||||||
"^;;; Generated autoloads from \\(.*\\)" nil t)
|
"^;;; Generated autoloads from \\(.*\\)" nil t)
|
||||||
(setq file-name (match-string 1)))))))
|
(setq file-name (match-string 1)))))))
|
||||||
|
(when (and (null file-name)
|
||||||
|
(integerp (get variable 'variable-documentation)))
|
||||||
|
;; It's a variable not defined in Elisp but in C.
|
||||||
|
(if help-C-source-directory
|
||||||
|
(setq file-name
|
||||||
|
(concat "src/" (help-C-file-name variable 'var)))
|
||||||
|
(princ "\n\nDefined in core C code.")))
|
||||||
(when file-name
|
(when file-name
|
||||||
(princ "\n\nDefined in `")
|
(princ "\n\nDefined in `")
|
||||||
(princ file-name)
|
(princ file-name)
|
||||||
|
Loading…
Reference in New Issue
Block a user