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

annot -> type.

Browse Source
This commit is contained in:
Kazu Yamamoto 2012-02-13 13:38:06 +09:00
parent a43985a735
commit 11eb321ff6
2 changed files with 20 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
Info.hs
View File

@ -62,10 +62,10 @@ typeOf opt fileName modstr lineNo colNo = inModuleContext opt fileName modstr ex
#else #else
l spn | isGoodSrcSpan spn l spn | isGoodSrcSpan spn
#endif #endif
= ("("++) . (++")") . unwords . map show $ = unwords . map show $
[ srcSpanStartLine spn, srcSpanStartCol spn [ srcSpanStartLine spn, srcSpanStartCol spn
, srcSpanEndLine spn, srcSpanEndCol spn ] , srcSpanEndLine spn, srcSpanEndCol spn ]
l _ = "(0 0 0 0)" l _ = "0 0 0 0"
cmp a b cmp a b
| a `isSubspanOf` b = O.LT | a `isSubspanOf` b = O.LT

31
elisp/ghc-info.el
View File

@ -62,15 +62,17 @@
(defun ghc-type-get-types () (defun ghc-type-get-types ()
(overlay-get ghc-type-overlay 'types)) (overlay-get ghc-type-overlay 'types))
(ghc-defstruct tinfo beg-line beg-column end-line end-column info)
(defun ghc-type-init () (defun ghc-type-init ()
(setq ghc-type-overlay (make-overlay 0 0)) (setq ghc-type-overlay (make-overlay 0 0))
(overlay-put ghc-type-overlay 'face 'region) (overlay-put ghc-type-overlay 'face 'region)
(ghc-type-set-ix 0) (ghc-type-set-ix 0)
(ghc-type-set-point 0) (ghc-type-set-point 0)
(setq after-change-functions (setq after-change-functions
(cons 'ghc-delete-type-ovl after-change-functions))) (cons 'ghc-type-deleve-overlay after-change-functions)))
(defun ghc-delete-type-ovl (beg end len) (defun ghc-type-deleve-overlay (beg end len)
(when (overlayp ghc-type-overlay) (when (overlayp ghc-type-overlay)
(delete-overlay ghc-type-overlay))) (delete-overlay ghc-type-overlay)))
@ -85,25 +87,28 @@
(defun ghc-show-type0 (modname) (defun ghc-show-type0 (modname)
(let* ((buf (current-buffer)) (let* ((buf (current-buffer))
(types (ghc-get-type modname)) (tinfos (ghc-type-get-tinfos modname))
(tinfo (nth (ghc-type-get-ix) types)) (tinfo (nth (ghc-type-get-ix) tinfos))
(pos (nth 0 tinfo)) (type (ghc-tinfo-get-info tinfo))
(type (nth 1 tinfo)) (beg-line (ghc-tinfo-get-beg-line tinfo))
(left (ghc-get-pos buf (nth 0 pos) (nth 1 pos))) (beg-column (ghc-tinfo-get-beg-column tinfo))
(right (ghc-get-pos buf (nth 2 pos) (nth 3 pos)))) (end-line (ghc-tinfo-get-end-line tinfo))
(move-overlay ghc-type-overlay (- left 1) (- right 1) buf) (end-column (ghc-tinfo-get-end-column tinfo))
(message type))) (left (ghc-get-pos buf beg-line beg-column))
(right (ghc-get-pos buf end-line end-column)))
(move-overlay ghc-type-overlay (- left 1) (- right 1) buf)
(message type)))
(defun ghc-get-type (modname) (defun ghc-type-get-tinfos (modname)
(if (= (ghc-type-get-point) (point)) (if (= (ghc-type-get-point) (point))
(ghc-type-set-ix (ghc-type-set-ix
(mod (1+ (ghc-type-get-ix)) (length (ghc-type-get-types)))) (mod (1+ (ghc-type-get-ix)) (length (ghc-type-get-types))))
(ghc-type-set-types (ghc-call-type modname)) (ghc-type-set-types (ghc-type-obtain-tinfos modname))
(ghc-type-set-point (point)) (ghc-type-set-point (point))
(ghc-type-set-ix 0)) (ghc-type-set-ix 0))
(ghc-type-get-types)) (ghc-type-get-types))
(defun ghc-call-type (modname) (defun ghc-type-obtain-tinfos (modname)
(let* ((ln (int-to-string (line-number-at-pos))) (let* ((ln (int-to-string (line-number-at-pos)))
(cn (int-to-string (current-column))) (cn (int-to-string (current-column)))
(cdir default-directory) (cdir default-directory)