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

boot skips map-file.

Browse Source
This commit is contained in:
Kazu Yamamoto 2015-09-14 15:09:34 +09:00
parent 52016b6210
commit 6488f1070d
2 changed files with 25 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
elisp/ghc-comp.el
View File

@ -101,7 +101,7 @@ unloaded modules are loaded")
(defun ghc-boot (n) (defun ghc-boot (n)
(prog2 (prog2
(message "Initializing...") (message "Initializing...")
(ghc-sync-process "boot\n" n) (ghc-sync-process "boot\n" n nil 'skip-map-file)
(message "Initializing...done"))) (message "Initializing...done")))
(defun ghc-load-modules (mods) (defun ghc-load-modules (mods)

47
elisp/ghc-process.el
View File

@ -34,7 +34,7 @@
(defun ghc-get-project-root () (defun ghc-get-project-root ()
(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 skip-map-file)
(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 (and ghc-process-process-name (not ghc-process-running)) (when (and ghc-process-process-name (not ghc-process-running))
@ -54,26 +54,27 @@
(let ((pro (ghc-get-process cpro name buf)) (let ((pro (ghc-get-process cpro name buf))
(map-cmd (format "map-file %s\n" file))) (map-cmd (format "map-file %s\n" file)))
;; map-file ;; map-file
(setq ghc-process-file-mapping t) (unless skip-map-file
(setq ghc-process-callback nil) (setq ghc-process-file-mapping t)
(erase-buffer) (setq ghc-process-callback nil)
(when ghc-debug (erase-buffer)
(ghc-with-debug-buffer (when ghc-debug
(insert (format "%% %s" map-cmd)) (ghc-with-debug-buffer
(insert "CONTENTS + EOT\n"))) (insert (format "%% %s" map-cmd))
(process-send-string pro map-cmd) (insert "CONTENTS + EOT\n")))
(with-current-buffer cbuf (process-send-string pro map-cmd)
(save-restriction (with-current-buffer cbuf
(widen) (save-restriction
(process-send-region pro (point-min) (point-max)))) (widen)
(process-send-string pro "\004\n") (process-send-region pro (point-min) (point-max))))
(condition-case nil (process-send-string pro "\004\n")
(let ((inhibit-quit nil)) (condition-case nil
(while ghc-process-file-mapping (let ((inhibit-quit nil))
(accept-process-output pro 0.1 nil t))) (while ghc-process-file-mapping
(quit (accept-process-output pro 0.1 nil t)))
(setq ghc-process-running nil) (quit
(setq ghc-process-file-mapping nil))) (setq ghc-process-running nil)
(setq ghc-process-file-mapping nil))))
;; command ;; command
(setq ghc-process-callback callback) (setq ghc-process-callback callback)
(erase-buffer) (erase-buffer)
@ -179,12 +180,12 @@
(defvar ghc-process-num-of-results nil) (defvar ghc-process-num-of-results nil)
(defvar ghc-process-results nil) (defvar ghc-process-results nil)
(defun ghc-sync-process (cmd &optional n hook) (defun ghc-sync-process (cmd &optional n hook skip-map-file)
(unless ghc-process-running (unless ghc-process-running
(setq ghc-process-rendezvous nil) (setq ghc-process-rendezvous nil)
(setq ghc-process-results nil) (setq ghc-process-results nil)
(setq ghc-process-num-of-results (or n 1)) (setq ghc-process-num-of-results (or n 1))
(let ((pro (ghc-with-process cmd 'ghc-process-callback nil hook))) (let ((pro (ghc-with-process cmd 'ghc-process-callback nil hook skip-map-file)))
;; ghc-process-running is now t. ;; ghc-process-running is now t.
;; But if the process exits abnormally, it is set to nil. ;; But if the process exits abnormally, it is set to nil.
(condition-case nil (condition-case nil