From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Jorgen Schaefer Newsgroups: gmane.emacs.devel Subject: Re: Generalizing find-definition Date: Mon, 17 Nov 2014 21:10:39 +0100 Message-ID: <20141117211039.37f03409@forcix> References: <20141102151524.0d9c665c@forcix> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="MP_/rTh3p8zfvag0rjeaqFm3eg." X-Trace: ger.gmane.org 1416255171 19787 80.91.229.3 (17 Nov 2014 20:12:51 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Mon, 17 Nov 2014 20:12:51 +0000 (UTC) Cc: emacs-devel@gnu.org To: Stefan Monnier Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Mon Nov 17 21:12:45 2014 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1XqSfF-0004dc-0q for ged-emacs-devel@m.gmane.org; Mon, 17 Nov 2014 21:12:45 +0100 Original-Received: from localhost ([::1]:50029 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1XqSfE-0006CC-Hw for ged-emacs-devel@m.gmane.org; Mon, 17 Nov 2014 15:12:44 -0500 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:38669) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1XqSdX-0003u1-5x for emacs-devel@gnu.org; Mon, 17 Nov 2014 15:11:04 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1XqSdR-0006NJ-7t for emacs-devel@gnu.org; Mon, 17 Nov 2014 15:10:59 -0500 Original-Received: from loki.jorgenschaefer.de ([87.230.15.51]:56205) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1XqSdQ-0006Lf-9z for emacs-devel@gnu.org; Mon, 17 Nov 2014 15:10:53 -0500 Original-Received: by loki.jorgenschaefer.de (Postfix, from userid 998) id 1E4932002F6; Mon, 17 Nov 2014 21:10:47 +0100 (CET) Original-Received: from forcix (port-53053.pppoe.wtnet.de [46.59.207.229]) by loki.jorgenschaefer.de (Postfix) with ESMTPSA id 8E48B2002F4; Mon, 17 Nov 2014 21:10:42 +0100 (CET) In-Reply-To: X-Mailer: Claws Mail 3.11.1 (GTK+ 2.24.25; i586-pc-linux-gnu) X-detected-operating-system: by eggs.gnu.org: GNU/Linux 3.x X-Received-From: 87.230.15.51 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.14 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:177490 Archived-At: --MP_/rTh3p8zfvag0rjeaqFm3eg. Content-Type: text/plain; charset=US-ASCII Content-Transfer-Encoding: 7bit Content-Disposition: inline On Sun, 02 Nov 2014 10:34:28 -0500 Stefan Monnier wrote: > > M-. is bound to a new command `find-definition', which primarily > > calls the value of a new variable `find-definition-function' (by > > default a wrapper around `find-tag' to keep the current > > functionality intact). `find-definition' also keeps track of the > > tag ring, so this would move `find-tag-marker-ring' and related > > functionality out of etags.el, too. > > Yes, this sounds great. > > [...] > > > Comments? > > I'm all for it, Some initial patch attached. Is this what you had in mind when you said the above? Anything I should change to make it fit into Emacs better? I do not know much about Emacs coding conventions. Currently missing: - find-definition does not store locations in the tag ring yet (ran out of time and wanted to post the initial patch for feedback) - The whole "find uses" interface - etags.el integration - emacs-lisp-mode integration This also does define a minor mode instead of changing the global key bindings. I think in the final version it should replace the key binding definitions done in etags.el. Is this correct? Do I need to hook it up elsewhere in the build process? Public git repo for those who find that easier to read / clone (nothing there that isn't in the attached patch): https://github.com/jorgenschaefer/emacs/tree/find-definition https://github.com/jorgenschaefer/emacs/commit/ecac500ac7dee3095863df23c4cd661ba62e2187 Regards, Jorgen --MP_/rTh3p8zfvag0rjeaqFm3eg. Content-Type: text/x-patch Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename=0001-lisp-progmodes-find-definition.el-New-file.patch >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 --MP_/rTh3p8zfvag0rjeaqFm3eg.--