From 54c2be20b686cddaa29c2e1fc1101799d5e462d8 Mon Sep 17 00:00:00 2001 From: Kazu Yamamoto Date: Thu, 13 Aug 2015 14:40:48 +0900 Subject: [PATCH 1/5] better debug logging of Elisp. --- elisp/ghc-process.el | 11 +++-------- 1 file changed, 3 insertions(+), 8 deletions(-) diff --git a/elisp/ghc-process.el b/elisp/ghc-process.el index d9c0821..03cc62d 100644 --- a/elisp/ghc-process.el +++ b/elisp/ghc-process.el @@ -78,6 +78,9 @@ (if (not (get-buffer pbuf)) (setq ghc-process-running nil) ;; just in case (ghc-with-current-buffer (process-buffer process) + (when ghc-debug + (ghc-with-debug-buffer + (insert string))) (goto-char (point-max)) (insert string) (forward-line -1) @@ -86,17 +89,9 @@ (if ghc-process-hook (funcall ghc-process-hook)) (goto-char (point-min)) (funcall ghc-process-callback 'ok) - (when ghc-debug - (let ((cbuf (current-buffer))) - (ghc-with-debug-buffer - (insert-buffer-substring cbuf)))) (setq ghc-process-running nil)) ((looking-at "^NG ") (funcall ghc-process-callback 'ng) - (when ghc-debug - (let ((cbuf (current-buffer))) - (ghc-with-debug-buffer - (insert-buffer-substring cbuf)))) (setq ghc-process-running nil))))))) (defun ghc-process-sentinel (process event) From 002008aa301c0e09229b6c8fe2d0ed6231ec866c Mon Sep 17 00:00:00 2001 From: Kazu Yamamoto Date: Thu, 13 Aug 2015 16:50:19 +0900 Subject: [PATCH 2/5] splitting stdout and stderr. --- elisp/ghc-process.el | 43 ++++++++++++++++++++++++++++++++++++++----- 1 file changed, 38 insertions(+), 5 deletions(-) diff --git a/elisp/ghc-process.el b/elisp/ghc-process.el index 03cc62d..d6d4a35 100644 --- a/elisp/ghc-process.el +++ b/elisp/ghc-process.el @@ -21,7 +21,9 @@ (defvar-local ghc-process-hook nil) (defvar-local ghc-process-root nil) -(defvar ghc-command "ghc-mod") +(defvar ghc-command "Mock") + +(defvar ghc-error-buffer "*GHC Error*") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -74,15 +76,46 @@ pro)) (defun ghc-process-filter (process string) - (let ((pbuf (process-buffer process))) + (let* ((pbuf (process-buffer process)) + (tbufname (concat " tmp " (buffer-name pbuf))) + tbuf) (if (not (get-buffer pbuf)) (setq ghc-process-running nil) ;; just in case - (ghc-with-current-buffer (process-buffer process) + (ghc-with-current-buffer pbuf (when ghc-debug (ghc-with-debug-buffer (insert string))) - (goto-char (point-max)) - (insert string) + (with-current-buffer (get-buffer-create tbufname) + (setq tbuf (current-buffer)) + (goto-char (point-max)) + (insert string) + (goto-char (point-min)) + (let ((cont t) end out) + (while (and cont (not (eobp))) + (cond + ((looking-at "^O: ") + (setq out t)) + ((looking-at "^E: ") + (setq out nil)) + (t + (setq cont nil))) + (when cont + (forward-line) + (unless (bolp) (setq cont nil))) + (when cont + (delete-region 1 4) + (setq end (point)) + (if out + (with-current-buffer pbuf + (goto-char (point-max)) + (insert-buffer-substring tbuf 1 end)) + (with-current-buffer (get-buffer-create ghc-error-buffer) + (goto-char (point-max)) + (insert-buffer-substring tbuf 1 end) + (display-buffer (current-buffer)) + (redisplay))) + (delete-region 1 end))))) + (goto-char (point-max)) (forward-line -1) (cond ((looking-at "^OK$") From efef2b19eabcb36958f5fe3d1705cf97b1de9c3f Mon Sep 17 00:00:00 2001 From: Kazu Yamamoto Date: Thu, 13 Aug 2015 17:39:01 +0900 Subject: [PATCH 3/5] scrolling errors. --- elisp/ghc-process.el | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/elisp/ghc-process.el b/elisp/ghc-process.el index d6d4a35..7de4bb3 100644 --- a/elisp/ghc-process.el +++ b/elisp/ghc-process.el @@ -110,9 +110,15 @@ (goto-char (point-max)) (insert-buffer-substring tbuf 1 end)) (with-current-buffer (get-buffer-create ghc-error-buffer) - (goto-char (point-max)) - (insert-buffer-substring tbuf 1 end) - (display-buffer (current-buffer)) + (let* ((cbuf (current-buffer)) + cwin) + (unless (get-buffer-window cbuf) (display-buffer cbuf)) + (setq cwin (get-buffer-window cbuf)) + (goto-char (point-max)) + (insert-buffer-substring tbuf 1 end) + (unless (pos-visible-in-window-p (point) cwin) + (with-selected-window cwin + (scroll-up 2)))) (redisplay))) (delete-region 1 end))))) (goto-char (point-max)) From f762209e603e0f2851c61f4394de3786c4cd7149 Mon Sep 17 00:00:00 2001 From: Kazu Yamamoto Date: Fri, 14 Aug 2015 11:36:37 +0900 Subject: [PATCH 4/5] using new ghc-mod. --- elisp/ghc-process.el | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/elisp/ghc-process.el b/elisp/ghc-process.el index 7de4bb3..db22ef0 100644 --- a/elisp/ghc-process.el +++ b/elisp/ghc-process.el @@ -21,7 +21,7 @@ (defvar-local ghc-process-hook nil) (defvar-local ghc-process-root nil) -(defvar ghc-command "Mock") +(defvar ghc-command "ghc-mod") (defvar ghc-error-buffer "*GHC Error*") @@ -68,7 +68,9 @@ (t cpro))) (defun ghc-start-process (name buf) - (let* ((opts (append '("legacy-interactive" "-b" "\n" "-l" "-s") (ghc-make-ghc-options))) + (let* ((opts (append '("-b" "\n" "-l" "--line-prefix=O: ,E: ") + (ghc-make-ghc-options) + '("legacy-interactive"))) (pro (apply 'start-file-process name buf ghc-command opts))) (set-process-filter pro 'ghc-process-filter) (set-process-sentinel pro 'ghc-process-sentinel) From cfddddcfe8da8f4121d0ddd930a1447e84275127 Mon Sep 17 00:00:00 2001 From: Kazu Yamamoto Date: Fri, 14 Aug 2015 11:40:57 +0900 Subject: [PATCH 5/5] error buffer is now read-only. --- elisp/ghc-process.el | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/elisp/ghc-process.el b/elisp/ghc-process.el index db22ef0..8214aa1 100644 --- a/elisp/ghc-process.el +++ b/elisp/ghc-process.el @@ -112,12 +112,16 @@ (goto-char (point-max)) (insert-buffer-substring tbuf 1 end)) (with-current-buffer (get-buffer-create ghc-error-buffer) - (let* ((cbuf (current-buffer)) + (setq buffer-read-only t) + (let* ((buffer-read-only nil) + (inhibit-read-only t) + (cbuf (current-buffer)) cwin) (unless (get-buffer-window cbuf) (display-buffer cbuf)) (setq cwin (get-buffer-window cbuf)) (goto-char (point-max)) (insert-buffer-substring tbuf 1 end) + (set-buffer-modified-p nil) (unless (pos-visible-in-window-p (point) cwin) (with-selected-window cwin (scroll-up 2))))