   "The OCaml mode to use for the *merlin types* buffer."
   :group 'merlin :type 'symbol)
 
-
 (defcustom merlin-margin-lock-string "-"
   "String put in the margin to signal the end of the locked zone."
   :group 'merlin :type 'string)
 
 (defcustom merlin-margin-error-string "!"
   "String to put in the margin of a line containing an error."
-  :group 'merlin :type 'string
-)
+  :group 'merlin :type 'string)
 
 (defcustom merlin-margin-warning-string "?"
   "String to put in the margin of a line containing a warning."

         (lambda (item)
           (if (string-equal candidate item)
               (message "%s: %s" candidate (popup-item-summary item))))
         merlin-cache))))

(defvar merlin-ac-source
  (if merlin-ac-prefix-size
  `((init . merlin-source-init)
    (candidates . (lambda () merlin-cache))
    (action . merlin-fetch-type)
    (prefix . ,merlin-ac-prefix-size))
  '((init . merlin-source-init)
    (candidates . (lambda () merlin-cache))
    (action . merlin-fetch-type))))



(when (featurep 'auto-complete)
  (ac-define-source "merlin" merlin-ac-source))

;; Usual completion
(defun merlin-completion-lookup (string state)
  "Lookup the entry STRING inside the completion table."
  (let ((ret (assoc string merlin-completion-annotation-table)))
    (if ret
        (message "%s%s" (car ret) (cdr ret)))))
(defun merlin-completion-at-point ()
  "Perform completion at point with merlin."
  (let ((bounds (bounds-of-thing-at-point 'ocamlatom)))
    (list (car bounds) (cdr bounds)
            (apply-partially #'merlin-completion-table (car bounds))
            . (:exit-function #'merlin-completion-lookup
              :annotation-function '(lambda (s) (cdr (assoc s merlin-completion-annotation-table)))))))
            



(defun merlin-completion-annotate (candidate)
  "Retrieve the annotation for candidate CANDIDATE in `merlin-completion-annotate-table'."
  (cdr (assoc candidate merlin-completion-annotation-table)))
(defun merlin-completion-table (start string pred action)
  "Implement completion for merlin using `completion-at-point' API."
  (if (eq 'metadata action)
      (when merlin-completion-types
        '(metadata ((annotation-function . merlin-completion-annotate)
                    (exit-function . merlin-completion-lookup))))
    (unless (and merlin-completion-annotation-table
                 (eq (car merlin-completion-cache-state) start)
                 (string-equal (merlin-compute-prefix string)
                               (merlin-compute-prefix (cdr merlin-completion-cache-state))))
      (save-excursion
        (goto-char start)
        (setq merlin-lock-point (merlin-retract-to (point))))
      (save-excursion
        (with-merlin-sync
         (setq merlin-completion-annotation-table
               (mapcar #'(lambda (a)
                           (cons (car a) (concat ": " (cadr a))))
                       (merlin-completion-data string)))
         (goto-char start)))
      (setq merlin-completion-cache-state (cons start string)))
    (complete-with-action action merlin-completion-annotation-table string pred)))


;; Switch to ML file
(defun merlin-list-by-ext (ext)
  "List filenames ending by EXT in the path."
  (append (merlin-send-command "which" (list "with_ext" ext))
          nil))

(defun merlin-switch-to (name ext)
  "Switch to NAME.EXT."
  (let ((file
         (merlin-send-command "which" (list "path" (concat (downcase name) "." ext))
                              #'(lambda (err) (message "No such file (message: %s)" err)))))
    (when file (find-file-other-window file))))
(defun merlin-switch-to-ml (name)
  "Switch to the ML file corresponding to the module NAME."
  (interactive (list (completing-read "Module:" (merlin-list-by-ext "ml"))))
  (merlin-switch-to name "ml"))

(defun merlin-switch-to-mli (name)
  "Switch to the MLI file corresponding to the module NAME."
  (interactive (list (completing-read "Module:" (merlin-list-by-ext "mli"))))
  (merlin-switch-to name "mli"))
               
;; Get the type of an element
(defun merlin-type-of-expression-local (exp callback-if-success &optional callback-if-exn)
  "Get the type of EXP inside the local context."
  (if exp
      (merlin-send-command-async "type"
                                 (list "expression" exp "at"
                                       (merlin-unmake-point (point)))
                                 callback-if-success callback-if-exn)))

(defun merlin-type-of-expression-global (exp callback-if-success &optional callback-if-exn)
  "Get the type of EXP globally."
  (if exp
      (merlin-send-command-async "type" (list "expression" exp)
                                 callback-if-success callback-if-exn)))


(defun merlin-type-of-expression (exp callback-if-success &optional callback-if-exn)
  "Get the type of EXP.
It uses three techniques to do so:
- type-expression at (local),
- type expression (global)."
  (merlin-type-of-expression-local exp
                                   callback-if-success
                                   #'(lambda (exn)
                                       (merlin-type-of-expression-global exp
                                                                         callback-if-success
                                                                         callback-if-exn))))


(defun merlin-display-type (bounds type &optional quiet)
  "Display the type TYPE of the the expression occuring at BOUNDS.
If QUIET is non nil, then an overlay and the merlin types can be used."
  (if (not type)
      (if (not quiet)
          (message "<no information>"))
    (progn
      (if (not (merlin-is-long-p type))
          (progn 
            (message "%s" type)
            (if (and (not quiet) bounds)
                (merlin-highlight bounds 'merlin-type-face)))
        (when (not quiet)
          (display-buffer (get-buffer-create merlin-type-buffer-name))
          (with-current-buffer (get-buffer-create merlin-type-buffer-name)
            (erase-buffer)
            (insert type)))))))

(defun merlin-string-at-bounds (bounds)
  "Return the string inbetween BOUNDS."
  (if bounds
      (buffer-substring-no-properties (car bounds)
                                      (cdr bounds))))

(defun merlin-show-type (bounds &optional quiet)
  "Show the type of the expression inside BOUNDS in the current buffer.
If QUIET is non nil then an overlay is displayed and module
types are displayed in another buffer.  Otherwise only value type
are displayed, and without overlay."
  (lexical-let* ((substring (merlin-string-at-bounds bounds))
                 (bounds bounds)
                 (quiet quiet))
    (merlin-type-of-expression substring
                               #'(lambda (type)
                                   (merlin-display-type bounds type quiet)))))

(defun merlin-get-type-codomain (type)
  "Return the codomain of TYPE if it exists, or nil."
  (car (last (split-string type " " nil))))

(defun merlin-show-type-def ()
  "Print the definition of the type of the term under point."
  (interactive)
  (lexical-let* ((bounds (bounds-of-thing-at-point 'ocamlatom)))
    (with-merlin-sync
     (merlin-type-of-expression
      (merlin-string-at-bounds bounds)
      #'(lambda (type)
          (merlin-type-of-expression (merlin-get-type-codomain type)
                                     #'(lambda (typedef)
                                         (merlin-display-type bounds
                                                              (if typedef typedef
                                                                (concat type ": <not an atomic type>"))))))))))

(defun merlin-show-type-of-region ()
  "Show the type of the region."
  (interactive)
  (with-merlin-sync
   (merlin-show-type (cons (region-beginning) (region-end)))))

(defun merlin-show-type-of-point (arg) 
  "Show the type of the identifier under the point. 
If it is called with a prefix argument, then show the type of the region."
  (interactive "p")
  (if (> arg 1)
      (merlin-show-type-of-region)
    (merlin-show-type (bounds-of-thing-at-point 'ocamlatom))))

;; ENCLOSING TYPES
(defun merlin-type-enclosing ()
  "If there is a selected type enclosing, kill it.
Otherwise start a new session at point."
  (interactive)
  (let ((list
         (mapcar
          (lambda (obj)
            (cons
             (cdr (assoc 'type obj))
             (merlin-make-bounds obj)))
          (elt
           (merlin-send-command "type" (list "enclosing" (merlin-unmake-point (point))))
           1))))
    (setq merlin-last-point-type (point))
    (setq merlin-enclosing-types list)
    (setq merlin-enclosing-offset -1)))

(defun merlin-magic-show-type (arg)
  "Print the type of the expression under point.
If called several times at the same position, it will print types
of bigger expressions around point (it will go up the
ast).  Called with a prefix argument, it will go down the AST.  If
there is no enclosing, falls back to
`merlin-show-type-of-point'."
  (interactive "p")
  (save-excursion
    (with-merlin-sync
     (if (> arg 1)
         (merlin-show-type-of-region)
       (progn
         (merlin-type-enclosing)
         (if (not merlin-enclosing-types)
             (merlin-show-type-of-point arg)
           (merlin-type-enclosing-go-up)))))))

(defun merlin-show-type-of-user-supplied-expression (s)
  "Show the type of the expression S."
  (interactive "sExpression:")
  (merlin-type-of-expression s #'(lambda (type)
                                   (merlin-display-type nil s nil))))

(defun merlin-type-enclosing-go ()
  "Highlight the given corresponding enclosing data (of the form (TYPE . BOUNDS)."
  (let ((data (elt merlin-enclosing-types merlin-enclosing-offset)))
    (if (cddr data)
        (merlin-display-type (cdr data) (car data)))))

(defun merlin-type-enclosing-go-up ()
  "Go up in the enclosing type zipper."

    (define-key merlin-menu-map [separator]
      '("-"))
    (define-key merlin-show-type-map [local]
      '(menu-item "around the cursor" merlin-show-type
                  :help "Show the type of the smallest subexpression near cursor"))
    (define-key merlin-show-type-map [region]
      '(menu-item "of the region" merlin-show-type-of-region
