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

ghc-with-process takes two hooks.

Browse Source
This commit is contained in:
Kazu Yamamoto 2014-04-22 12:33:26 +09:00
parent 2e1df9c21f
commit e3798ac82a
2 changed files with 14 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
elisp/ghc-info.el
View File

@ -111,7 +111,13 @@
(cn (int-to-string (1+ (current-column)))) (cn (int-to-string (1+ (current-column))))
(file (buffer-file-name)) (file (buffer-file-name))
(cmd (format "type %s %s %s\n" file ln cn))) (cmd (format "type %s %s %s\n" file ln cn)))
(ghc-sync-process cmd))) (ghc-sync-process cmd nil 'ghc-type-fix-string)))
(defun ghc-type-fix-string ()
(save-excursion
(goto-char (point-min))
(while (search-forward "[Char]" nil t)
(replace-match "String"))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; ;;;

11
elisp/ghc-process.el
View File

@ -17,6 +17,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 ghc-interactive-command "ghc-modi") (defvar ghc-interactive-command "ghc-modi")
@ -25,11 +26,11 @@
(defun ghc-get-project-root () (defun ghc-get-project-root ()
(ghc-run-ghc-mod '("root"))) (ghc-run-ghc-mod '("root")))
(defun ghc-with-process (cmd callback &optional hook) (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 ghc-process-process-name (when ghc-process-process-name
(if hook (funcall hook)) (if hook1 (funcall hook1))
(let* ((cbuf (current-buffer)) (let* ((cbuf (current-buffer))
(name ghc-process-process-name) (name ghc-process-process-name)
(buf (get-buffer-create (concat " ghc-modi:" name))) (buf (get-buffer-create (concat " ghc-modi:" name)))
@ -41,6 +42,7 @@
(setq ghc-process-original-buffer cbuf) (setq ghc-process-original-buffer cbuf)
(setq ghc-process-original-file file) (setq ghc-process-original-file file)
(setq ghc-process-callback callback) (setq ghc-process-callback callback)
(setq ghc-process-hook hook2)
(erase-buffer) (erase-buffer)
(let ((pro (ghc-get-process cpro name buf))) (let ((pro (ghc-get-process cpro name buf)))
(process-send-string pro cmd) (process-send-string pro cmd)
@ -71,6 +73,7 @@
(insert string) (insert string)
(forward-line -1) (forward-line -1)
(when (looking-at "^\\(OK\\|NG\\)$") (when (looking-at "^\\(OK\\|NG\\)$")
(if ghc-process-hook (funcall ghc-process-hook))
(goto-char (point-min)) (goto-char (point-min))
(funcall ghc-process-callback) (funcall ghc-process-callback)
(when ghc-debug (when ghc-debug
@ -85,11 +88,11 @@
(defvar ghc-process-num-of-results nil) (defvar ghc-process-num-of-results nil)
(defvar ghc-process-results nil) (defvar ghc-process-results nil)
(defun ghc-sync-process (cmd &optional n) (defun ghc-sync-process (cmd &optional n hook)
(setq ghc-process-rendezvous nil) (setq ghc-process-rendezvous nil)
(setq ghc-process-results nil) (setq ghc-process-results nil)
(setq ghc-process-num-of-results (or n 1)) (setq ghc-process-num-of-results (or n 1))
(ghc-with-process cmd 'ghc-process-callback) (ghc-with-process cmd 'ghc-process-callback nil hook)
(while (null ghc-process-rendezvous) (while (null ghc-process-rendezvous)
(sit-for 0.01)) (sit-for 0.01))
ghc-process-results) ghc-process-results)