Merge branch 'master' of github.com:kazu-yamamoto/ghc-mod

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)

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'`
 

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
@@ -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")))))
 

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\"
@@ -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-))

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

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))
 

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)

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,15 +158,18 @@
 	(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)))))))
 
-(defun ghc-process-sentinel (process event)
+(defun ghc-process-sentinel (_process _event)
   (setq ghc-process-running nil))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

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))))