From 3f01b15a3e4e3bddbc6aa7a335ea0b721d6b2ccc Mon Sep 17 00:00:00 2001
From: Kazu Yamamoto <kazu@iij.ad.jp>
Date: Thu, 20 Mar 2014 15:32:54 +0900
Subject: [PATCH] ghc-goto-next-error.

---
 elisp/ghc-check.el   | 35 ++++++++++++++++++++++++++++-------
 elisp/ghc-command.el |  3 +--
 elisp/ghc.el         |  6 +++---
 3 files changed, 32 insertions(+), 12 deletions(-)

diff --git a/elisp/ghc-check.el b/elisp/ghc-check.el
index 7736271..bf0896a 100644
--- a/elisp/ghc-check.el
+++ b/elisp/ghc-check.el
@@ -11,9 +11,6 @@
 ;; other files' errors should go to 0
 ;; ghc-flymake-display-errors -> line column
 ;; ghc-flymake-jump
-;; flymake-goto-prev-error
-;; flymake-goto-next-error
-;; no need to save
 
 (require 'ghc-func)
 
@@ -110,6 +107,8 @@
 	(let ((line (ghc-hilit-info-get-line info))
 	      (msg (ghc-hilit-info-get-msg info))
 	      beg end ovl)
+	  ;; FIXME: This is the Shlemiel painter's algorithm.
+	  ;; If this is a bottleneck for a large code, let's fix.
 	  (goto-char (point-min))
 	  (forward-line (1- line))
 	  (while (eq (char-after) 32) (forward-char))
@@ -143,9 +142,9 @@
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(defun ghc-check-display-errors ()
+(defun ghc-display-errors ()
   (interactive)
-  (let* ((ovls (ghc-check-overlay-here))
+  (let* ((ovls (ghc-check-overlay-at (point)))
 	 (errs (mapcar (lambda (ovl) (overlay-get ovl 'ghc-msg)) ovls)))
     (if (null ovls)
 	(message "No errors or warnings")
@@ -155,8 +154,30 @@
 ;;	 (insert title "\n\n")
 	 (mapc (lambda (x) (insert x "\n")) errs))))))
 
-(defun ghc-check-overlay-here ()
-  (let ((ovls (overlays-at (point))))
+(defun ghc-check-overlay-at (p)
+  (let ((ovls (overlays-at p)))
     (ghc-filter (lambda (ovl) (overlay-get ovl 'ghc-check)) ovls)))
 
+(defun ghc-goto-prev-error ()
+  (interactive)
+  (let* ((here (point))
+	 (ovls0 (ghc-check-overlay-at here))
+	 (end (if ovls0 (overlay-start (car ovls0)) here))
+	 (ovls1 (overlays-in (point-min) end))
+	 (ovls2 (ghc-filter (lambda (ovl) (overlay-get ovl 'ghc-check)) ovls1))
+	 (pnts0 (mapcar 'overlay-start ovls2))
+	 (pnts1 (sort pnts0 '>)))
+    (if pnts1 (goto-char (car pnts1)))))
+
+(defun ghc-goto-next-error ()
+  (interactive)
+  (let* ((here (point))
+	 (ovls0 (ghc-check-overlay-at here))
+	 (beg (if ovls0 (overlay-end (car ovls0)) here))
+	 (ovls1 (overlays-in beg (point-max)))
+	 (ovls2 (ghc-filter (lambda (ovl) (overlay-get ovl 'ghc-check)) ovls1))
+	 (pnts0 (mapcar 'overlay-start ovls2))
+	 (pnts1 (sort pnts0 '<)))
+    (if pnts1 (goto-char (car pnts1)))))
+
 (provide 'ghc-check)
diff --git a/elisp/ghc-command.el b/elisp/ghc-command.el
index 0873498..f7c8b0c 100644
--- a/elisp/ghc-command.el
+++ b/elisp/ghc-command.el
@@ -40,8 +40,7 @@
 
 (defun ghc-save-buffer ()
   (interactive)
-  (if (buffer-modified-p) (save-buffer))
-;;  (if (buffer-modified-p) (call-interactively 'save-buffer))
+  (if (buffer-modified-p) (call-interactively 'save-buffer))
   (ghc-check-syntax))
 
 (provide 'ghc-command)
diff --git a/elisp/ghc.el b/elisp/ghc.el
index b4ca4b1..5a7427d 100644
--- a/elisp/ghc.el
+++ b/elisp/ghc.el
@@ -74,9 +74,9 @@
     (define-key haskell-mode-map ghc-expand-key      'ghc-expand-th)
 ;;    (define-key haskell-mode-map ghc-jump-key        'ghc-flymake-jump) ;; fixme
     (define-key haskell-mode-map ghc-import-key      'ghc-import-module)
-;;    (define-key haskell-mode-map ghc-previous-key    'flymake-goto-prev-error)
-;;    (define-key haskell-mode-map ghc-next-key        'flymake-goto-next-error)
-    (define-key haskell-mode-map ghc-help-key        'ghc-check-display-errors)
+    (define-key haskell-mode-map ghc-previous-key    'ghc-goto-prev-error)
+    (define-key haskell-mode-map ghc-next-key        'ghc-goto-next-error)
+    (define-key haskell-mode-map ghc-help-key        'ghc-display-errors)
     (define-key haskell-mode-map ghc-insert-key      'ghc-insert-template)
     (define-key haskell-mode-map ghc-sort-key        'ghc-sort-lines)
     (define-key haskell-mode-map ghc-check-key       'ghc-save-buffer)