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

don't silently ignore case when ghc process is already running in ghc-with-process

Browse Source
This commit is contained in:
Sergey Vinokurov 2015-05-17 23:22:05 +03:00
parent f7717ee1ee
commit ac31e6edc2
1 changed files with 24 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
elisp/ghc-process.el
View File

@ -18,7 +18,8 @@
(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")
@ -30,26 +31,28 @@
(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)))
(when (and ghc-process-process-name (not ghc-process-running)) (if ghc-process-running
(setq ghc-process-running t) (error "ghc process already running")
(if hook1 (funcall hook1)) (progn
(let* ((cbuf (current-buffer)) (when ghc-process-running t)
(name ghc-process-process-name) (if hook1 (funcall hook1))
(buf (get-buffer-create (concat " ghc-mod:" name))) (let* ((cbuf (current-buffer))
(file (buffer-file-name)) (name ghc-process-process-name)
(cpro (get-process name))) (buf (get-buffer-create (concat " ghc-mod:" name)))
(ghc-with-current-buffer buf (file (buffer-file-name))
(setq ghc-process-original-buffer cbuf) (cpro (get-process name)))
(setq ghc-process-original-file file) (ghc-with-current-buffer buf
(setq ghc-process-callback callback) (setq ghc-process-original-buffer cbuf)
(setq ghc-process-hook hook2) (setq ghc-process-original-file file)
(erase-buffer) (setq ghc-process-callback callback)
(let ((pro (ghc-get-process cpro name buf))) (setq ghc-process-hook hook2)
(process-send-string pro cmd) (erase-buffer)
(when ghc-debug (let ((pro (ghc-get-process cpro name buf)))
(ghc-with-debug-buffer (process-send-string pro cmd)
(insert (format "%% %s" cmd)))) (when ghc-debug
pro))))) (ghc-with-debug-buffer
(insert (format "%% %s" cmd))))
pro))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;