ghc-with-process now takes string for the first argument.

This commit is contained in:
Kazu Yamamoto 2014-04-21 09:46:33 +09:00
parent 756d17eaa2
commit 19453e67d7
4 changed files with 16 additions and 17 deletions

View File

@ -46,21 +46,21 @@ nil does not display errors/warnings.
(defun ghc-check-syntax ()
(interactive)
(ghc-with-process 'ghc-check-send 'ghc-check-callback))
(setq mode-line-process " -:-") ;; fixme
(ghc-with-process (ghc-check-send) 'ghc-check-callback))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(ghc-defstruct hilit-info file line msg err)
(defun ghc-check-send ()
(with-current-buffer ghc-process-original-buffer
(setq mode-line-process " -:-"))
(if ghc-check-command
(let ((opts (ghc-haskell-list-of-string ghc-hlint-options)))
(if opts
(concat "lint " opts " " ghc-process-original-file "\n")
(concat "lint " ghc-process-original-file "\n")))
(concat "check " ghc-process-original-file "\n")))
(let ((file (buffer-file-name)))
(if ghc-check-command
(let ((opts (ghc-haskell-list-of-string ghc-hlint-options)))
(if opts
(format "lint %s %s\n" opts file)
(format "lint %s\n" file)))
(format "check %s\n" file))))
(defun ghc-haskell-list-of-string (los)
(when los

View File

@ -24,7 +24,7 @@
(defun ghc-get-info (expr)
(let* ((file (buffer-file-name))
(cmd (format "info %s %s\n" file expr)))
(car (ghc-sync-process (lambda () cmd)))))
(ghc-sync-process cmd)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
@ -111,7 +111,7 @@
(cn (int-to-string (1+ (current-column))))
(file (buffer-file-name))
(cmd (format "type %s %s %s\n" file ln cn)))
(ghc-sync-process (lambda () cmd))))
(ghc-sync-process cmd)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;

View File

@ -74,6 +74,6 @@
(defun ghc-function-to-modules (fun)
(let ((cmd (format "find %s\n" fun)))
(ghc-sync-process (lambda () cmd))))
(ghc-sync-process cmd)))
(provide 'ghc-ins-mod)

View File

@ -31,7 +31,7 @@
(when (looking-at "^\\(.*\\)$")
(match-string-no-properties 1))))))
(defun ghc-with-process (send callback)
(defun ghc-with-process (cmd callback)
(unless ghc-process-process-name
(setq ghc-process-process-name (ghc-get-project-root)))
(when ghc-process-process-name
@ -47,8 +47,7 @@
(setq ghc-process-original-file file)
(setq ghc-process-callback callback)
(erase-buffer)
(let ((pro (ghc-get-process cpro name buf))
(cmd (funcall send)))
(let ((pro (ghc-get-process cpro name buf)))
(process-send-string pro cmd)
(when ghc-debug
(ghc-with-debug-buffer
@ -90,10 +89,10 @@
(defvar ghc-process-rendezvous nil)
(defvar ghc-process-results nil)
(defun ghc-sync-process (send)
(defun ghc-sync-process (cmd)
(setq ghc-process-rendezvous nil)
(setq ghc-process-results nil)
(ghc-with-process send 'ghc-process-callback)
(ghc-with-process cmd 'ghc-process-callback)
(while (null ghc-process-rendezvous)
(sit-for 0.01))
ghc-process-results)