caching a project root to a local variable.

This commit is contained in:
Kazu Yamamoto 2015-08-12 15:44:16 +09:00
parent 443650705c
commit dc3ce15512
2 changed files with 26 additions and 23 deletions

View File

@ -137,7 +137,7 @@ nil does not display errors/warnings.
info infos) info infos)
(dolist (err errs (nreverse infos)) (dolist (err errs (nreverse infos))
(when (string-match regex err) (when (string-match regex err)
(let* ((file (expand-file-name (match-string 1 err) (ghc-get-project-root))) ;; for Windows (let* ((file (expand-file-name (match-string 1 err) ghc-process-root)) ;; for Windows
(line (string-to-number (match-string 2 err))) (line (string-to-number (match-string 2 err)))
(coln (string-to-number (match-string 3 err))) (coln (string-to-number (match-string 3 err)))
(msg (match-string 4 err)) (msg (match-string 4 err))

View File

@ -19,6 +19,7 @@
(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)
(defvar-local ghc-process-root nil)
(defvar ghc-command "ghc-mod") (defvar ghc-command "ghc-mod")
@ -28,8 +29,9 @@
(ghc-run-ghc-mod '("root"))) (ghc-run-ghc-mod '("root")))
(defun ghc-with-process (cmd callback &optional hook1 hook2) (defun ghc-with-process (cmd callback &optional hook1 hook2)
(let ((root (ghc-get-project-root)))
(unless ghc-process-process-name (unless ghc-process-process-name
(setq ghc-process-process-name (ghc-get-project-root))) (setq ghc-process-process-name root))
(when (and ghc-process-process-name (not ghc-process-running)) (when (and ghc-process-process-name (not ghc-process-running))
(setq ghc-process-running t) (setq ghc-process-running t)
(if hook1 (funcall hook1)) (if hook1 (funcall hook1))
@ -43,13 +45,14 @@
(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) (setq ghc-process-hook hook2)
(setq ghc-process-root root)
(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)
(when ghc-debug (when ghc-debug
(ghc-with-debug-buffer (ghc-with-debug-buffer
(insert (format "%% %s" cmd)))) (insert (format "%% %s" cmd))))
pro))))) pro))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;