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

ensuring that root ends with a file separator.

This commit is contained in:
Kazu Yamamoto 2015-09-15 12:14:36 +09:00
parent ac2d8ba134
commit 545f0557f2
2 changed files with 19 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
elisp/ghc-func.el
View File

@ -207,12 +207,13 @@
(defun ghc-run-ghc-mod (cmds &optional prog) (defun ghc-run-ghc-mod (cmds &optional prog)
(let ((target (or prog ghc-module-command))) (let ((target (or prog ghc-module-command)))
(ghc-executable-find target (ghc-executable-find target
(let ((cdir default-directory)) (let ((cdir (or ghc-process-root ;; ghc-mod version/debug
default-directory))) ;; ghc-mod root
(with-temp-buffer (with-temp-buffer
(cd cdir) (let ((default-directory cdir))
(apply 'ghc-call-process target nil t nil (apply 'ghc-call-process target nil t nil
(append (ghc-make-ghc-options) cmds)) (append (ghc-make-ghc-options) cmds))
(buffer-substring (point-min) (1- (point-max)))))))) (buffer-substring (point-min) (1- (point-max)))))))))
(defmacro ghc-executable-find (cmd &rest body) (defmacro ghc-executable-find (cmd &rest body)
;; (declare (indent 1)) ;; (declare (indent 1))

26
elisp/ghc-process.el
View File

@ -42,7 +42,7 @@
(if hook1 (funcall hook1)) (if hook1 (funcall hook1))
(let* ((cbuf (current-buffer)) (let* ((cbuf (current-buffer))
(name ghc-process-process-name) (name ghc-process-process-name)
(root ghc-process-process-name) (root (file-name-as-directory ghc-process-process-name))
(buf (get-buffer-create (concat " ghc-mod:" name))) (buf (get-buffer-create (concat " ghc-mod:" name)))
(file (buffer-file-name)) (file (buffer-file-name))
(cpro (get-process name))) (cpro (get-process name)))
@ -51,7 +51,7 @@
(setq ghc-process-original-file file) (setq ghc-process-original-file file)
(setq ghc-process-hook hook2) (setq ghc-process-hook hook2)
(setq ghc-process-root root) (setq ghc-process-root root)
(let ((pro (ghc-get-process cpro name buf)) (let ((pro (ghc-get-process cpro name buf root))
(map-cmd (format "map-file %s\n" file))) (map-cmd (format "map-file %s\n" file)))
;; map-file ;; map-file
(unless skip-map-file (unless skip-map-file
@ -86,18 +86,18 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun ghc-get-process (cpro name buf) (defun ghc-get-process (cpro name buf root)
(let ((default-directory name)) (cond
(cond ((not cpro)
((not cpro) (ghc-start-process name buf root))
(ghc-start-process name buf)) ((not (eq (process-status cpro) 'run))
((not (eq (process-status cpro) 'run)) (delete-process cpro)
(delete-process cpro) (ghc-start-process name buf root))
(ghc-start-process name buf)) (t cpro)))
(t cpro))))
(defun ghc-start-process (name buf) (defun ghc-start-process (name buf root)
(let* ((process-connection-type nil) ;; using PIPE due to ^D (let* ((default-directory root)
(process-connection-type nil) ;; using PIPE due to ^D
(opts (append ghc-debug-options (opts (append ghc-debug-options
'("-b" "\n" "-l" "--line-prefix=O: ,E: ") '("-b" "\n" "-l" "--line-prefix=O: ,E: ")
(ghc-make-ghc-options) (ghc-make-ghc-options)