;;; find-definition.el --- Find definition at point  -*- lexical-binding: t -*-

;; Copyright (C) 2014 Free Software Foundation, Inc.

;; Author: Jorgen Schaefer <contact@jorgenschaefer.de>
;; 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 <http://www.gnu.org/licenses/>.

;;; 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