;;; eldoc.el --- show function arglist or variable docstring in echo area

;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;;   2005, 2006, 2007 Free Software Foundation, Inc.

;; Copyright (C) 2009 KOBAYASHI Shigeru <shigeru.kb@gmail.com>

;; Author: Noah Friedman <friedman@splode.com>
;; Maintainer: friedman@splode.com
;; Keywords: extensions
;; Created: 1995-10-06

;; This file is `NOT' part of GNU Emacs.

;; GNU Emacs 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, or (at your option)
;; any later version.

;; GNU Emacs 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 GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.

;;; Commentary:

;; This program was inspired by the behavior of the "mouse documentation
;; window" on many Lisp Machine systems; as you type a function's symbol
;; name as part of a sexp, it will print the argument list for that
;; function.  Behavior is not identical; for example, you need not actually
;; type the function name, you need only move point around in a sexp that
;; calls it.  Also, if point is over a documented variable, it will print
;; the one-line documentation for that variable instead, to remind you of
;; that variable's meaning.

;; One useful way to enable this minor mode is to put the following in your
;; .emacs:
;;
;;      (add-hook 'emacs-lisp-mode-hook 'turn-on-eldoc-mode)
;;      (add-hook 'lisp-interaction-mode-hook 'turn-on-eldoc-mode)
;;      (add-hook 'ielm-mode-hook 'turn-on-eldoc-mode)

;; Major modes for other languages may use Eldoc by defining an
;; appropriate function as the buffer-local value of
;; `eldoc-documentation-function'.

;;; Code:

(eval-when-compile
  (require 'cl))

;; For fundoc-usage handling functions. (require Emacs22 or later)
(require 'help-fns)

(defgroup eldoc nil
  "Show function arglist or variable docstring in echo area."
  :group 'lisp
  :group 'extensions)

(defcustom eldoc-idle-delay 0.20
  "*Number of seconds of idle time to wait before printing."
  :type 'number
  :group 'eldoc)

;;;###autoload
(defcustom eldoc-minor-mode-string " ElDoc"
  "*String to display in mode line when Eldoc Mode is enabled; nil for none."
  :type '(choice string (const :tag "None" nil))
  :group 'eldoc)

(defcustom eldoc-arglist-case 'upcase
  "Case to display argument names of functions, as a symbol."
  :type '(radio (function-item upcase)
                (function-item downcase)
                function)
  :group 'eldoc)

(defcustom eldoc-use-multiline-p nil
  "*Allow long eldoc messages to resize echo area display."
  :type 'boolean
  :group 'eldoc)

(defface eldoc-highlight-arglist
    '((t (:inherit highlight)))
  "Face used for the argument at point in a function's argument list."
  :group 'eldoc)

(defstruct eldoc-last-data
  (symbol nil             :type symbol)
  (doc    "Undocumented." :type string)
  (type   'variable       :type symbol))

(lexical-let ((cache (make-eldoc-last-data)))

  (defun eldoc-cache-symbol () #1=(eldoc-last-data-symbol cache))
  (defun eldoc-cache-doc    () #2=(eldoc-last-data-doc    cache))
  (defun eldoc-cache-type   () #3=(eldoc-last-data-type   cache))

  (defun eldoc-update-cache (symbol doc type)
    (setf #1# symbol
          #2# doc
          #3# type))
  )

(defvar eldoc-last-message nil)


;;; User interface

;;;###autoload
(define-minor-mode eldoc-mode
    "Displays information about a function or variable at point."
  :group 'eldoc
  :lighter eldoc-minor-mode-string
  (setq eldoc-last-message nil)
  (cond
    ;; ON
    (eldoc-mode
     (eldoc-start-timer)
     (add-hook 'pre-command-hook 'eldoc-pre-command-refresh-echo-area t))
    ;; OFF
    (t
     (eldoc-stop-timer)
     (remove-hook 'pre-command-hook 'eldoc-pre-command-refresh-echo-area))))

;;;###autoload
(defun turn-on-eldoc-mode ()
  "Unequivocally turn on ElDoc mode (see command `eldoc-mode')."
  (interactive)
  (eldoc-mode 1))

;;;###autoload
(defun turn-off-eldoc-mode ()
  (interactive)
  (eldoc-mode -1))



;;; Timer
(defvar eldoc-timer nil
  "eldoc's timer object.")

(defun eldoc-start-timer ()
  (when eldoc-timer
    (cancel-timer eldoc-timer))
  (setq eldoc-timer
        (run-with-idle-timer eldoc-idle-delay t
                             'eldoc-autodoc-at-point)))

(defun eldoc-stop-timer ()
  (when eldoc-timer
    (cancel-timer eldoc-timer)
    (setq eldoc-timer nil)))


;;; Echo

(defun eldoc-message (doc)
  (when doc
    (setq doc (substring doc 0 (string-match "\n" doc))))
  (setq eldoc-last-message doc)
  (when eldoc-last-message
    ;; suppress log output
    (let ((message-log-max nil)
          (message-truncate-lines (null eldoc-use-multiline-p)))
      (message "%s" eldoc-last-message))))

;; This function goes on pre-command-hook for XEmacs or when using idle
;; timers in Emacs.  Motion commands clear the echo area for some reason,
;; which make eldoc messages flicker or disappear just before motion
;; begins.  This function reprints the last eldoc message immediately
;; before the next command executes, which does away with the flicker.
;; This doesn't seem to be required for Emacs 19.28 and earlier.
(defun eldoc-pre-command-refresh-echo-area ()
  (if (eldoc-enable-display-p)
      (eldoc-message eldoc-last-message)
      (setq eldoc-last-message nil)))

(defun eldoc-enable-display-p ()
  "Check various conditions about the current environment that might make
it undesirable to print eldoc messages right this instant."
  (and eldoc-mode
       (not executing-kbd-macro)
       (not (and (boundp 'edebug-active) edebug-active))
       ;; Having this mode operate in an active minibuffer/echo area causes
       ;; interference with what's going on there.
       (not cursor-in-echo-area)
       (not (eq (selected-window) (minibuffer-window)))
       (or (null (current-message))
           (string-equal (current-message) eldoc-last-message))
       (not (active-minibuffer-window))))


;;; Find symbol

;;;###autoload
(defvar eldoc-documentation-function nil
  "If non-nil, function to call to return doc string.
The function of no args should return a one-line string for displaying
doc about a function etc. appropriate to the context around point.
It should return nil if there's no doc appropriate for the context.
Typically doc is returned if point is on a function-like name or in its
arg list.

This variable is expected to be made buffer-local by modes (other than
Emacs Lisp mode) that support Eldoc.")

(defun eldoc-autodoc-at-point ()
  (when (eldoc-enable-display-p)
    (condition-case err
        (if eldoc-documentation-function
            (eldoc-message (funcall eldoc-documentation-function))
            (let ((current-symbol (eldoc-current-symbol)))
              (destructuring-bind (fnsym index)
                  (eldoc-parse-fnsym) ;; (eldoc-fnsym-in-current-sexp)
                (let ((doc (cond
                             ;; Function -> Variable
                             ((eq current-symbol fnsym)
                              (or #1=(eldoc-get-fnsym-args-string fnsym index)
                                  #2=(eldoc-get-var-docstring current-symbol)))
                             ;; Variable -> Function
                             (t
                              (or #2# #1#)))))
                  (eldoc-message doc)))))
      ;; This is run from post-command-hook or some idle timer thing,
      ;; so we need to be careful that errors aren't ignored.
      (error (message "eldoc error: %s" err)) )))

(defun eldoc-get-fnsym-args-string (sym &optional index)
  "Return a string containing the parameter list of the function SYM.
If SYM is a subr and no arglist is obtainable from the docstring
or elsewhere, return a 1-line docstring.  The former calls
`eldoc-arglist-case'; the latter gives the function name
`font-lock-function-name-face', and optionally highlights
argument number INDEX."
  (when (fboundp sym)
    (let* ((docstring (documentation sym t))
           (list (help-split-fundoc docstring sym))
           (args (car list))
           (doc  (cdr list)))
      (cond
        ;; Find from cache
        ((and (eq sym (eldoc-cache-symbol))
              (eq 'function (eldoc-cache-type)))
         (setq args (eldoc-cache-doc)))
        ;; Find arglist from docstring (builtin, autoload, etc.)
        (args
         ;; e.g. "(setq [SYM VAL]...)" -> "[SYM VAL]..."
         (if (string-match "\\`[^ )]* ?\\(.*\\))\\'" args)
             (setq args (match-string 1 args))))
        (t
         ;; User defined function
         ;; `nil' means function has no argment.
         (setq args (help-function-arglist sym))))
      (setq args (format "%s" (or args "")))
      ;; Stringify, and store before highlighting, downcasing, etc.
      ;; (eldoc-last-data-store sym args 'function)
      (eldoc-update-cache sym args 'function)
      ;; Change case, highlight, truncate.
      (format "(%s %s): %s"
              (propertize (symbol-name sym) 'face 'font-lock-function-name-face)
              (eldoc-highlight-arglist
               sym
               (eldoc-arglist-case
                (replace-regexp-in-string "[][()]+" "" args))
               index)
              (or doc docstring "Undocumented.")))))

(defun eldoc-arglist-case (argstring)
  (mapconcat (lambda (str)
               (if (memq (intern str)
                         (eval-when-compile
                           lambda-list-keywords))
                   str
                   (funcall eldoc-arglist-case str)))
             (split-string argstring)
             " "))

;; FIXME: (point {}) -> "args-out-of-range -1 0"
(defun* eldoc-highlight-arglist (sym argstring &optional (index 1))
  "Highlight argument INDEX in ARGSTRING list for function SYM."
  (declare (ignore sym))
  (let ((start nil)
        (end    0)
        (face  'eldoc-highlight-arglist))
    ;; Find the current argument in the argument string.  We need to
    ;; handle `&rest' and informal `...' properly.
    ;;
    ;; FIXME: What to do with optional arguments, like in
    ;;        (defun NAME ARGLIST [DOCSTRING] BODY...) case?
    ;;        The problem is there is no robust way to determine if
    ;;        the current argument is indeed a docstring.
    (while (<= 1 index)
      (cond ((string-match "[^ ()]+" argstring end)
             (progn
               (setq start (match-beginning 0)
                     end   (match-end 0))
               (let ((argument (match-string 0 argstring)))
                 (cond ((member argument '("&rest" "&body"))
                        ;; All the rest arguments are the same.
                        (setq index 1))
                       ((string= argument "&optional"))
                       ((string-match "\\.\\.\\.$" argument)
                        (setq index 0))
                       (t
                        (decf index))))))
            (t
             (setq end   (length argstring)
                   start (1- end)
                   face  'font-lock-warning-face
                   index 0))))
    (when start
      (add-text-properties start end `(face ,face) argstring))
    argstring))

(defun eldoc-get-var-docstring (sym)
  "Return a string containing a brief documentation string for the variable."
  (when sym
    (or (and (eq sym (eldoc-cache-symbol))
             (eq 'variable (eldoc-cache-type))
             (eldoc-cache-doc))
        (let ((doc (documentation-property sym 'variable-documentation t)))
          (when doc
            (setq doc (format "%s: %s"
                              (propertize (symbol-name sym)
                                          'face
                                          'font-lock-variable-name-face)
                              doc))
            (eldoc-update-cache sym doc 'variable)
            doc)))))

(defun eldoc-inside-string-p (&optional point)
  (or point (setq point (point)))
  (save-excursion
    (goto-char point)
    (let* ((lim (or (save-excursion
                      (beginning-of-defun)
                      (point))
                    (point-min)))
           (state (parse-partial-sexp lim point)))
      ;; 8. character address of start of comment or string; nil if not in one.
      (nth 8 state))))

(defun* eldoc-parse-fnsym ()
  "Return list of function-symbol (or nil) and point-of-argindex."
  (save-excursion
    (let ((parse-sexp-ignore-comments t)))
    (goto-char (or (eldoc-inside-string-p) (point)))
    (let ((index 0)
          (opoint (point)))
      ;; set point beginning-of-sexp
      (ignore-errors (up-list -1) (forward-char))
      (let ((op (eldoc-current-symbol)))
        (if (null op)
            '(nil 0)
            (condition-case err
                (loop
                   (forward-sexp)
                   (if (<= opoint (point))
                       (return #1=`(,op ,index)))
                   (incf index))
              (error #1#)))))))

(defun eldoc-current-symbol ()
  "Returns nil unless current word is an interned symbol."
  (let ((c (following-char)))
    (and c
         (memq (char-syntax c) '(?w ?_)) ; word or symbol
         (intern-soft (current-word)))))

(provide 'eldoc)

;;; eldoc.el ends here