ghc-goto-next-error.

This commit is contained in:
Kazu Yamamoto 2014-03-20 15:32:54 +09:00
parent 3e64fb2935
commit 3f01b15a3e
3 changed files with 32 additions and 12 deletions

View File

@ -11,9 +11,6 @@
;; 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)
@ -110,6 +107,8 @@
(let ((line (ghc-hilit-info-get-line info))
(msg (ghc-hilit-info-get-msg info))
beg end ovl)
;; FIXME: This is the Shlemiel painter's algorithm.
;; If this is a bottleneck for a large code, let's fix.
(goto-char (point-min))
(forward-line (1- line))
(while (eq (char-after) 32) (forward-char))
@ -143,9 +142,9 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun ghc-check-display-errors ()
(defun ghc-display-errors ()
(interactive)
(let* ((ovls (ghc-check-overlay-here))
(let* ((ovls (ghc-check-overlay-at (point)))
(errs (mapcar (lambda (ovl) (overlay-get ovl 'ghc-msg)) ovls)))
(if (null ovls)
(message "No errors or warnings")
@ -155,8 +154,30 @@
;; (insert title "\n\n")
(mapc (lambda (x) (insert x "\n")) errs))))))
(defun ghc-check-overlay-here ()
(let ((ovls (overlays-at (point))))
(defun ghc-check-overlay-at (p)
(let ((ovls (overlays-at p)))
(ghc-filter (lambda (ovl) (overlay-get ovl 'ghc-check)) ovls)))
(defun ghc-goto-prev-error ()
(interactive)
(let* ((here (point))
(ovls0 (ghc-check-overlay-at here))
(end (if ovls0 (overlay-start (car ovls0)) here))
(ovls1 (overlays-in (point-min) end))
(ovls2 (ghc-filter (lambda (ovl) (overlay-get ovl 'ghc-check)) ovls1))
(pnts0 (mapcar 'overlay-start ovls2))
(pnts1 (sort pnts0 '>)))
(if pnts1 (goto-char (car pnts1)))))
(defun ghc-goto-next-error ()
(interactive)
(let* ((here (point))
(ovls0 (ghc-check-overlay-at here))
(beg (if ovls0 (overlay-end (car ovls0)) here))
(ovls1 (overlays-in beg (point-max)))
(ovls2 (ghc-filter (lambda (ovl) (overlay-get ovl 'ghc-check)) ovls1))
(pnts0 (mapcar 'overlay-start ovls2))
(pnts1 (sort pnts0 '<)))
(if pnts1 (goto-char (car pnts1)))))
(provide 'ghc-check)

View File

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

View File

@ -74,9 +74,9 @@
(define-key haskell-mode-map ghc-expand-key 'ghc-expand-th)
;; (define-key haskell-mode-map ghc-jump-key 'ghc-flymake-jump) ;; fixme
(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-next-key 'flymake-goto-next-error)
(define-key haskell-mode-map ghc-help-key 'ghc-check-display-errors)
(define-key haskell-mode-map ghc-previous-key 'ghc-goto-prev-error)
(define-key haskell-mode-map ghc-next-key 'ghc-goto-next-error)
(define-key haskell-mode-map ghc-help-key 'ghc-display-errors)
(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-check-key 'ghc-save-buffer)