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

integrating display functions.

This commit is contained in:
Kazu Yamamoto 2012-03-06 17:12:15 +09:00
parent 3178393c85
commit 41fe35b691
3 changed files with 44 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
elisp/ghc-flymake.el
View File

@ -19,8 +19,6 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defconst ghc-error-buffer-name "*GHC Errors*")
(defconst ghc-flymake-allowed-file-name-masks
'("\\.l?hs$" ghc-flymake-init flymake-simple-cleanup ghc-flymake-get-real-file-name))
@ -71,18 +69,13 @@
(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))))
(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)))
(ghc-display
nil
(lambda (&rest ignore)
(insert title "\n\n")
(mapc (lambda (x) (insert x "\n")) errs))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

26
elisp/ghc-func.el
View File

@ -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)
@ -145,4 +153,22 @@
(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)

29
elisp/ghc-info.el
View File

@ -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)))))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;