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)
(let ((target (or prog ghc-module-command)))
(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
(cd cdir)
(apply 'ghc-call-process target nil t nil
(append (ghc-make-ghc-options) cmds))
(buffer-substring (point-min) (1- (point-max))))))))
(let ((default-directory cdir))
(apply 'ghc-call-process target nil t nil
(append (ghc-make-ghc-options) cmds))
(buffer-substring (point-min) (1- (point-max)))))))))
(defmacro ghc-executable-find (cmd &rest body)
;; (declare (indent 1))

26
elisp/ghc-process.el
View File

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