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
|
||||
'("\\.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))))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
|
@ -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)
|
||||
|
@ -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)))))))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;;
|
||||
|
Loading…
Reference in New Issue
Block a user