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

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

Browse Source
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
elisp/ghc-check.el
View File

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

4
elisp/ghc-info.el
View File

@ -24,7 +24,7 @@
(defun ghc-get-info (expr) (defun ghc-get-info (expr)
(let* ((file (buffer-file-name)) (let* ((file (buffer-file-name))
(cmd (format "info %s %s\n" file expr))) (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)))) (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 (lambda () cmd)))) (ghc-sync-process cmd)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; ;;;

2
elisp/ghc-ins-mod.el
View File

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

9
elisp/ghc-process.el
View File

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