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

39
elisp/ghc-check.el
View File

@ -69,25 +69,30 @@ 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)
(let* ((errs (ghc-read-lisp-this-buffer)) (cond
(infos (ghc-to-info errs))) ((eq status 'ok)
(cond (let* ((errs (ghc-read-lisp-this-buffer))
(infos (infos (ghc-to-info errs)))
(let ((file ghc-process-original-file) (cond
(buf ghc-process-original-buffer)) (infos
(ghc-check-highlight-original-buffer file buf infos))) (let ((file ghc-process-original-file)
(t (buf ghc-process-original-buffer))
(ghc-check-highlight-original-buffer file buf infos)))
(t
(with-current-buffer ghc-process-original-buffer
(remove-overlays (point-min) (point-max) 'ghc-check t))))
(with-current-buffer ghc-process-original-buffer (with-current-buffer ghc-process-original-buffer
(remove-overlays (point-min) (point-max) 'ghc-check t)))) (let ((len (length infos)))
(if (= len 0)
(setq mode-line-process "")
(let* ((errs (ghc-filter 'ghc-hilit-info-get-err infos))
(elen (length errs))
(wlen (- len elen)))
(setq mode-line-process (format " %d:%d" elen wlen))))))))
(t
(with-current-buffer ghc-process-original-buffer (with-current-buffer ghc-process-original-buffer
(let ((len (length infos))) (setq mode-line-process " failed")))))
(if (= len 0)
(setq mode-line-process "")
(let* ((errs (ghc-filter 'ghc-hilit-info-get-err infos))
(elen (length errs))
(wlen (- len elen)))
(setq mode-line-process (format " %d:%d" elen wlen))))))))
(defun ghc-to-info (errs) (defun ghc-to-info (errs)
;; [^\t] to include \n. ;; [^\t] to include \n.

34
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)
(let* ((n ghc-process-num-of-results) (cond
(ret (if (= n 1) ((eq status 'ok)
(ghc-read-lisp-this-buffer) (let* ((n ghc-process-num-of-results)
(ghc-read-lisp-list-this-buffer n)))) (ret (if (= n 1)
(setq ghc-process-results ret) (ghc-read-lisp-this-buffer)
(setq ghc-process-num-of-results nil) (ghc-read-lisp-list-this-buffer n))))
(setq ghc-process-rendezvous t))) (setq ghc-process-results ret)))
(t
(setq ghc-process-results nil)))
(setq ghc-process-num-of-results nil)
(setq ghc-process-rendezvous t))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;