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

passing 'ok/'ng to callback.

Browse Source
This commit is contained in:
Kazu Yamamoto 2014-04-27 21:51:44 +09:00
parent dede115731
commit 4d2ef23f33
2 changed files with 45 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
elisp/ghc-check.el
View File

@ -69,7 +69,9 @@ nil does not display errors/warnings.
(mapconcat (lambda (x) (concat "\"" x "\"")) los ", ") (mapconcat (lambda (x) (concat "\"" x "\"")) los ", ")
"]"))) "]")))
(defun ghc-check-callback () (defun ghc-check-callback (status)
(cond
((eq status 'ok)
(let* ((errs (ghc-read-lisp-this-buffer)) (let* ((errs (ghc-read-lisp-this-buffer))
(infos (ghc-to-info errs))) (infos (ghc-to-info errs)))
(cond (cond
@ -88,6 +90,9 @@ nil does not display errors/warnings.
(elen (length errs)) (elen (length errs))
(wlen (- len elen))) (wlen (- len elen)))
(setq mode-line-process (format " %d:%d" elen wlen)))))))) (setq mode-line-process (format " %d:%d" elen wlen))))))))
(t
(with-current-buffer ghc-process-original-buffer
(setq mode-line-process " failed")))))
(defun ghc-to-info (errs) (defun ghc-to-info (errs)
;; [^\t] to include \n. ;; [^\t] to include \n.

24
elisp/ghc-process.el
View File

@ -72,15 +72,23 @@
(goto-char (point-max)) (goto-char (point-max))
(insert string) (insert string)
(forward-line -1) (forward-line -1)
(when (looking-at "^OK$\\|^NG ") (cond
((looking-at "^OK$")
(if ghc-process-hook (funcall ghc-process-hook)) (if ghc-process-hook (funcall ghc-process-hook))
(goto-char (point-min)) (goto-char (point-min))
(funcall ghc-process-callback) (funcall ghc-process-callback 'ok)
(when ghc-debug (when ghc-debug
(let ((cbuf (current-buffer))) (let ((cbuf (current-buffer)))
(ghc-with-debug-buffer (ghc-with-debug-buffer
(insert-buffer-substring cbuf)))) (insert-buffer-substring cbuf))))
(setq ghc-process-running nil)))) (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)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -97,14 +105,18 @@
(sit-for 0.1 t)) (sit-for 0.1 t))
ghc-process-results) ghc-process-results)
(defun ghc-process-callback () (defun ghc-process-callback (status)
(cond
((eq status 'ok)
(let* ((n ghc-process-num-of-results) (let* ((n ghc-process-num-of-results)
(ret (if (= n 1) (ret (if (= n 1)
(ghc-read-lisp-this-buffer) (ghc-read-lisp-this-buffer)
(ghc-read-lisp-list-this-buffer n)))) (ghc-read-lisp-list-this-buffer n))))
(setq ghc-process-results ret) (setq ghc-process-results ret)))
(t
(setq ghc-process-results nil)))
(setq ghc-process-num-of-results nil) (setq ghc-process-num-of-results nil)
(setq ghc-process-rendezvous t))) (setq ghc-process-rendezvous t))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;