error-tip.el

;;; error-tip.el --- showing error library by popup.el -*- lexical-binding: t; -*-

;; Copyright (C) 2014 by Yuta Yamada

;; Author: Yuta Yamada <cokesboy"at"gmail.com>
;; URL: https://github.com/yuutayamada/flycheck-tip
;; Version: 0.5.0
;; Package-Requires: ((emacs "24.1") (popup "0.5.0"))

;;; License:
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:

;;; Code:

(require 'cl-lib)
(require 'popup)
(require 'notifications) ; this introduced from Emacs 24

(defvar error-tip-notify-keep-messages nil
  "If the value is non-nil, keep error messages to notification area.
This feature only activates when you leave from popup's message.")

(defvar error-tip-notify-last-notification nil
  "Last notification id.")

(defvar error-tip-notify-timeout (* 60 1000)
  "Value for time out.  The default value is 1 minute.")

(defvar error-tip-notify-parametors
  '(:title "flycheck-tip" :category "im.error")
  "Parameters for ‘error-tip-notify’.
You can add ‘notifications-notify’s parametors without :body, :replaces-id and
:timeout.

Example:

  (setq error-tip-notify-parametors
        (append error-tip-notify-parametors '(:app-icon \"/path/to/icon-file\")))")

;; INTERNAL VARIABLE
(defvar error-tip-popup-object nil)
(defvar error-tip-timer-object nil)
(defvar error-tip-current-errors nil)
(defvar error-tip-timer-delay 0.3
  "Whether how much delay showing error popup.
If you set nil to this variable, then do not use delay timer.")
(defvar error-tip-newline-character nil
  "Use this variable if you want change specific characters to turn to newlines.")
(defvar error-tip-state nil)

(defun error-tip-cycle (errors &optional reverse)
  (error-tip-delete-popup)
  (setq error-tip-state nil)
  (when errors
    (let*
        ((next     (assoc-default :next         errors))
         (previous (assoc-default :previous     errors))
         (cur-line (assoc-default :current-line errors))
         (jump (lambda (errs)
                 ;; Set errors forcefully at EOB
                 (when (and (eobp) (eq (point) (point-at-bol)))
                   (setq errs previous))
                 (goto-char (point-min))
                 (unless (line-move (1- (error-tip-get (car errs) 'line)) t)
                   (push (cons 'eob (line-number-at-pos)) error-tip-state))
                 (setq error-tip-current-errors errs)
                 (if (null error-tip-timer-delay)
                     (error-tip-popup-error-message (error-tip-get-errors))
                   (error-tip-cancel-timer)
                   (error-tip-register-timer))))
         (target (if (not reverse)
                     (or next previous cur-line)
                   (reverse (or previous next cur-line)))))
      (funcall jump target))))

(defun error-tip-get (err element)
  (when (fboundp 'flycheck-tip--get)
    (flycheck-tip--get element err)))

(defun error-tip-collect-current-file-errors (errors)
  "Collect errors from ERRORS."
  (cl-loop with c-line = (line-number-at-pos (point))
           for err in errors
           for err-line = (error-tip-get err 'line)
           if (and buffer-file-truename ; whether file or buffer
                   (not (equal (expand-file-name buffer-file-truename)
                               (error-tip-get err 'file))))
           do '() ; skip
           else if (< c-line err-line)
           collect err into next
           else if (> c-line err-line)
           collect err into previous
           else if (= c-line err-line)
           collect err into current-line
           finally return (when (or next previous current-line)
                            (list (cons :next         next)
                                  (cons :previous     previous)
                                  (cons :current-line current-line)))))

(defun error-tip-popup-error-message (errors &optional point)
  "Popup error message(s) from ERRORS.
If there are multiple errors on current line, all current line's errors are
appeared.  The POINT arg is a point to show up error(s)."
  (setq error-tip-popup-object
        (popup-tip
         (error-tip-format errors)
         :nowait t
         :point (let ((p (or point (error-tip-get-point))))
                  (if (and (eobp) (eq (point) (point-at-bol)))
                      (1- p)
                    p))))
  (add-hook 'pre-command-hook 'error-tip-delete-popup))

(defun error-tip-get-point ()
  "Return point where the popup message emerges."
  (1+ (point-at-bol)))

(defun error-tip-format (errors)
  "Format ERRORS."
  (let ((messages (format "*%s" (mapconcat 'identity errors "\n*"))))
    (if error-tip-newline-character
        (replace-regexp-in-string error-tip-newline-character "\n" messages)
      messages)))

(defun error-tip-get-errors ()
  "Get errors."
  (cl-loop with current-line = (line-number-at-pos (point))
           for error in error-tip-current-errors
           for e-line = (error-tip-get error 'line)
           for e-str  = (error-tip-get error 'message)
           if (or (equal current-line e-line)
                  (and (equal 1 current-line)
                       (equal 0 e-line)))
           collect e-str into result
           else if (or (and (< (- 1 current-line) e-line)
                            (> (+ 1 current-line) e-line))
                       ;; #12
                       (let ((line-eob (assoc-default 'eob error-tip-state)))
                         (and line-eob (<= line-eob e-line))))
           collect e-str into fallback
           finally return (or result fallback)))

(defun error-tip-delete-popup ()
  "Delete popup object."
  (condition-case err
      (when (popup-live-p error-tip-popup-object)
        (popup-delete error-tip-popup-object)
        (when error-tip-notify-keep-messages (error-tip-notify)))
    (error err))
  (remove-hook 'pre-command-hook 'error-tip-delete-popup))

(defun error-tip-register-timer ()
  "Register timer that show error message."
  (setq error-tip-timer-object
        (run-with-timer
         error-tip-timer-delay nil
         (lambda ()
           (error-tip-popup-error-message (error-tip-get-errors))))))

(defun error-tip-cancel-timer ()
  "Cancel `error-tip-timer-object'."
  (when (timerp error-tip-timer-object)
    (cancel-timer error-tip-timer-object)))

;;;###autoload
(defun error-tip-error-p ()
  "Return non-nil if error is occurred in current buffer.
This function can catch error against flycheck, and flymake."
  (cond
   ((bound-and-true-p flycheck-current-errors)
    'flycheck)
   ((or (bound-and-true-p flymake-err-info)
        (and (fboundp 'flymake-diagnostics)
             (flymake-diagnostics)))
    'flymake)
   (t nil)))

;;;###autoload
(defun error-tip-cycle-dwim (&optional reverse)
  "Showing error function.
This function switches proper error showing function by context.
 (whether flycheck or flymake) The REVERSE option jumps by inverse if
the value is non-nil."
  (interactive)
  (funcall (cl-case (error-tip-error-p)
             (flycheck 'flycheck-tip-cycle)
             (flymake  'flymake-tip-cycle))
           reverse))

;;;###autoload
(defun error-tip-cycle-dwim-reverse ()
  "Same as ‘error-tip-cycle-dwim’, but it jumps to inverse direction."
  (interactive)
  (error-tip-cycle-dwim t))

;; Show errors by using notifications.el(D-Bus)
(defun error-tip-notify ()
  "Keep ERROR-MESSAGES on notification area.
See also ‘error-tip-notify-keep-messages’"
  (setq error-tip-notify-last-notification
        (apply
         `((lambda ()
             (notifications-notify
              ,@(and error-tip-notify-parametors)
              :body ,(format "%s"
                             (error-tip-format
                              (if (cl-struct-p (car error-tip-current-errors))
                                  (error-tip-get-errors)
                                error-tip-current-errors)))
              :replaces-id error-tip-notify-last-notification
              :timeout error-tip-notify-timeout))))))

;; Manual test:
;; (defun error-tip--test-toggle-flymake-and-flycheck ()
;;   (interactive)
;;   (if flymake-mode
;;       (flymake-mode 0)
;;     (flymake-mode 1))
;;   (if flycheck-mode
;;       (flycheck-mode 0)
;;     (flycheck-mode 1) ))
;; (error-tip--test-toggle-flymake-and-flycheck)

(provide 'error-tip)

;; Local Variables:
;; coding: utf-8
;; mode: emacs-lisp
;; End:

;;; error-tip.el ends here