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 ", ")
"]")))
(defun ghc-check-callback ()
(let* ((errs (ghc-read-lisp-this-buffer))
(infos (ghc-to-info errs)))
(cond
(infos
(let ((file ghc-process-original-file)
(buf ghc-process-original-buffer))
(ghc-check-highlight-original-buffer file buf infos)))
(t
(defun ghc-check-callback (status)
(cond
((eq status 'ok)
(let* ((errs (ghc-read-lisp-this-buffer))
(infos (ghc-to-info errs)))
(cond
(infos
(let ((file ghc-process-original-file)
(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
(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
(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))))))))
(setq mode-line-process " failed")))))
(defun ghc-to-info (errs)
;; [^\t] to include \n.

34
elisp/ghc-process.el
View File

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