hasufell/ghc-mod
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

splitting stdout and stderr.

Browse Source
This commit is contained in:
Kazu Yamamoto 2015-08-13 16:50:19 +09:00
parent 54c2be20b6
commit 002008aa30
1 changed files with 38 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

43
elisp/ghc-process.el
View File

@ -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$")