Merge pull request #1195 from geraldus/g/fix-XXXX

Prevent automatic haskell-doc-mode actions when point in string or comment

Author: gracjan

haskell-doc.el

@@ -1392,12 +1392,14 @@ is not."
 This function is run by an idle timer to print the type
  automatically if `haskell-doc-mode' is turned on."
   (and haskell-doc-mode
+       (haskell-doc-in-code-p)
        (not haskell-mode-interactive-prompt-state)
        (not (eobp))
        (not executing-kbd-macro)
        ;; Having this mode operate in the minibuffer makes it impossible to
        ;; see what you're doing.
        (not (eq (selected-window) (minibuffer-window)))
+       ;; not in string or comment
        ;; take a nap, if run straight from post-command-hook.
        (if (fboundp 'run-with-idle-timer) t
          (sit-for haskell-doc-idle-delay))
@@ -1416,12 +1418,11 @@ This function is run by an idle timer to print the type
 Meant for `eldoc-documentation-function'."
   ;; There are a number of possible documentation functions.
   ;; Some of them are asynchronous.
-  (let ((msg (or
-              (haskell-doc-current-info--interaction)
-              (haskell-doc-sym-doc (haskell-ident-at-point)))))
-    (unless (symbolp msg) msg)))
-
-
+  (when (haskell-doc-in-code-p)
+    (let ((msg (or
+                (haskell-doc-current-info--interaction)
+                (haskell-doc-sym-doc (haskell-ident-at-point)))))
+      (unless (symbolp msg) msg))))
 
 (defun haskell-doc-ask-mouse-for-type (event)
   "Read the identifier under the mouse and echo its type.
@@ -1434,6 +1435,7 @@ function.  Only the user interface is different."
     (haskell-doc-show-type)))
 
 (defun haskell-doc-in-code-p ()
+  "A predicate indicating suitable case to show docs."
   (not (or (and (eq haskell-literate 'bird)
                 ;; Copied from haskell-indent-bolp.
                 (<= (current-column) 2)
@@ -1442,7 +1444,7 @@ function.  Only the user interface is different."
 
 ;;;###autoload
 (defun haskell-doc-show-type (&optional sym)
-  "Show the type of the function near point.
+  "Show the type of the function near point or given symbol SYM.
 For the function under point, show the type in the echo area.
 This information is extracted from the `haskell-doc-prelude-types' alist
 of prelude functions and their types, or from the local functions in the
@@ -1461,36 +1463,39 @@ current buffer."
           (message "%s" doc))))))
 
 (defvar haskell-doc-current-info--interaction-last nil
-  "If non-nil, a previous eldoc message from an async call, that
-  hasn't been displayed yet.")
+  "Async message stack.
+If non-nil, a previous eldoc message from an async call, that
+hasn't been displayed yet.")
 
 (defun haskell-doc-current-info--interaction (&optional sync)
-  "Asynchronous call to `haskell-process-get-type', suitable for
-use in the eldoc function `haskell-doc-current-info'.
+  "Asynchronous call to `haskell-process-get-type'.
+Suitable for use in the eldoc function `haskell-doc-current-info'.
 
 If SYNC is non-nil, the call will be synchronous instead, and
 instead of calling `eldoc-print-current-symbol-info', the result
 will be returned directly."
   ;; Return nil if nothing is available, or 'async if something might
   ;; be available, but asynchronously later. This will call
   ;; `eldoc-print-current-symbol-info' later.
-  (let (sym prev-message)
-    (cond
-     ((setq prev-message haskell-doc-current-info--interaction-last)
-      (setq haskell-doc-current-info--interaction-last nil)
-      (cdr prev-message))
-     ((setq sym
-            (if (use-region-p)
-                (buffer-substring-no-properties
-                 (region-beginning) (region-end))
-              (haskell-ident-at-point)))
-      (if sync
-          (haskell-process-get-type sym #'identity t)
-        (haskell-process-get-type
-         sym (lambda (response)
-               (setq haskell-doc-current-info--interaction-last
-                     (cons 'async response))
-               (eldoc-print-current-symbol-info))))))))
+  (when (haskell-doc-in-code-p)
+    ;; do nothing when inside string or comment
+    (let (sym prev-message)
+      (cond
+       ((setq prev-message haskell-doc-current-info--interaction-last)
+        (setq haskell-doc-current-info--interaction-last nil)
+        (cdr prev-message))
+       ((setq sym
+              (if (use-region-p)
+                  (buffer-substring-no-properties
+                   (region-beginning) (region-end))
+                (haskell-ident-at-point)))
+        (if sync
+            (haskell-process-get-type sym #'identity t)
+          (haskell-process-get-type
+           sym (lambda (response)
+                 (setq haskell-doc-current-info--interaction-last
+                       (cons 'async response))
+                 (eldoc-print-current-symbol-info)))))))))
 
 (defun haskell-process-get-type (expr-string &optional callback sync)
   "Asynchronously get the type of a given string.
@@ -1547,7 +1552,7 @@ If SYNC is non-nil, make the call synchronously instead."
         'async))))
 
 (defun haskell-doc-sym-doc (sym)
-  "Show the type of the function near point.
+  "Show the type of given symbol SYM.
 For the function under point, show the type in the echo area.
 This information is extracted from the `haskell-doc-prelude-types' alist
 of prelude functions and their types, or from the local functions in the
@@ -1734,23 +1739,6 @@ ToDo: Also eliminate leading and trailing whitespace."
       (setq str (replace-match " " t t str)))
     str))
 
-;; ToDo: make this more efficient!!
-;;(defun haskell-doc-string-nub-ws (str)
-;;  "Replace all sequences of whitespaces in STR by just one whitespace."
-;;  (let ( (res "")
-;;       (l (length str))
-;;       (i 0)
-;;       (j 0)
-;;       (in-ws nil))
-;;   (while (< i l)
-;;     (let* ( (c (string-to-char (substring str i (1+ i))))
-;;          (is-ws (eq (char-syntax c) ? )) )
-;;       (if (not (and in-ws is-ws))
-;;           (setq res (concat res (char-to-string c))))
-;;       (setq in-ws is-ws)
-;;       (setq i (1+ i))))
-;;   res))
-
 (defun haskell-doc-chop-off-context (str)
   "Eliminate the context in a type represented by the string STR."
   (let ((i (string-match "=>" str)) )