Merge branch 'master' of github.com:kazu-yamamoto/ghc-mod

This commit is contained in:
Daniel Gröber 2015-08-12 08:52:25 +02:00
commit 6a01550d3f
2 changed files with 22 additions and 25 deletions

View File

@ -127,7 +127,7 @@ unloaded modules are loaded")
(interactive) (interactive)
(if (ghc-should-scroll) (if (ghc-should-scroll)
(ghc-scroll-completion-buffer) (ghc-scroll-completion-buffer)
(ghc-try-complete))) (ghc-try-complete)))
(defun ghc-should-scroll () (defun ghc-should-scroll ()
(let ((window (ghc-completion-window))) (let ((window (ghc-completion-window)))

View File

@ -18,8 +18,7 @@
(defvar-local ghc-process-original-buffer nil) (defvar-local ghc-process-original-buffer nil)
(defvar-local ghc-process-original-file nil) (defvar-local ghc-process-original-file nil)
(defvar-local ghc-process-callback nil) (defvar-local ghc-process-callback nil)
(defvar-local ghc-process-hook nil (defvar-local ghc-process-hook nil)
"Hook that will be called upon successfull completion of ghc-mod command.")
(defvar ghc-command "ghc-mod") (defvar ghc-command "ghc-mod")
@ -31,28 +30,26 @@
(defun ghc-with-process (cmd callback &optional hook1 hook2) (defun ghc-with-process (cmd callback &optional hook1 hook2)
(unless ghc-process-process-name (unless ghc-process-process-name
(setq ghc-process-process-name (ghc-get-project-root))) (setq ghc-process-process-name (ghc-get-project-root)))
(if ghc-process-running (when (and ghc-process-process-name (not ghc-process-running))
(error "ghc process already running") (setq ghc-process-running t)
(progn (if hook1 (funcall hook1))
(setq ghc-process-running t) (let* ((cbuf (current-buffer))
(if hook1 (funcall hook1)) (name ghc-process-process-name)
(let* ((cbuf (current-buffer)) (buf (get-buffer-create (concat " ghc-mod:" name)))
(name ghc-process-process-name) (file (buffer-file-name))
(buf (get-buffer-create (concat " ghc-mod:" name))) (cpro (get-process name)))
(file (buffer-file-name)) (ghc-with-current-buffer buf
(cpro (get-process name))) (setq ghc-process-original-buffer cbuf)
(ghc-with-current-buffer buf (setq ghc-process-original-file file)
(setq ghc-process-original-buffer cbuf) (setq ghc-process-callback callback)
(setq ghc-process-original-file file) (setq ghc-process-hook hook2)
(setq ghc-process-callback callback) (erase-buffer)
(setq ghc-process-hook hook2) (let ((pro (ghc-get-process cpro name buf)))
(erase-buffer) (process-send-string pro cmd)
(let ((pro (ghc-get-process cpro name buf))) (when ghc-debug
(process-send-string pro cmd) (ghc-with-debug-buffer
(when ghc-debug (insert (format "%% %s" cmd))))
(ghc-with-debug-buffer pro)))))
(insert (format "%% %s" cmd))))
pro))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;