hasufell/ghc-mod
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Add special commands for navigating holes

Browse Source
This commit is contained in:
Alejandro Serrano 2014-07-27 11:10:37 +02:00
parent 5cc884ef47
commit 82f7fd62f0
3 changed files with 41 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
elisp/ghc-check.el
View File

@ -52,6 +52,13 @@ nil does not display errors/warnings.
'other-buffer displays errors/warnings in the other buffer.
")
(defvar ghc-display-hole 'other-buffer
"*An action to display hole information for 'C-c C-j' and 'C-c C-h'
'minibuffer displays errors/warnings in the minibuffer.
'other-buffer displays errors/warnings in the other buffer"
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun ghc-check-syntax ()
@ -156,6 +163,7 @@ nil does not display errors/warnings.
(overlay-put ovl 'ghc-file file)
(overlay-put ovl 'ghc-msg msg)
(overlay-put ovl 'help-echo msg)
(overlay-put ovl 'ghc-hole hole)
(let ((fringe (if err ghc-check-error-fringe (if hole ghc-check-hole-fringe ghc-check-warning-fringe)))
(face (if err 'ghc-face-error (if hole 'ghc-face-hole 'ghc-face-warn))))
(overlay-put ovl 'before-string fringe)
@ -236,6 +244,34 @@ nil does not display errors/warnings.
((eq ghc-display-error 'minibuffer) (ghc-display-errors-to-minibuf))
((eq ghc-display-error 'other-buffer) (ghc-display-errors))))
(defun ghc-goto-prev-hole ()
(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))
(ovls3 (ghc-filter (lambda (ovl) (overlay-get ovl 'ghc-hole)) ovls2))
(pnts (mapcar 'overlay-start ovls3)))
(if pnts (goto-char (apply 'max pnts))))
(cond
((eq ghc-display-hole 'minibuffer) (ghc-display-errors-to-minibuf))
((eq ghc-display-hole 'other-buffer) (ghc-display-errors))))
(defun ghc-goto-next-hole ()
(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))
(ovls3 (ghc-filter (lambda (ovl) (overlay-get ovl 'ghc-hole)) ovls2))
(pnts (mapcar 'overlay-start ovls3)))
(if pnts (goto-char (apply 'min pnts))))
(cond
((eq ghc-display-hole 'minibuffer) (ghc-display-errors-to-minibuf))
((eq ghc-display-hole 'other-buffer) (ghc-display-errors))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun ghc-check-insert-from-warning ()

3
elisp/ghc-func.el
View File

@ -158,8 +158,7 @@
(turn-on-haskell-font-lock)))
(display-buffer buf
'((display-buffer-reuse-window
display-buffer-pop-up-window)
(window-height . 20))))))
display-buffer-pop-up-window))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

4
elisp/ghc.el
View File

@ -76,6 +76,8 @@
(defvar ghc-case-split-key "\C-c\C-s")
(defvar ghc-initial-sig-key "\C-c\C-g")
(defvar ghc-refine-key "\C-c\C-r")
(defvar ghc-prev-hole-key "\C-c\ep")
(defvar ghc-next-hole-key "\C-c\en")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
@ -111,6 +113,8 @@
(define-key haskell-mode-map ghc-case-split-key 'ghc-case-split)
(define-key haskell-mode-map ghc-initial-sig-key 'ghc-initial-code-from-signature)
(define-key haskell-mode-map ghc-refine-key 'ghc-refine)
(define-key haskell-mode-map ghc-prev-hole-key 'ghc-goto-prev-hole)
(define-key haskell-mode-map ghc-next-hole-key 'ghc-goto-next-hole)
(ghc-comp-init)
(setq ghc-initialized t))
(ghc-import-module)