ghc-check-display-errors.

This commit is contained in:
Kazu Yamamoto 2014-03-19 22:57:05 +09:00
parent 1ffc425caa
commit 3e64fb2935
3 changed files with 33 additions and 5 deletions

View File

@ -8,6 +8,13 @@
;;; Code: ;;; Code:
;; other files' errors should go to 0
;; ghc-flymake-display-errors -> line column
;; ghc-flymake-jump
;; flymake-goto-prev-error
;; flymake-goto-next-error
;; no need to save
(require 'ghc-func) (require 'ghc-func)
(defvar-local ghc-check-running nil) (defvar-local ghc-check-running nil)
@ -85,14 +92,16 @@
(infos (infos
(ghc-check-highlight-original-buffer ghc-check-original-buffer infos)) (ghc-check-highlight-original-buffer ghc-check-original-buffer infos))
(t (t
(message "No changes"))) (with-current-buffer ghc-check-original-buffer
(remove-overlays (point-min) (point-max) 'ghc-check t))
;; fixme no changes
))
(setq ghc-check-running nil)))))) (setq ghc-check-running nil))))))
(defun ghc-check-process-sentinel () (defun ghc-check-process-sentinel ()
) )
(defun ghc-check-highlight-original-buffer (buf infos) (defun ghc-check-highlight-original-buffer (buf infos)
(message "%s" infos)
(with-current-buffer buf (with-current-buffer buf
(remove-overlays (point-min) (point-max) 'ghc-check t) (remove-overlays (point-min) (point-max) 'ghc-check t)
(save-excursion (save-excursion
@ -101,7 +110,8 @@
(let ((line (ghc-hilit-info-get-line info)) (let ((line (ghc-hilit-info-get-line info))
(msg (ghc-hilit-info-get-msg info)) (msg (ghc-hilit-info-get-msg info))
beg end ovl) beg end ovl)
(goto-line line) (goto-char (point-min))
(forward-line (1- line))
(while (eq (char-after) 32) (forward-char)) (while (eq (char-after) 32) (forward-char))
(setq beg (point)) (setq beg (point))
(forward-line) (forward-line)
@ -131,5 +141,22 @@
"Face used for marking warning lines." "Face used for marking warning lines."
:group 'ghc) :group 'ghc)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun ghc-check-display-errors ()
(interactive)
(let* ((ovls (ghc-check-overlay-here))
(errs (mapcar (lambda (ovl) (overlay-get ovl 'ghc-msg)) ovls)))
(if (null ovls)
(message "No errors or warnings")
(ghc-display
nil
(lambda ()
;; (insert title "\n\n")
(mapc (lambda (x) (insert x "\n")) errs))))))
(defun ghc-check-overlay-here ()
(let ((ovls (overlays-at (point))))
(ghc-filter (lambda (ovl) (overlay-get ovl 'ghc-check)) ovls)))
(provide 'ghc-check) (provide 'ghc-check)

View File

@ -40,7 +40,8 @@
(defun ghc-save-buffer () (defun ghc-save-buffer ()
(interactive) (interactive)
(if (buffer-modified-p) (call-interactively 'save-buffer)) (if (buffer-modified-p) (save-buffer))
;; (if (buffer-modified-p) (call-interactively 'save-buffer))
(ghc-check-syntax)) (ghc-check-syntax))
(provide 'ghc-command) (provide 'ghc-command)

View File

@ -76,7 +76,7 @@
(define-key haskell-mode-map ghc-import-key 'ghc-import-module) (define-key haskell-mode-map ghc-import-key 'ghc-import-module)
;; (define-key haskell-mode-map ghc-previous-key 'flymake-goto-prev-error) ;; (define-key haskell-mode-map ghc-previous-key 'flymake-goto-prev-error)
;; (define-key haskell-mode-map ghc-next-key 'flymake-goto-next-error) ;; (define-key haskell-mode-map ghc-next-key 'flymake-goto-next-error)
;; (define-key haskell-mode-map ghc-help-key 'ghc-flymake-display-errors) (define-key haskell-mode-map ghc-help-key 'ghc-check-display-errors)
(define-key haskell-mode-map ghc-insert-key 'ghc-insert-template) (define-key haskell-mode-map ghc-insert-key 'ghc-insert-template)
(define-key haskell-mode-map ghc-sort-key 'ghc-sort-lines) (define-key haskell-mode-map ghc-sort-key 'ghc-sort-lines)
(define-key haskell-mode-map ghc-check-key 'ghc-save-buffer) (define-key haskell-mode-map ghc-check-key 'ghc-save-buffer)