X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/e1acbda2a65ff78c0e13e706aa20ee3e91c1d9a5..0111ab41ec5239b1d7d0aed44dac798ebaa963e5:/lisp/emacs-lisp/find-func.el diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el index dbe6b6a672..54efd14b35 100644 --- a/lisp/emacs-lisp/find-func.el +++ b/lisp/emacs-lisp/find-func.el @@ -1,6 +1,6 @@ ;;; find-func.el --- find the definition of the Emacs Lisp function near point -;; Copyright (C) 1997 Free Software Foundation, Inc. +;; Copyright (C) 1997, 1999, 2001, 2004 Free Software Foundation, Inc. ;; Author: Jens Petersen ;; Maintainer: petersen@kurims.kyoto-u.ac.jp @@ -43,7 +43,7 @@ ;; ("help.el") and `fff-find-loaded-emacs-lisp-function' (Noah Friedman's ;; "fff.el"). -;;;; Code: +;;; Code: (require 'loadhist) @@ -54,33 +54,42 @@ ;; :prefix "find-function" :group 'lisp) +(defconst find-function-space-re "\\(?:\\s-\\|\n\\|;.*\n\\)+") + (defcustom find-function-regexp - "^\\s-*(def[^cgv\W]\\w+\\*?\\s-+%s\\(\\s-\\|$\\)" -"The regexp used by `find-function' to search for a function -definition. Note it must contain a `%s' at the place where `format' + ;; Match things like (defun foo ...), (defmacro foo ...), + ;; (define-skeleton foo ...), (define-generic-mode 'foo ...), + ;; (define-derived-mode foo ...), (define-minor-mode foo) + (concat + "^\\s-*(\\(def\\(ine-skeleton\\|ine-generic-mode\\|ine-derived-mode\\|\ +\[^cgv\W]\\w+\\*?\\)\\|define-minor-mode\ +\\|easy-mmode-define-global-mode\\)" find-function-space-re + "\\('\\|\(quote \\)?%s\\(\\s-\\|$\\|\(\\|\)\\)") + "The regexp used by `find-function' to search for a function definition. +Note it must contain a `%s' at the place where `format' should insert the function name. The default value avoids `defconst', `defgroup', `defvar'. Please send improvements and fixes to the maintainer." :type 'regexp :group 'find-function - :version "20.3") + :version "21.1") (defcustom find-variable-regexp - "^\\s-*(def[^uma\W]\\w+\\*?\\s-+%s\\(\\s-\\|$\\)" + (concat"^\\s-*(def[^umag]\\(\\w\\|\\s_\\)+\\*?" find-function-space-re "%s\\(\\s-\\|$\\)") "The regexp used by `find-variable' to search for a variable definition. It should match right up to the variable name. The default value -avoids `defun', `defmacro', `defalias', `defadvice'. +avoids `defun', `defmacro', `defalias', `defadvice', `defgroup'. Please send improvements and fixes to the maintainer." :type 'regexp :group 'find-function - :version "20.3") + :version "21.1") (defcustom find-function-source-path nil - "The default list of directories where find-function searches. + "The default list of directories where `find-function' searches. -If this variable is `nil' then find-function searches `load-path' by +If this variable is nil then `find-function' searches `load-path' by default." :type '(repeat directory) :group 'find-function) @@ -88,8 +97,9 @@ default." (defcustom find-function-recenter-line 1 "The window line-number from which to start displaying a symbol definition. A value of nil implies center the beginning of the definition. -See the function `center-to-window-line' for more information, and -`find-function' and `find-variable'." +See `find-function' and `find-variable'." + :type '(choice (const :tag "Center" nil) + integer) :group 'find-function :version "20.3") @@ -102,62 +112,114 @@ See the functions `find-function' and `find-variable'." ;;; Functions: +(defun find-library-suffixes () + (let ((suffixes nil)) + (dolist (suffix load-suffixes (nreverse suffixes)) + (unless (string-match "elc" suffix) (push suffix suffixes))))) + +(defun find-library-name (library) + "Return the full name of the elisp source of LIBRARY." + ;; If the library is byte-compiled, try to find a source library by + ;; the same name. + (if (string-match "\\.el\\(c\\(\\..*\\)?\\)\\'" library) + (setq library (replace-match "" t t library))) + (or (locate-file library + (or find-function-source-path load-path) + (append (find-library-suffixes) '(""))) + (error "Can't find library %s" library))) + +(defvar find-function-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 find-function-C-source (fun-or-var file variable-p) + "Find the source location where SUBR-OR-VAR is defined in FILE. +VARIABLE-P should be non-nil for a variable or nil for a subroutine." + (unless find-function-C-source-directory + (setq find-function-C-source-directory + (read-directory-name "Emacs C source dir: " nil nil t))) + (setq file (expand-file-name file find-function-C-source-directory)) + (unless (file-readable-p file) + (error "The C source file %s is not available" + (file-name-nondirectory file))) + (unless variable-p + (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 variable-p + (concat "DEFVAR[A-Z_]*[ \t\n]*([ \t\n]*\"" + (regexp-quote (symbol-name fun-or-var)) + "\"") + (concat "DEFUN[ \t\n]*([ \t\n]*\"" + (regexp-quote (subr-name fun-or-var)) + "\"")) + nil t) + (error "Can't find source for %s" fun-or-var)) + (cons (current-buffer) (match-beginning 0)))) + +;;;###autoload +(defun find-library (library) + "Find the elisp source of LIBRARY." + (interactive + (list + (completing-read "Library name: " + 'locate-file-completion + (cons (or find-function-source-path load-path) + (find-library-suffixes))))) + (let ((buf (find-file-noselect (find-library-name library)))) + (condition-case nil (switch-to-buffer buf) (error (pop-to-buffer buf))))) + +;;;###autoload (defun find-function-search-for-symbol (symbol variable-p library) - "Search for SYMBOL in LIBRARY. + "Search for SYMBOL. If VARIABLE-P is nil, `find-function-regexp' is used, otherwise -`find-variable-regexp' is used." +`find-variable-regexp' is used. The search is done in library LIBRARY." (if (null library) (error "Don't know where `%s' is defined" symbol)) - (if (string-match "\\.el\\(c\\)\\'" library) - (setq library (substring library 0 (match-beginning 1)))) - (let* ((path find-function-source-path) - (compression (or (rassq 'jka-compr-handler file-name-handler-alist) - (member 'crypt-find-file-hook find-file-hooks))) - (filename (if (and (file-exists-p library) - (not (file-directory-p library))) - library - ;; use `file-name-sans-extension' here? (if it gets fixed) - (if (string-match "\\(\\.el\\)\\'" library) - (setq library (substring library 0 - (match-beginning 1)))) - (or (locate-library (concat library ".el") t path) - (locate-library library t path) - (if compression - (or (locate-library (concat library ".el.gz") - t path) - (locate-library (concat library ".gz") - t path))))))) - (if (not filename) - (error "The library `%s' is not in the path" library)) - (with-current-buffer (find-file-noselect filename) - (save-match-data + ;; Some functions are defined as part of the construct + ;; that defines something else. + (while (and (symbolp symbol) (get symbol 'definition-name)) + (setq symbol (get symbol 'definition-name))) + (if (string-match "\\`src/\\(.*\\.c\\)\\'" library) + (find-function-C-source symbol (match-string 1 library) variable-p) + (if (string-match "\\.el\\(c\\)\\'" library) + (setq library (substring library 0 (match-beginning 1)))) + (let* ((filename (find-library-name library))) + (with-current-buffer (find-file-noselect filename) (let ((regexp (format (if variable-p find-variable-regexp find-function-regexp) (regexp-quote (symbol-name symbol)))) - (syn-table (syntax-table))) - (unwind-protect - (progn - (set-syntax-table emacs-lisp-mode-syntax-table) - (goto-char (point-min)) - (if (re-search-forward regexp nil t) - (progn - (beginning-of-line) - (cons (current-buffer) (point))) - (error "Cannot find definition of `%s' in library `%s'" - symbol library))) - (set-syntax-table syn-table))))))) + (case-fold-search)) + (with-syntax-table emacs-lisp-mode-syntax-table + (goto-char (point-min)) + (if (or (re-search-forward regexp nil t) + (re-search-forward + (concat "^([^ ]+" find-function-space-re "['(]" + (regexp-quote (symbol-name symbol)) + "\\>") + nil t)) + (progn + (beginning-of-line) + (cons (current-buffer) (point))) + (error "Cannot find definition of `%s' in library `%s'" + symbol library)))))))) ;;;###autoload (defun find-function-noselect (function) - "Returns a pair (BUFFER . POINT) pointing to the definition of FUNCTION. + "Return a pair (BUFFER . POINT) pointing to the definition of FUNCTION. Finds the Emacs Lisp library containing the definition of FUNCTION in a buffer and the point of the definition. The buffer is not selected. If the file where FUNCTION is defined is not known, then it is -searched for in `find-function-source-path' if non `nil', otherwise +searched for in `find-function-source-path' if non nil, otherwise in `load-path'." (if (not function) (error "You didn't specify a function")) @@ -183,37 +245,13 @@ in `load-path'." ((symbol-file function))))) (find-function-search-for-symbol function nil library)))) -(defun function-at-point () - (or (condition-case () - (let ((stab (syntax-table))) - (unwind-protect - (save-excursion - (set-syntax-table emacs-lisp-mode-syntax-table) - (or (not (zerop (skip-syntax-backward "_w"))) - (eq (char-syntax (char-after (point))) ?w) - (eq (char-syntax (char-after (point))) ?_) - (forward-sexp -1)) - (skip-chars-forward "`'") - (let ((obj (read (current-buffer)))) - (and (symbolp obj) (fboundp obj) obj))) - (set-syntax-table stab))) - (error nil)) - (condition-case () - (save-excursion - (save-restriction - (narrow-to-region (max (point-min) (- (point) 1000)) (point-max)) - (backward-up-list 1) - (forward-char 1) - (let (obj) - (setq obj (read (current-buffer))) - (and (symbolp obj) (fboundp obj) obj)))) - (error nil)))) +(defalias 'function-at-point 'function-called-at-point) (defun find-function-read (&optional variable-p) "Read and return an interned symbol, defaulting to the one near point. If the optional VARIABLE-P is nil, then a function is gotten -defaulting to the value of the function `function-at-point', otherwise +defaulting to the value of the function `function-at-point', otherwise a variable is asked for, with the default coming from `variable-at-point'." (let ((symb (funcall (if variable-p @@ -241,11 +279,11 @@ a variable is asked for, with the default coming from (intern val))))) (defun find-function-do-it (symbol variable-p switch-fn) - "Find Emacs Lisp SYMBOL in a buffer and display it with SWITCH-FN. -If VARIABLE-P is nil, a function definition is searched for, otherwise + "Find Emacs Lisp SYMBOL in a buffer and display it. +If VARIABLE-P is nil, a function definition is searched for, otherwise a variable definition is searched for. The start of a definition is centered according to the variable `find-function-recenter-line'. -See also `find-function-after-hook'. +See also `find-function-after-hook' It is displayed with function SWITCH-FN. Point is saved in the buffer if it is one of the current buffers." (let* ((orig-point (point)) @@ -264,11 +302,11 @@ Point is saved in the buffer if it is one of the current buffers." (funcall switch-fn new-buf) (goto-char new-point) (recenter find-function-recenter-line) - (run-hooks find-function-after-hook)))) + (run-hooks 'find-function-after-hook)))) ;;;###autoload (defun find-function (function) - "Find the definition of the function near point in the current window. + "Find the definition of the FUNCTION near point. Finds the Emacs Lisp library containing the definition of the function near point (selected by `function-at-point') in a buffer and @@ -276,14 +314,14 @@ places point before the definition. Point is saved in the buffer if it is one of the current buffers. The library where FUNCTION is defined is searched for in -`find-function-source-path', if non `nil', otherwise in `load-path'. +`find-function-source-path', if non nil, otherwise in `load-path'. See also `find-function-recenter-line' and `find-function-after-hook'." (interactive (find-function-read)) (find-function-do-it function nil 'switch-to-buffer)) ;;;###autoload (defun find-function-other-window (function) - "Find the definition of the function near point in the other window. + "Find, in another window, the definition of FUNCTION near point. See `find-function' for more details." (interactive (find-function-read)) @@ -291,30 +329,31 @@ See `find-function' for more details." ;;;###autoload (defun find-function-other-frame (function) - "Find the definition of the function near point in the another frame. + "Find, in ananother frame, the definition of FUNCTION near point. See `find-function' for more details." (interactive (find-function-read)) (find-function-do-it function nil 'switch-to-buffer-other-frame)) ;;;###autoload -(defun find-variable-noselect (variable) - "Returns a pair `(buffer . point)' pointing to the definition of SYMBOL. +(defun find-variable-noselect (variable &optional file) + "Return a pair `(BUFFER . POINT)' pointing to the definition of SYMBOL. Finds the Emacs Lisp library containing the definition of SYMBOL in a buffer and the point of the definition. The buffer is not selected. -The library where VARIABLE is defined is searched for in -`find-function-source-path', if non `nil', otherwise in `load-path'." +The library where VARIABLE is defined is searched for in FILE or +`find-function-source-path', if non nil, otherwise in `load-path'." (if (not variable) (error "You didn't specify a variable")) - (let ((library (symbol-file variable))) + ;; Fixme: I think `symbol-file' should be fixed instead. -- fx + (let ((library (or file (symbol-file (cons 'defvar variable))))) (find-function-search-for-symbol variable 'variable library))) ;;;###autoload (defun find-variable (variable) - "Find the definition of the variable near point in the current window. + "Find the definition of the VARIABLE near point. Finds the Emacs Lisp library containing the definition of the variable near point (selected by `variable-at-point') in a buffer and @@ -322,14 +361,14 @@ places point before the definition. Point is saved in the buffer if it is one of the current buffers. The library where VARIABLE is defined is searched for in -`find-function-source-path', if non `nil', otherwise in `load-path'. +`find-function-source-path', if non nil, otherwise in `load-path'. See also `find-function-recenter-line' and `find-function-after-hook'." (interactive (find-function-read 'variable)) (find-function-do-it variable t 'switch-to-buffer)) ;;;###autoload (defun find-variable-other-window (variable) - "Find the definition of the variable near point in the other window. + "Find, in another window, the definition of VARIABLE near point. See `find-variable' for more details." (interactive (find-function-read 'variable)) @@ -337,7 +376,7 @@ See `find-variable' for more details." ;;;###autoload (defun find-variable-other-frame (variable) - "Find the definition of the variable near point in the another frame. + "Find, in annother frame, the definition of VARIABLE near point. See `find-variable' for more details." (interactive (find-function-read 'variable)) @@ -348,13 +387,27 @@ See `find-variable' for more details." "Find the function that KEY invokes. KEY is a string. Point is saved if FUNCTION is in the current buffer." (interactive "kFind function on key: ") - (let ((defn (key-binding key)) - (key-desc (key-description key))) - (if (or (null defn) (integerp defn)) - (message "%s is unbound" key-desc) - (if (consp defn) - (message "%s runs %s" key-desc (prin1-to-string defn)) - (find-function-other-window defn))))) + (let (defn) + (save-excursion + (let* ((event (and (eventp key) (aref key 0))) ; Null event OK below. + (start (event-start event)) + (modifiers (event-modifiers event)) + (window (and (or (memq 'click modifiers) (memq 'down modifiers) + (memq 'drag modifiers)) + (posn-window start)))) + ;; For a mouse button event, go to the button it applies to + ;; to get the right key bindings. And go to the right place + ;; in case the keymap depends on where you clicked. + (when (windowp window) + (set-buffer (window-buffer window)) + (goto-char (posn-point start))) + (setq defn (key-binding key)))) + (let ((key-desc (key-description key))) + (if (or (null defn) (integerp defn)) + (message "%s is unbound" key-desc) + (if (consp defn) + (message "%s runs %s" key-desc (prin1-to-string defn)) + (find-function-other-window defn)))))) ;;;###autoload (defun find-function-at-point () @@ -385,4 +438,5 @@ Point is saved if FUNCTION is in the current buffer." (provide 'find-func) +;;; arch-tag: 43ecd81c-74dc-4d9a-8f63-a61e55670d64 ;;; find-func.el ends here