mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2025-02-05 20:43:08 +00:00
Code Issues Releases Activity

(help-C-file-name): Use new subr-name.

Browse Source 
Prepend `src/' to the file name.
(help-C-source-directory, help-subr-name, help-find-C-source): Remove.
(describe-function-1, describe-variable): Only find a C source file name
if DOC is already loaded.
This commit is contained in:
Stefan Monnier 2004-04-29 18:46:13 +00:00
parent 2ea0f8fde5
commit 3ff0a7e940
1 changed files with 14 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

60
lisp/help-fns.el
View File

@ -216,27 +216,13 @@ ARGLIST can also be t or a string of the form \"(fun ARG1 ARG2 ...)\"."
(intern (upcase name))))))
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)))))
(concat "F" (subr-name subr-or-var)))))
(with-current-buffer docbuf
(goto-char (point-min))
(if (eobp)
@ -246,31 +232,11 @@ KIND should be `var' for a variable or `subr' for a subroutine."
(re-search-backward "S\\(.*\\)")
(let ((file (match-string 1)))
(if (string-match "\\.\\(o\\|obj\\)\\'" file)
(replace-match ".c" t t file)
(setq file (replace-match ".c" t t file)))
(if (string-match "\\.c\\'" file)
(concat "src/" 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
(defun describe-function-1 (function)
(let* ((def (if (symbolp function)
@ -336,14 +302,16 @@ KIND should be `var' for a variable or `subr' for a subroutine."
(when (re-search-backward
"^;;; Generated autoloads from \\(.*\\)" nil t)
(setq file-name (match-string 1)))))))
(when (and (null file-name) (subrp def) help-C-source-directory)
(when (and (null file-name) (subrp def))
;; Find the C source file name.
(setq file-name (concat "src/" (help-C-file-name def 'subr))))
(setq file-name (if (get-buffer " *DOC*")
(help-C-file-name def 'subr)
'C-source)))
(when file-name
(princ " in `")
;; We used to add .el to the file name,
;; but that's completely wrong when the user used load-file.
(princ file-name)
(princ (if (eq file-name 'C-source) "C source code" file-name))
(princ "'")
;; Make a hyperlink to the library.
(with-current-buffer standard-output
@ -576,13 +544,13 @@ it is displayed along with the global value."
(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.")))
(setq file-name
(if (get-buffer " *DOC*")
(help-C-file-name variable 'var)
'C-source)))
(when file-name
(princ "\n\nDefined in `")
(princ file-name)
(princ (if (eq file-name 'C-source) "C source code" file-name))
(princ "'.")
(with-current-buffer standard-output
(save-excursion