stop using 0 as the line separator.

This commit is contained in:
Kazu Yamamoto 2014-04-19 16:14:02 +09:00
parent 8d866d7a5b
commit 47f95149e3
4 changed files with 36 additions and 38 deletions

View File

@ -69,22 +69,8 @@ nil does not display errors/warnings.
"]")))
(defun ghc-check-callback ()
(let ((regex "^\\([^\n\0]*\\):\\([0-9]+\\):\\([0-9]+\\): *\\(.+\\)")
info infos)
(while (re-search-forward regex nil t)
(let* ((file (expand-file-name (match-string 1))) ;; for Windows
(line (string-to-number (match-string 2)))
;; don't take column to make multiple same errors to a single.
(msg (match-string 4))
(err (not (string-match "^Warning" msg)))
(info (ghc-make-hilit-info
:file file
:line line
:msg msg
:err err)))
(unless (member info infos)
(setq infos (cons info infos)))))
(setq infos (nreverse infos))
(let* ((errs (ghc-read-lisp-this-buffer))
(infos (ghc-to-info errs)))
(cond
(infos
(let ((file ghc-process-original-file)
@ -102,6 +88,25 @@ nil does not display errors/warnings.
(wlen (- len elen)))
(setq mode-line-process (format " %d:%d" elen wlen))))))))
(defun ghc-to-info (errs)
;; [^\t] to include \n.
(let ((regex "^\\([^\n]*\\):\\([0-9]+\\):\\([0-9]+\\): *\\([^\t]+\\)")
info infos)
(dolist (err errs (nreverse infos))
(when (string-match regex err)
(let* ((file (expand-file-name (match-string 1 err))) ;; for Windows
(line (string-to-number (match-string 2 err)))
;; don't take column to make multiple same errors to a single.
(msg (match-string 4 err))
(wrn (string-match "^Warning" msg))
(info (ghc-make-hilit-info
:file file
:line line
:msg msg
:err (not wrn))))
(unless (member info infos)
(ghc-add infos info)))))))
(defun ghc-check-highlight-original-buffer (ofile buf infos)
(with-current-buffer buf
(remove-overlays (point-min) (point-max) 'ghc-check t)
@ -131,8 +136,7 @@ nil does not display errors/warnings.
(overlay-put ovl 'ghc-check t)
(overlay-put ovl 'ghc-file file)
(overlay-put ovl 'ghc-msg msg)
(let ((echo (ghc-replace-character msg ?\0 ?\n)))
(overlay-put ovl 'help-echo echo))
(overlay-put ovl 'help-echo msg)
(let ((fringe (if err ghc-check-error-fringe ghc-check-warning-fringe))
(face (if err 'ghc-face-error 'ghc-face-warn)))
(overlay-put ovl 'before-string fringe)
@ -179,7 +183,7 @@ nil does not display errors/warnings.
(message "No errors or warnings")
(let* ((file (ghc-file-msgs-get-file file-msgs))
(msgs (ghc-file-msgs-get-msgs file-msgs))
(errmsg (mapconcat (lambda (x) (replace-regexp-in-string "\0" "\n" x)) msgs "\n"))
(errmsg (mapconcat 'identity msgs "\n"))
(buffile buffer-file-name))
(if (string-equal buffile file)
(message "%s" errmsg)
@ -231,10 +235,10 @@ nil does not display errors/warnings.
(if (not (bolp)) (insert "\n")))
(insert (match-string 1) " = undefined\n")))
;; GHC 7.8 uses Unicode for single-quotes.
((string-match "Not in scope: type constructor or class .\\([^\n\0]+\\)." data)
((string-match "Not in scope: type constructor or class .\\([^\n]+\\)." data)
(let ((sym (match-string 1 data)))
(ghc-ins-mod sym)))
((string-match "Not in scope: .\\([^\n\0]+\\)." data)
((string-match "Not in scope: .\\([^\n]+\\)." data)
(let ((sym (match-string 1 data)))
(if (or (string-match "\\." sym) ;; qualified
(y-or-n-p (format "Import module for %s?" sym)))
@ -247,7 +251,8 @@ nil does not display errors/warnings.
(let* ((fn (ghc-get-function-name))
(arity (ghc-get-function-arity fn)))
(ghc-insert-underscore fn arity)))
((string-match "Found:\0[ ]*\\([^\0]+\\)\0Why not:\0[ ]*\\([^\0]+\\)" data)
;; fixme
((string-match "Found:\n[ ]*\\([^\n]+\\)\nWhy not:\n[ ]*\\([^\n]+\\)" data)
(let ((old (match-string 1 data))
(new (match-string 2 data)))
(beginning-of-line)
@ -263,11 +268,11 @@ nil does not display errors/warnings.
(with-temp-buffer
(insert str)
(goto-char (point-min))
(when (re-search-forward "Inferred type: \\|no type signature:\\( \\|\0 +\\)?" nil t)
(when (re-search-forward "Inferred type: \\|no type signature:\\( \\|\n +\\)?" nil t)
(delete-region (point-min) (point)))
(when (re-search-forward " forall [^.]+\\." nil t)
(replace-match ""))
(while (re-search-forward "\0 +" nil t)
(while (re-search-forward "\n +" nil t)
(replace-match " "))
(goto-char (point-min))
(while (re-search-forward "\\[Char\\]" nil t)

View File

@ -63,6 +63,10 @@
(defun ghc-read-lisp (func)
(with-temp-buffer
(funcall func)
(ghc-read-lisp-this-buffer)))
(defun ghc-read-lisp-this-buffer ()
(save-excursion
(goto-char (point-min))
(condition-case nil
(read (current-buffer))
@ -86,11 +90,6 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defconst ghc-null 0)
(defconst ghc-newline 10)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun ghc-things-at-point ()
(thing-at-point 'sexp))
@ -152,7 +151,6 @@
(with-current-buffer buf
(erase-buffer)
(funcall ins-func)
(ghc-replace-character-buffer ghc-null ghc-newline)
(goto-char (point-min))
(if (not fontify)
(turn-off-haskell-font-lock)

View File

@ -89,13 +89,8 @@
(concat "find " fun "\n"))
(defun ghc-ins-mod-callback ()
(let (lines line beg)
(while (not (eobp))
(setq beg (point))
(forward-line)
(setq line (buffer-substring-no-properties beg (1- (point))))
(setq lines (cons line lines)))
(let ((mods (ghc-read-lisp-this-buffer)))
(setq ghc-ins-mod-rendezvous t)
(setq ghc-ins-mod-results (nreverse (cdr lines))))) ;; removing "OK"
(setq ghc-ins-mod-results mods))) ;; fixme -- OK
(provide 'ghc-ins-mod)

View File

@ -66,7 +66,7 @@
(t cpro)))
(defun ghc-start-process (name buf)
(let ((pro (start-file-process name buf ghc-interactive-command)))
(let ((pro (start-file-process name buf ghc-interactive-command "-b" "\n" "-l")))
(set-process-filter pro 'ghc-process-filter)
(set-process-query-on-exit-flag pro nil)
pro))