integrating display functions.
This commit is contained in:
parent
3178393c85
commit
41fe35b691
@ -19,8 +19,6 @@
|
|||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
(defconst ghc-error-buffer-name "*GHC Errors*")
|
|
||||||
|
|
||||||
(defconst ghc-flymake-allowed-file-name-masks
|
(defconst ghc-flymake-allowed-file-name-masks
|
||||||
'("\\.l?hs$" ghc-flymake-init flymake-simple-cleanup ghc-flymake-get-real-file-name))
|
'("\\.l?hs$" ghc-flymake-init flymake-simple-cleanup ghc-flymake-get-real-file-name))
|
||||||
|
|
||||||
@ -71,18 +69,13 @@
|
|||||||
(interactive)
|
(interactive)
|
||||||
(if (not (ghc-flymake-have-errs-p))
|
(if (not (ghc-flymake-have-errs-p))
|
||||||
(message "No errors or warnings")
|
(message "No errors or warnings")
|
||||||
(let ((buf (get-buffer-create ghc-error-buffer-name))
|
(let ((title (ghc-flymake-err-title))
|
||||||
(title (ghc-flymake-err-title))
|
|
||||||
(errs (ghc-flymake-err-list)))
|
(errs (ghc-flymake-err-list)))
|
||||||
(with-current-buffer buf
|
(ghc-display
|
||||||
(erase-buffer)
|
nil
|
||||||
(ghc-flymake-insert-errors title errs))
|
(lambda (&rest ignore)
|
||||||
(display-buffer buf))))
|
(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)))
|
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
@ -22,6 +22,14 @@
|
|||||||
(if (char-equal (aref ret cnt) from)
|
(if (char-equal (aref ret cnt) from)
|
||||||
(aset ret cnt to)))))
|
(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)
|
(defmacro ghc-add (sym val)
|
||||||
@ -145,4 +153,22 @@
|
|||||||
(defun ghc-make-ghc-options ()
|
(defun ghc-make-ghc-options ()
|
||||||
(ghc-mapconcat (lambda (x) (list "-g" x)) ghc-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)
|
(provide 'ghc-func)
|
||||||
|
@ -17,7 +17,7 @@
|
|||||||
(expr (if ask (ghc-read-expression expr0) expr0))
|
(expr (if ask (ghc-read-expression expr0) expr0))
|
||||||
(file (buffer-file-name))
|
(file (buffer-file-name))
|
||||||
(cmds (list "info" file modname expr)))
|
(cmds (list "info" file modname expr)))
|
||||||
(ghc-display-information cmds)))
|
(ghc-display-information cmds nil)))
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
;;;
|
;;;
|
||||||
@ -124,31 +124,26 @@
|
|||||||
(interactive)
|
(interactive)
|
||||||
(let* ((file (buffer-file-name))
|
(let* ((file (buffer-file-name))
|
||||||
(cmds (list "expand" file)))
|
(cmds (list "expand" file)))
|
||||||
(ghc-display-information cmds)))
|
(ghc-display-information cmds t)))
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
;;;
|
;;;
|
||||||
;;; Display
|
;;; Display
|
||||||
;;;
|
;;;
|
||||||
|
|
||||||
(defun ghc-display-information (cmds)
|
(defun ghc-display-information (cmds fontify)
|
||||||
(interactive)
|
(interactive)
|
||||||
(if (not (ghc-which ghc-module-command))
|
(if (not (ghc-which ghc-module-command))
|
||||||
(message "%s not found" ghc-module-command)
|
(message "%s not found" ghc-module-command)
|
||||||
(let ((cdir default-directory)
|
(ghc-display
|
||||||
(buf (get-buffer-create ghc-error-buffer-name)))
|
fontify
|
||||||
(with-current-buffer buf
|
(lambda (cdir)
|
||||||
(erase-buffer)
|
(insert
|
||||||
(insert
|
(with-temp-buffer
|
||||||
(with-temp-buffer
|
(cd cdir)
|
||||||
(cd cdir)
|
(apply 'call-process ghc-module-command nil t nil
|
||||||
(apply 'call-process ghc-module-command nil t nil
|
(append (ghc-make-ghc-options) cmds))
|
||||||
(append (ghc-make-ghc-options) cmds))
|
(buffer-substring (point-min) (1- (point-max)))))))))
|
||||||
(buffer-substring (point-min) (1- (point-max)))))
|
|
||||||
(goto-char (point-min))
|
|
||||||
(haskell-font-lock-defaults-create)
|
|
||||||
(turn-on-haskell-font-lock))
|
|
||||||
(display-buffer buf))))
|
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
;;;
|
;;;
|
||||||
|
Loading…
Reference in New Issue
Block a user