From b7cea06a523d99d8b58f6e503d24f0f19c7eaa11 Mon Sep 17 00:00:00 2001 From: Kazu Yamamoto Date: Wed, 19 Aug 2015 15:02:00 +0900 Subject: [PATCH 1/6] Flushing stdout to solve infinite loop (#542). --- Language/Haskell/GhcMod/Output.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/Language/Haskell/GhcMod/Output.hs b/Language/Haskell/GhcMod/Output.hs index e96956a..6e3f36c 100644 --- a/Language/Haskell/GhcMod/Output.hs +++ b/Language/Haskell/GhcMod/Output.hs @@ -129,13 +129,14 @@ stdoutGateway chan = go ("", "") case ty of GmTerminated -> case stream of - GmOut -> putStr (obuf++l) >> go ("", ebuf) - GmErr -> putStr (ebuf++l) >> go (obuf, "") + GmOut -> putStr (obuf++l) >> hFlush stdout >> go ("", ebuf) + GmErr -> putStr (ebuf++l) >> hFlush stdout >> go (obuf, "") GmPartial -> case reverse $ lines l of [] -> go buf [x] -> go (appendBuf stream buf x) x:xs -> do putStr $ unlines $ reverse xs + hFlush stdout go (appendBuf stream buf x) appendBuf GmOut (obuf, ebuf) s = (obuf++s, ebuf) From 24510719b865127035f35af404bb98c84e1c35af Mon Sep 17 00:00:00 2001 From: Kazu Yamamoto Date: Wed, 19 Aug 2015 15:27:27 +0900 Subject: [PATCH 2/6] adding "make lint" for Elisp. --- elisp/Makefile | 17 ++++++++++++----- 1 file changed, 12 insertions(+), 5 deletions(-) diff --git a/elisp/Makefile b/elisp/Makefile index 96bec8b..8e89dde 100644 --- a/elisp/Makefile +++ b/elisp/Makefile @@ -1,17 +1,17 @@ SRCS = ghc.el ghc-func.el ghc-doc.el ghc-comp.el ghc-check.el ghc-process.el \ ghc-command.el ghc-info.el ghc-ins-mod.el ghc-indent.el ghc-rewrite.el EMACS = emacs -DETECT = xemacs TEMPFILE = temp.el +TEMPFILE2 = temp2.el all: $(TEMPFILE) ghc.el $(EMACS) -batch -q -no-site-file -l ./$(TEMPFILE) -f ghc-compile rm -f $(TEMPFILE) -detect: $(TEMPFILE) ghc.el - $(EMACS) -batch -q -no-site-file -l ./$(TEMPFILE) -f ghc-compile - rm -f $(DETECT) +lint: $(TEMPFILE2) ghc.el + $(EMACS) -batch -q -no-site-file -l ./$(TEMPFILE2) -f ghc-compile + rm -f $(TEMPFILE2) $(TEMPFILE): @echo '(setq load-path (cons "." load-path))' >> $(TEMPFILE) @@ -19,8 +19,15 @@ $(TEMPFILE): @echo $(SRCS)| sed -e 's/\(ghc[^ ]*\.el\)/"\1"/g' >> $(TEMPFILE) @echo ')))' >> $(TEMPFILE) +$(TEMPFILE2): + @echo '(setq load-path (cons "." load-path))' >> $(TEMPFILE2) + @echo '(setq hack-local-variables-hook (lambda () (setq lexical-binding t)))' >> $(TEMPFILE2) + @echo '(defun ghc-compile () (mapcar (lambda (x) (byte-compile-file x)) (list ' >> $(TEMPFILE2) + @echo $(SRCS)| sed -e 's/\(ghc[^ ]*\.el\)/"\1"/g' >> $(TEMPFILE2) + @echo ')))' >> $(TEMPFILE2) + clean: - rm -f *.elc $(TEMPFILE) + rm -f *.elc $(TEMPFILE) $(TEMPFILE2) VERSION = `grep version ghc.el | sed -e 's/[^0-9\.]//g'` From 531a731da1991c74d675431624fac14ad83ca1a0 Mon Sep 17 00:00:00 2001 From: Kazu Yamamoto Date: Wed, 19 Aug 2015 15:37:41 +0900 Subject: [PATCH 3/6] preventing "unused variable" warnings. --- elisp/ghc-check.el | 7 +++---- elisp/ghc-doc.el | 2 +- elisp/ghc-func.el | 17 ++++++++++------- elisp/ghc-indent.el | 4 ++-- elisp/ghc-info.el | 2 +- elisp/ghc-process.el | 2 +- elisp/ghc-rewrite.el | 9 +++------ 7 files changed, 21 insertions(+), 22 deletions(-) diff --git a/elisp/ghc-check.el b/elisp/ghc-check.el index 5819a17..d02142a 100644 --- a/elisp/ghc-check.el +++ b/elisp/ghc-check.el @@ -295,14 +295,13 @@ nil do not display errors/warnings. (let ((file-msgs (ghc-get-only-holes))) (if (null file-msgs) (message "No holes") - (let ((file (ghc-file-msgs-get-file file-msgs)) - (msgs (ghc-file-msgs-get-msgs file-msgs))) + (let ((msgs (ghc-file-msgs-get-msgs file-msgs))) (ghc-display nil (lambda () (progn (mapc (lambda (x) (insert x "\n\n")) msgs) - (buttonize-buffer)) )))))) + (buttonize-buffer)))))))) (defun ghc-display-holes-to-minibuf () (let ((file-msgs (ghc-get-only-holes))) @@ -479,7 +478,7 @@ nil do not display errors/warnings. (forward-line) (re-search-forward "^$" nil t) (insert fn) - (dotimes (i arity) + (dotimes (_i arity) (insert " _")) (insert " = error \"" fn "\"\n"))))) diff --git a/elisp/ghc-doc.el b/elisp/ghc-doc.el index 512fa7d..42790dd 100644 --- a/elisp/ghc-doc.el +++ b/elisp/ghc-doc.el @@ -54,7 +54,7 @@ (defconst ghc-doc-hackage-format "http://hackage.haskell.org/packages/archive/%s/%s/doc/html/%s.html") -(defun ghc-browse-url-safari (uri &rest args) +(defun ghc-browse-url-safari (uri &rest _args) "Open a URI in Safari using AppleScript. This preserves anchors." (let ((script (format " tell application \"Safari\" diff --git a/elisp/ghc-func.el b/elisp/ghc-func.el index 83d1840..34eff59 100644 --- a/elisp/ghc-func.el +++ b/elisp/ghc-func.el @@ -18,9 +18,10 @@ (defun ghc-replace-character (string from to) "Replace characters equal to FROM to TO in STRING." (let ((ret (copy-sequence string))) - (dotimes (cnt (length ret) ret) + (dotimes (cnt (length ret)) (if (char-equal (aref ret cnt) from) - (aset ret cnt to))))) + (aset ret cnt to))) + ret)) (defun ghc-replace-character-buffer (from-c to-c) (let ((from (char-to-string from-c)) @@ -66,7 +67,7 @@ (dolist (lst lol) (dolist (key lst) (puthash key key hash))) - (maphash (lambda (key val) (ghc-add ret key)) hash) + (maphash (lambda (key _val) (ghc-add ret key)) hash) ret)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -90,8 +91,9 @@ (condition-case nil (let ((m (set-marker (make-marker) 1 (current-buffer))) ret) - (dotimes (i n (nreverse ret)) - (ghc-add ret (read m)))) + (dotimes (_i n) + (ghc-add ret (read m))) + (nreverse ret)) (error ())))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -108,10 +110,11 @@ (defun ghc-keyword-number-pair (spec) (let ((len (length spec)) key ret) - (dotimes (i len (nreverse ret)) + (dotimes (i len) (setq key (intern (concat ":" (symbol-name (car spec))))) (setq ret (cons (cons key i) ret)) - (setq spec (cdr spec))))) + (setq spec (cdr spec))) + (nreverse ret))) (defmacro ghc-defstruct (type &rest spec) `(progn diff --git a/elisp/ghc-indent.el b/elisp/ghc-indent.el index 3f1de9e..519cce5 100644 --- a/elisp/ghc-indent.el +++ b/elisp/ghc-indent.el @@ -10,11 +10,11 @@ (defvar ghc-indent-offset 4) -(defun ghc-make-indent-shallower (beg end) +(defun ghc-make-indent-shallower (_beg _end) (interactive "r") (indent-rigidly (region-beginning) (region-end) (- ghc-indent-offset))) -(defun ghc-make-indent-deeper (beg end) +(defun ghc-make-indent-deeper (_beg _end) (interactive "r") (indent-rigidly (region-beginning) (region-end) ghc-indent-offset)) diff --git a/elisp/ghc-info.el b/elisp/ghc-info.el index d7854c5..abe4356 100644 --- a/elisp/ghc-info.el +++ b/elisp/ghc-info.el @@ -63,7 +63,7 @@ (cons 'ghc-type-clear-overlay after-change-functions)) (add-hook 'post-command-hook 'ghc-type-post-command-hook)) -(defun ghc-type-clear-overlay (&optional beg end len) +(defun ghc-type-clear-overlay (&optional _beg _end _len) (when (overlayp ghc-type-overlay) (ghc-type-set-ix 0) (ghc-type-set-point 0) diff --git a/elisp/ghc-process.el b/elisp/ghc-process.el index 94dc5d7..3e0c4a5 100644 --- a/elisp/ghc-process.el +++ b/elisp/ghc-process.el @@ -141,7 +141,7 @@ (funcall ghc-process-callback 'ng) (setq ghc-process-running nil))))))) -(defun ghc-process-sentinel (process event) +(defun ghc-process-sentinel (_process _event) (setq ghc-process-running nil)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/elisp/ghc-rewrite.el b/elisp/ghc-rewrite.el index e8087a9..20f7f69 100644 --- a/elisp/ghc-rewrite.el +++ b/elisp/ghc-rewrite.el @@ -126,12 +126,9 @@ (lambda () (insert "Possible completions:\n") (mapc - (lambda (x) - (let* (; (ins1 (insert "- ")) - (pos-begin (point)) - (ins (insert x)) - (pos-end (point)) - (ins3 (insert "\n"))) + (lambda (_x) + (let ((pos-begin (point)) + (pos-end (point))) (make-button pos-begin pos-end :type 'auto-button))) (ghc-sinfo-get-info info)))) (select-window (ghc-auto-completion-window)))) From afe8f69ab98ddf7924d22134e75be331d6722efc Mon Sep 17 00:00:00 2001 From: Kazu Yamamoto Date: Wed, 19 Aug 2015 15:39:09 +0900 Subject: [PATCH 4/6] removing unused variable. --- elisp/ghc-doc.el | 1 - 1 file changed, 1 deletion(-) diff --git a/elisp/ghc-doc.el b/elisp/ghc-doc.el index 42790dd..8142a83 100644 --- a/elisp/ghc-doc.el +++ b/elisp/ghc-doc.el @@ -68,7 +68,6 @@ end tell" uri))) (mod- (ghc-replace-character mod ?. ?-)) (ver (ghc-pkg-ver-path-get-ver pkg-ver-path)) (path (ghc-pkg-ver-path-get-path pkg-ver-path)) - (pkg-with-ver (format "%s-%s" pkg ver)) (local (format ghc-doc-local-format path mod-)) (remote (format ghc-doc-hackage-format pkg ver mod-)) (file (format "%s/%s.html" path mod-)) From f0a98cf64f798cc79f82e88f48df6e347faa299d Mon Sep 17 00:00:00 2001 From: Kazu Yamamoto Date: Wed, 19 Aug 2015 15:41:08 +0900 Subject: [PATCH 5/6] removing unused variable. --- elisp/ghc-check.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/elisp/ghc-check.el b/elisp/ghc-check.el index d02142a..4b85773 100644 --- a/elisp/ghc-check.el +++ b/elisp/ghc-check.el @@ -136,7 +136,7 @@ nil do not display errors/warnings. (defun ghc-to-info (errs) ;; [^\t] to include \n. (let ((regex "^\\([^\n]*\\):\\([0-9]+\\):\\([0-9]+\\): *\\([^\t]+\\)") - info infos) + infos) (dolist (err errs (nreverse infos)) (when (string-match regex err) (let* ((file (expand-file-name (match-string 1 err) ghc-process-root)) ;; for Windows From 26d72b0b88266ad6fe87bc96a827eb568ac84f83 Mon Sep 17 00:00:00 2001 From: Kazu Yamamoto Date: Thu, 20 Aug 2015 11:33:55 +0900 Subject: [PATCH 6/6] supporting map-file in Emacs frontend. --- elisp/ghc-process.el | 48 +++++++++++++++++++++++++++++++++++--------- 1 file changed, 38 insertions(+), 10 deletions(-) diff --git a/elisp/ghc-process.el b/elisp/ghc-process.el index 3e0c4a5..47ceb24 100644 --- a/elisp/ghc-process.el +++ b/elisp/ghc-process.el @@ -16,6 +16,7 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defvar ghc-process-running nil) +(defvar ghc-process-file-mapping nil) (defvar-local ghc-process-process-name nil) (defvar-local ghc-process-original-buffer nil) @@ -48,15 +49,38 @@ (ghc-with-current-buffer buf (setq ghc-process-original-buffer cbuf) (setq ghc-process-original-file file) - (setq ghc-process-callback callback) (setq ghc-process-hook hook2) (setq ghc-process-root root) - (erase-buffer) - (let ((pro (ghc-get-process cpro name buf))) - (process-send-string pro cmd) + (let ((pro (ghc-get-process cpro name buf)) + (map-cmd (format "map-file %s\n" file))) + ;; map-file + (setq ghc-process-file-mapping t) + (setq ghc-process-callback nil) + (erase-buffer) + (when ghc-debug + (ghc-with-debug-buffer + (insert (format "%% %s" map-cmd)) + (insert "CONTENTS + EOT\n"))) + (process-send-string pro map-cmd) + (with-current-buffer cbuf + (save-restriction + (widen) + (process-send-region pro (point-min) (point-max)))) + (process-send-string pro "\004\n") + (condition-case nil + (let ((inhibit-quit nil)) + (while ghc-process-file-mapping + (accept-process-output pro 0.1 nil t))) + (quit + (setq ghc-process-running nil) + (setq ghc-process-file-mapping nil))) + ;; command + (setq ghc-process-callback callback) + (erase-buffer) (when ghc-debug (ghc-with-debug-buffer (insert (format "%% %s" cmd)))) + (process-send-string pro cmd) pro)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -71,11 +95,12 @@ (t cpro))) (defun ghc-start-process (name buf) - (let* ((opts (append ghc-debug-options + (let* ((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) '("legacy-interactive"))) - (pro (apply 'start-file-process name buf ghc-command opts))) + (pro (apply 'start-process name buf ghc-command opts))) (set-process-filter pro 'ghc-process-filter) (set-process-sentinel pro 'ghc-process-sentinel) (set-process-query-on-exit-flag pro nil) @@ -133,10 +158,13 @@ (forward-line -1) (cond ((looking-at "^OK$") - (if ghc-process-hook (funcall ghc-process-hook)) - (goto-char (point-min)) - (funcall ghc-process-callback 'ok) - (setq ghc-process-running nil)) + (delete-region (point) (point-max)) + (setq ghc-process-file-mapping nil) + (when ghc-process-callback + (if ghc-process-hook (funcall ghc-process-hook)) + (goto-char (point-min)) + (funcall ghc-process-callback 'ok) + (setq ghc-process-running nil))) ((looking-at "^NG ") (funcall ghc-process-callback 'ng) (setq ghc-process-running nil)))))))