diff --git a/ErrMsg.hs b/ErrMsg.hs --- a/ErrMsg.hs +++ b/ErrMsg.hs @@ -14,7 +14,6 @@ import qualified Gap import HscTypes import Outputable -import System.FilePath ---------------------------------------------------------------- @@ -54,7 +53,7 @@ ppMsg spn msg stl = fromMaybe def $ do (line,col,_,_) <- Gap.getSrcSpan spn file <- Gap.getSrcFile spn - return $ takeFileName file ++ ":" ++ show line ++ ":" ++ show col ++ ":" ++ cts ++ "\0" + return $ file ++ ":" ++ show line ++ ":" ++ show col ++ ":" ++ cts ++ "\0" where def = "ghc-mod:0:0:Probably mutual module import occurred\0" cts = showMsg msg stl diff --git a/elisp/Makefile b/elisp/Makefile --- a/elisp/Makefile +++ b/elisp/Makefile @@ -1,5 +1,5 @@ SRCS = ghc.el ghc-func.el ghc-doc.el ghc-comp.el ghc-flymake.el \ - ghc-command.el ghc-info.el ghc-ins-mod.el + ghc-command.el ghc-info.el ghc-ins-mod.el ghc-indent.el EMACS = emacs DETECT = xemacs diff --git a/elisp/ghc-flymake.el b/elisp/ghc-flymake.el --- a/elisp/ghc-flymake.el +++ b/elisp/ghc-flymake.el @@ -19,10 +19,8 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defconst ghc-error-buffer-name "*GHC Errors*") - (defconst ghc-flymake-allowed-file-name-masks - '("\\.l?hs$" ghc-flymake-init flymake-simple-cleanup flymake-get-real-file-name)) + '("\\.l?hs$" ghc-flymake-init flymake-simple-cleanup ghc-flymake-get-real-file-name)) (defconst ghc-flymake-err-line-patterns '("^\\(.*\\.l?hs\\):\\([0-9]+\\):\\([0-9]+\\):[ ]*\\(.+\\)" 1 2 3 4)) @@ -58,23 +56,39 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defun ghc-flymake-get-real-file-name (path) + (let ((bufnam (buffer-name)) + (filnam (file-name-nondirectory path))) + (if (string= bufnam filnam) + bufnam + path))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (defun ghc-flymake-display-errors () (interactive) (if (not (ghc-flymake-have-errs-p)) (message "No errors or warnings") - (let ((buf (get-buffer-create ghc-error-buffer-name)) - (title (ghc-flymake-err-title)) + (let ((title (ghc-flymake-err-title)) (errs (ghc-flymake-err-list))) - (with-current-buffer buf - (erase-buffer) - (ghc-flymake-insert-errors title errs)) - (display-buffer buf)))) + (ghc-display + nil + (lambda (&rest ignore) + (insert title "\n\n") + (mapc (lambda (x) (insert x "\n")) errs)))))) -(defun ghc-flymake-insert-errors (title errs) - (save-excursion - (insert title "\n\n") - (mapc (lambda (x) (insert (ghc-replace-character x ghc-null ghc-newline) "\n")) errs))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defun ghc-flymake-jump () + (interactive) + (if (not (ghc-flymake-have-errs-p)) + (message "No errors or warnings") + (let* ((acts (ghc-flymake-act-list)) + (act (car acts))) + (if (not act) + (message "No destination") + (eval act))))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun ghc-extract-type (str) @@ -166,6 +180,9 @@ (defun ghc-flymake-err-get-title (x) (nth 0 x)) (defun ghc-flymake-err-get-errs (x) (nth 1 x)) +(defun ghc-flymake-err-get-err-msg (x) (nth 0 x)) +(defun ghc-flymake-err-get-err-act (x) (nth 1 x)) + (defalias 'ghc-flymake-have-errs-p 'ghc-flymake-data) (defun ghc-flymake-data () @@ -177,6 +194,9 @@ (ghc-flymake-err-get-title (ghc-flymake-data))) (defun ghc-flymake-err-list () - (mapcar 'car (ghc-flymake-err-get-errs (ghc-flymake-data)))) + (mapcar 'ghc-flymake-err-get-err-msg (ghc-flymake-err-get-errs (ghc-flymake-data)))) + +(defun ghc-flymake-act-list () + (mapcar 'ghc-flymake-err-get-err-act (ghc-flymake-err-get-errs (ghc-flymake-data)))) (provide 'ghc-flymake) diff --git a/elisp/ghc-func.el b/elisp/ghc-func.el --- a/elisp/ghc-func.el +++ b/elisp/ghc-func.el @@ -22,6 +22,14 @@ (if (char-equal (aref ret cnt) from) (aset ret cnt to))))) +(defun ghc-replace-character-buffer (from-c to-c) + (let ((from (char-to-string from-c)) + (to (char-to-string to-c))) + (save-excursion + (goto-char (point-min)) + (while (search-forward from nil t) + (replace-match to))))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defmacro ghc-add (sym val) @@ -144,5 +152,23 @@ (defun ghc-make-ghc-options () (ghc-mapconcat (lambda (x) (list "-g" x)) ghc-ghc-options)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defconst ghc-error-buffer-name "*GHC Info*") + +(defun ghc-display (fontify ins-func) + (let ((cdir default-directory) + (buf (get-buffer-create ghc-error-buffer-name))) + (with-current-buffer buf + (erase-buffer) + (funcall ins-func cdir) + (ghc-replace-character-buffer ghc-null ghc-newline) + (goto-char (point-min)) + (if (not fontify) + (turn-off-haskell-font-lock) + (haskell-font-lock-defaults-create) + (turn-on-haskell-font-lock))) + (display-buffer buf))) (provide 'ghc-func) diff --git a/elisp/ghc-indent.el b/elisp/ghc-indent.el new file mode 100644 --- /dev/null +++ b/elisp/ghc-indent.el @@ -0,0 +1,35 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; ghc-indent.el +;;; + +;; Author: Kazu Yamamoto +;; Created: Feb 28, 2012 + +;;; Code: + +(defvar ghc-indent-offset 4) + +(defun ghc-make-indent-shallower (beg end) + (interactive "r") + (let ((n ghc-indent-offset)) + (save-excursion + (save-restriction + (narrow-to-region beg end) + (goto-char beg) + (while (not (eobp)) + (delete-region (point) (+ (point) n)) + (forward-line)))))) + +(defun ghc-make-indent-deeper (beg end) + (interactive "r") + (let ((indent (make-string ghc-indent-offset 32))) + (save-excursion + (save-restriction + (narrow-to-region beg end) + (goto-char beg) + (while (not (eobp)) + (insert indent) + (forward-line)))))) + +(provide 'ghc-indent) diff --git a/elisp/ghc-info.el b/elisp/ghc-info.el --- a/elisp/ghc-info.el +++ b/elisp/ghc-info.el @@ -17,7 +17,7 @@ (expr (if ask (ghc-read-expression expr0) expr0)) (file (buffer-file-name)) (cmds (list "info" file modname expr))) - (ghc-display-information cmds))) + (ghc-display-information cmds nil))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; @@ -124,31 +124,26 @@ (interactive) (let* ((file (buffer-file-name)) (cmds (list "expand" file))) - (ghc-display-information cmds))) + (ghc-display-information cmds t))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Display ;;; -(defun ghc-display-information (cmds) +(defun ghc-display-information (cmds fontify) (interactive) (if (not (ghc-which ghc-module-command)) (message "%s not found" ghc-module-command) - (let ((cdir default-directory) - (buf (get-buffer-create ghc-error-buffer-name))) - (with-current-buffer buf - (erase-buffer) - (insert - (with-temp-buffer - (cd cdir) - (apply 'call-process ghc-module-command nil t nil - (append (ghc-make-ghc-options) cmds)) - (buffer-substring (point-min) (1- (point-max))))) - (goto-char (point-min)) - (haskell-font-lock-defaults-create) - (turn-on-haskell-font-lock)) - (display-buffer buf)))) + (ghc-display + fontify + (lambda (cdir) + (insert + (with-temp-buffer + (cd cdir) + (apply 'call-process ghc-module-command nil t nil + (append (ghc-make-ghc-options) cmds)) + (buffer-substring (point-min) (1- (point-max))))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; diff --git a/elisp/ghc.el b/elisp/ghc.el --- a/elisp/ghc.el +++ b/elisp/ghc.el @@ -16,7 +16,7 @@ ;;; Code: -(defconst ghc-version "1.10.10") +(defconst ghc-version "1.10.11") ;; (eval-when-compile ;; (require 'haskell-mode)) @@ -27,6 +27,7 @@ (require 'ghc-flymake) (require 'ghc-command) (require 'ghc-ins-mod) +(require 'ghc-indent) (require 'dabbrev) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -53,7 +54,10 @@ (defvar ghc-toggle-key "\C-c\C-c") (defvar ghc-module-key "\C-c\C-m") (defvar ghc-expand-key "\C-c\C-e") +(defvar ghc-jump-key "\C-c\C-j") (defvar ghc-hoogle-key (format "\C-c%c" (ghc-find-C-h))) +(defvar ghc-shallower-key "\C-c<") +(defvar ghc-deeper-key "\C-c>") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; @@ -72,6 +76,7 @@ (define-key haskell-mode-map ghc-type-key 'ghc-show-type) (define-key haskell-mode-map ghc-info-key 'ghc-show-info) (define-key haskell-mode-map ghc-expand-key 'ghc-expand-th) + (define-key haskell-mode-map ghc-jump-key 'ghc-flymake-jump) (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) @@ -82,6 +87,8 @@ (define-key haskell-mode-map ghc-toggle-key 'ghc-flymake-toggle-command) (define-key haskell-mode-map ghc-module-key 'ghc-insert-module) (define-key haskell-mode-map ghc-hoogle-key 'haskell-hoogle) + (define-key haskell-mode-map ghc-shallower-key 'ghc-make-indent-shallower) + (define-key haskell-mode-map ghc-deeper-key 'ghc-make-indent-deeper) (ghc-comp-init) (setq ghc-initialized t))) diff --git a/ghc-mod.cabal b/ghc-mod.cabal --- a/ghc-mod.cabal +++ b/ghc-mod.cabal @@ -1,5 +1,5 @@ Name: ghc-mod -Version: 1.10.10 +Version: 1.10.11 Author: Kazu Yamamoto Maintainer: Kazu Yamamoto License: BSD3 @@ -16,13 +16,15 @@ or extracts names of functions, classes, and data declarations. To use "ghc-mod" on Vim, - see + see or + Category: Development Cabal-Version: >= 1.6 Build-Type: Simple Data-Dir: elisp Data-Files: Makefile ghc.el ghc-func.el ghc-doc.el ghc-comp.el - ghc-flymake.el ghc-command.el ghc-info.el ghc-ins-mod.el + ghc-flymake.el ghc-command.el ghc-info.el + ghc-ins-mod.el ghc-indent.el Executable ghc-mod Main-Is: GHCMod.hs Other-Modules: Browse