From 41fe35b691f38fbe2c9728d0a3b96abd3f086836 Mon Sep 17 00:00:00 2001
From: Kazu Yamamoto <kazu@iij.ad.jp>
Date: Tue, 6 Mar 2012 17:12:15 +0900
Subject: [PATCH] integrating display functions.

---
 elisp/ghc-flymake.el | 19 ++++++-------------
 elisp/ghc-func.el    | 26 ++++++++++++++++++++++++++
 elisp/ghc-info.el    | 29 ++++++++++++-----------------
 3 files changed, 44 insertions(+), 30 deletions(-)

diff --git a/elisp/ghc-flymake.el b/elisp/ghc-flymake.el
index dda0968..7d05f1f 100644
--- a/elisp/ghc-flymake.el
+++ b/elisp/ghc-flymake.el
@@ -19,8 +19,6 @@
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(defconst ghc-error-buffer-name "*GHC Errors*")
-
 (defconst ghc-flymake-allowed-file-name-masks
   '("\\.l?hs$" ghc-flymake-init flymake-simple-cleanup ghc-flymake-get-real-file-name))
 
@@ -71,18 +69,13 @@
   (interactive)
   (if (not (ghc-flymake-have-errs-p))
       (message "No errors or warnings")
-    (let ((buf (get-buffer-create ghc-error-buffer-name))
-	  (title (ghc-flymake-err-title))
+    (let ((title (ghc-flymake-err-title))
 	  (errs (ghc-flymake-err-list)))
-      (with-current-buffer buf
-	(erase-buffer)
-	(ghc-flymake-insert-errors title errs))
-      (display-buffer buf))))
-
-(defun ghc-flymake-insert-errors (title errs)
-  (save-excursion
-    (insert title "\n\n")
-    (mapc (lambda (x) (insert (ghc-replace-character x ghc-null ghc-newline) "\n")) errs)))
+      (ghc-display
+       nil
+       (lambda (&rest ignore)
+	 (insert title "\n\n")
+	 (mapc (lambda (x) (insert x "\n")) errs))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
diff --git a/elisp/ghc-func.el b/elisp/ghc-func.el
index 22bf351..936bcc0 100644
--- a/elisp/ghc-func.el
+++ b/elisp/ghc-func.el
@@ -22,6 +22,14 @@
       (if (char-equal (aref ret cnt) from)
 	  (aset ret cnt to)))))
 
+(defun ghc-replace-character-buffer (from-c to-c)
+  (let ((from (char-to-string from-c))
+	(to (char-to-string to-c)))
+    (save-excursion
+      (goto-char (point-min))
+      (while (search-forward from nil t)
+	(replace-match to)))))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defmacro ghc-add (sym val)
@@ -145,4 +153,22 @@
 (defun ghc-make-ghc-options ()
   (ghc-mapconcat (lambda (x) (list "-g" x)) ghc-ghc-options))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defconst ghc-error-buffer-name "*GHC Info*")
+
+(defun ghc-display (fontify ins-func)
+  (let ((cdir default-directory)
+	(buf (get-buffer-create ghc-error-buffer-name)))
+    (with-current-buffer buf
+      (erase-buffer)
+      (funcall ins-func cdir)
+      (ghc-replace-character-buffer ghc-null ghc-newline)
+      (goto-char (point-min))
+      (if (not fontify)
+	  (turn-off-haskell-font-lock)
+	(haskell-font-lock-defaults-create)
+	(turn-on-haskell-font-lock)))
+    (display-buffer buf)))
+
 (provide 'ghc-func)
diff --git a/elisp/ghc-info.el b/elisp/ghc-info.el
index ba51d4e..244419e 100644
--- a/elisp/ghc-info.el
+++ b/elisp/ghc-info.el
@@ -17,7 +17,7 @@
 	 (expr (if ask (ghc-read-expression expr0) expr0))
 	 (file (buffer-file-name))
 	 (cmds (list "info" file modname expr)))
-    (ghc-display-information cmds)))
+    (ghc-display-information cmds nil)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
@@ -124,31 +124,26 @@
   (interactive)
   (let* ((file (buffer-file-name))
 	 (cmds (list "expand" file)))
-    (ghc-display-information cmds)))
+    (ghc-display-information cmds t)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
 ;;; Display
 ;;;
 
-(defun ghc-display-information (cmds)
+(defun ghc-display-information (cmds fontify)
   (interactive)
   (if (not (ghc-which ghc-module-command))
       (message "%s not found" ghc-module-command)
-    (let ((cdir default-directory)
-	  (buf (get-buffer-create ghc-error-buffer-name)))
-      (with-current-buffer buf
-	(erase-buffer)
-	(insert
-	 (with-temp-buffer
-	   (cd cdir)
-	   (apply 'call-process ghc-module-command nil t nil
-		  (append (ghc-make-ghc-options) cmds))
-	   (buffer-substring (point-min) (1- (point-max)))))
-	(goto-char (point-min))
-	(haskell-font-lock-defaults-create)
-	(turn-on-haskell-font-lock))
-      (display-buffer buf))))
+    (ghc-display
+     fontify
+     (lambda (cdir)
+       (insert
+	(with-temp-buffer
+	  (cd cdir)
+	  (apply 'call-process ghc-module-command nil t nil
+		 (append (ghc-make-ghc-options) cmds))
+	  (buffer-substring (point-min) (1- (point-max)))))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;