>From ecac500ac7dee3095863df23c4cd661ba62e2187 Mon Sep 17 00:00:00 2001 From: Jorgen Schaefer Date: Mon, 17 Nov 2014 20:43:57 +0100 Subject: [PATCH] * lisp/progmodes/find-definition.el: New file. * test/automated/find-definition-test.el: New file. --- lisp/ChangeLog | 4 + lisp/progmodes/find-definition.el | 194 +++++++++++++++++++++++++++++ test/ChangeLog | 4 + test/automated/find-definition-test.el | 208 ++++++++++++++++++++++++++++++++ 4 files changed, 410 insertions(+) create mode 100644 lisp/progmodes/find-definition.el create mode 100644 test/automated/find-definition-test.el diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 912b69a..0334bb4 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,7 @@ +2014-11-17 Jorgen Schaefer + + * progmodes/find-definition.el: New file. + 2014-11-17 Lars Magne Ingebrigtsen * bindings.el (search-map): Move `eww-search-words' to `M-s M-w'. diff --git a/lisp/progmodes/find-definition.el b/lisp/progmodes/find-definition.el new file mode 100644 index 0000000..d9846e7 --- /dev/null +++ b/lisp/progmodes/find-definition.el @@ -0,0 +1,194 @@ +;;; find-definition.el --- Find definition at point -*- lexical-binding: t -*- + +;; Copyright (C) 2014 Free Software Foundation, Inc. + +;; Author: Jorgen Schaefer +;; Keywords: tools + +;; This file is part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 3 +;; of the License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;;; Code: + +(require 'ring) + +(defgroup find-definition nil "Finding definitions of things at point." + :group 'tools) + +(defcustom find-definition-marker-ring-length 16 + "Length of marker rings `find-definition-marker-ring'." + :group 'find-definition + :type 'integer) + +(defvar find-definition-function nil + "The function `find-definition' calls to find the definition. + +Will be called with no arguments with point at the location of +the thing to find the definition for. It should return a list +with each element being a list of one to three elements. The +first element should be the file name, the second the +line (defaulting to 1) and the third the column (defaulting to +0).") + +(defvar find-definition-identifier-function nil + "Find the definition of a named identifier. + +Will be called with the result of prompting the user for a +completion using `find-definition-completion-table', and should +return a list like `find-definition-function'.") + +(defvar find-definition-identifier-completion-table nil + "The completion table to complete known symbols. + +Will be passed as COLLECTION to `completing-read'.") + +(defvar find-definition-marker-ring + (make-ring find-definition-marker-ring-length) + "Ring of positions visited by `find-definition'.") + +(defvar find-definition-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "M-.") 'find-definition) + (define-key map (kbd "C-x 4 .") 'find-definition-other-window) + (define-key map (kbd "C-x 5 .") 'find-definition-other-frame) + ;; (define-key map (kbd "M-_") 'find-definition-uses) + (define-key map (kbd "M-,") 'find-definition-goto-last-position) + map) + "The key map for `find-definition-mode'.") + +;;;###autoload +(define-minor-mode find-definition-mode + "Minor mode to provide some key bindings to find definitions. + +\\{find-definition-mode-map}" + :keymap 'find-definition-mode) + +;;;###autoload +(defun find-definition (&optional ask) + "Go to the definition of the thing at point. + +If the definition can not be found, or with a prefix argument, +prompt for a symbol to use." + (interactive "P") + (switch-to-buffer (find-definition--noselect ask))) + +;;;###autoload +(defun find-definition-other-window (&optional ask) + "Display the definition of the thing at point in another window. + +If the definition can not be found, or with a prefix argument, +prompt for a symbol to use." + (interactive "P") + (switch-to-buffer-other-window (find-definition--noselect ask))) + +;;;###autoload +(defun find-definition-other-frame (&optional ask) + "Display the definition of the thing at point in another frame. + +If the definition can not be found, or with a prefix argument, +prompt for a symbol to use." + (interactive "P") + (switch-to-buffer-other-frame (find-definition--noselect ask))) + +(defun find-definition--noselect (&optional ask) + "Internal function for `find-definition'. + +Does all the work, but returns the buffer instead of displaying +it." + (let* ((locations (when (not ask) + (funcall find-definition-function)))) + (cond + (locations + (find-definition--find-locations locations)) + ((and find-definition-identifier-completion-table + find-definition-identifier-function) + (let* ((identifier (completing-read + "Find definition: " + find-definition-identifier-completion-table + nil t)) + (locations (funcall find-definition-identifier-function + identifier))) + (find-definition--find-locations locations))) + (t + (error "Can't find the definition of the thing at point"))))) + +(defun find-definition--find-locations (locations) + "Go to the location in LOCATIONS. + +If there is exactly one location, go directly there. Otherwise, +prompt the user for a location choice." + (if (null (cdr locations)) + ;; Exactly one definition + (let* ((location (car locations)) + (filename (elt location 0)) + (line (or (elt location 1) + 1)) + (col (or (elt location 2) + 0)) + (buf (find-file-noselect filename))) + (with-current-buffer buf + (widen) + (goto-char (point-min)) + (forward-line (- line 1)) + (forward-char col)) + buf) + ;; More than one definition + (let ((outbuf (get-buffer-create "*Definitions*")) + (dir default-directory) + (inhibit-read-only t)) + (with-current-buffer outbuf + (erase-buffer) + (setq default-directory dir) + (compilation-mode) + (dolist (location locations) + (let* ((filename (elt location 0)) + (line (or (elt location 1) + 1)) + (col (or (elt location 2) + 0)) + (buffer (find-buffer-visiting filename)) + (line-string + (when buffer + (with-current-buffer buffer + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (forward-line (- line 1)) + (buffer-substring (line-beginning-position) + (line-end-position)))))))) + (insert (format "%s:%s:%s:%s\n" + filename line col + (or line-string + ""))))) + (goto-char (point-min))) + outbuf))) + +;;;###autoload +(defun find-definition-goto-last-position () + "Pop back to where \\[find-definition] was last invoked." + (interactive) + (when (ring-empty-p find-definition-marker-ring) + (error "No previous locations for find-definition invocation")) + (let ((marker (ring-remove find-definition-marker-ring))) + (switch-to-buffer (or (marker-buffer marker) + (error "The marked buffer has been deleted"))) + (goto-char (marker-position marker)) + (set-marker marker nil nil))) + +(provide 'find-definition) +;;; find-definition.el ends here diff --git a/test/ChangeLog b/test/ChangeLog index fb00410..217672e 100644 --- a/test/ChangeLog +++ b/test/ChangeLog @@ -1,3 +1,7 @@ +2014-11-17 Jorgen Schaefer + + * automated/find-definition-test.el: New file. + 2014-11-17 Glenn Morris * automated/occur-tests.el (occur-test-case, occur-test-create): diff --git a/test/automated/find-definition-test.el b/test/automated/find-definition-test.el new file mode 100644 index 0000000..920eb30 --- /dev/null +++ b/test/automated/find-definition-test.el @@ -0,0 +1,208 @@ +;;; find-definition-test.el --- Test suite for find-definition.el -*- lexical-binding: t -*- + +;; Copyright (C) 2014 Jorgen Schaefer + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 3 +;; of the License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;;; Code: + +(require 'ert) +(require 'find-definition) + + +(defmacro find-definition-with-temp-file (variable &rest body) + "Create a temporary file, bind it to VARIABLE, and evaluated BODY. + +Delete the file after BODY finishes." + (declare (indent 1)) + `(let ((,variable (make-temp-file "find-definition-test-"))) + (unwind-protect + (progn ,@body) + (delete-file ,variable)))) + +;;;;;;;;;;;;;;;;;;; +;;; find-definition + +(ert-deftest find-definition () + ;; It should go to the definition if there is exactly one. + (find-definition-with-temp-file filename + (with-temp-file filename + (insert "Hello\n" + "World\n")) + (let ((find-definition-function (lambda () + (list (list filename 2 3))))) + + (find-definition) + + (should (equal (buffer-file-name) filename)) + (should (looking-at "ld"))) + (kill-buffer)) + + ;; If the backend function can't find a definition for the thing at + ;; point, find-definition should prompt the user for a symbol + ;; completed by a backend-provided completion table. This symbol + ;; then is passed to a backend function to get the location. + (find-definition-with-temp-file filename + (cl-letf* ( ;; User function definitions + (find-definition-function (lambda () + nil)) + (find-definition-identifier-completion-table 'test-table) + (fdsf-identifier nil) + (find-definition-identifier-function + (lambda (sym) + (setq fdsf-identifier sym) + (list (list filename 1 0)))) + ;; Mocking + (cr-collection nil) + ((symbol-function 'completing-read) + (lambda (prompt collection &rest args) + (setq cr-collection collection) + "test-symbol"))) + + (find-definition) + + (should (equal cr-collection 'test-table)) + (should (equal fdsf-identifier "test-symbol")) + (should (equal (buffer-file-name) filename)))) + + ;; Do the same with a prefix argument. + (find-definition-with-temp-file filename + (cl-letf* ( ;; User function definitions + (find-definition-function (lambda () + (error "Should not be called"))) + (find-definition-identifier-completion-table 'test-table) + (find-definition-identifier-function + (lambda (sym) + (list (list filename 1 0)))) + ;; Mocking + (cr-collection nil) + ((symbol-function 'completing-read) + (lambda (prompt collection &rest args) + (setq cr-collection collection) + "test-symbol"))) + + (find-definition '(4)) + + (should (equal cr-collection 'test-table)))) + + ;; Without a completion table and no identifier at point, the + ;; function should throw an error. + (cl-letf* ((find-definition-function (lambda () + nil)) + (find-definition-identifier-completion-table nil) + (find-definition-identifier-function nil)) + + (should-error + (find-definition))) + + ;; Without a completion table and a prefix argument, the function + ;; should throw an error as well + (cl-letf* ((find-definition-function (lambda () + (error "Should not be called"))) + (find-definition-identifier-completion-table nil) + (find-definition-identifier-function nil)) + + (should-error + (find-definition '(4)))) + + ;; It should pop up a selection dialog if there is more than one + ;; definition. + (find-definition-with-temp-file filename + (with-temp-file filename + (insert "Hello\n" + "World\n")) + (let ((find-definition-function (lambda () + (list (list filename 1) + (list filename 2))))) + + (find-definition) + + (should (equal (buffer-name) "*Definitions*")) + (should (eq major-mode 'compilation-mode)))) + ) + +;;;;;;;;;;;;;;;;;;;;;;;; +;;; find-definition-uses + +;; - find-definition-uses should go the use if there is exactly one. +;; - find-definition-uses should pop up a selection dialog if there is +;; more than one use. +;; - find-definition-uses should prompt for name if there is no definition. +;; - find-definition-uses should prompt for name with prefix argument. + +;; - Provide a new function, etags-find-definition + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; find-definition-goto-last-position + +(ert-deftest find-definition-goto-last-position () + ;; It should move to the last position in the same buffer + (with-temp-buffer + (let* ((find-definition-marker-ring (make-ring 5)) + (start (point)) + (marker (make-marker))) + (set-marker marker start) + (ring-insert find-definition-marker-ring marker) + (insert "Bla bla\n") + (should (not (= (point) start))) + (find-definition-goto-last-position) + (should (= (point) start)))) + + ;; It should move to the last position in another buffer + (with-temp-buffer + (let* ((find-definition-marker-ring (make-ring 5)) + (start (point)) + (start-buffer (current-buffer)) + (marker (make-marker))) + (set-marker marker start start-buffer) + (ring-insert find-definition-marker-ring marker) + (with-temp-buffer + (find-definition-goto-last-position) + (should (equal (current-buffer) start-buffer)) + (should (= (point) start))))) + + ;; It should should be interactive + (should (interactive-form 'find-definition-goto-last-position)) + + ;; It should raise an error when the marker ring is empty + (let ((find-definition-marker-ring (make-ring 1))) + (should-error (find-definition-goto-last-position))) + + ;; It should raise an error if the original buffer is deleted + (let* ((find-definition-marker-ring (make-ring 5)) + (marker (make-marker))) + (with-temp-buffer + (set-marker marker (point)) + (ring-insert find-definition-marker-ring marker)) + (should-error + (find-definition-goto-last-position))) + + ;; It should reset the marker + ;; + ;; Why? This is copied from pop-to-mark, but why would this be + ;; needed? + (let* ((find-definition-marker-ring (make-ring 5)) + (marker (make-marker))) + (with-temp-buffer + (set-marker marker (point)) + (ring-insert find-definition-marker-ring marker) + (find-definition-goto-last-position) + (should (null (marker-position marker))) + (should (null (marker-buffer marker))))) + ) + +(provide 'find-definition-test) +;;; find-definition-test.el ends here -- 1.7.10.4