mirror of https://github.com/Chizi123/.emacs.d.git

Chizi123
2018-11-21 7074318d7ab58aca124f590c42fd820e8eb258a5
commit | author | age
5cb5f7 1 ;;; error-tip.el --- showing error library by popup.el -*- lexical-binding: t; -*-
C 2
3 ;; Copyright (C) 2014 by Yuta Yamada
4
5 ;; Author: Yuta Yamada <cokesboy"at"gmail.com>
6 ;; URL: https://github.com/yuutayamada/flycheck-tip
7 ;; Version: 0.5.0
8 ;; Package-Requires: ((emacs "24.1") (popup "0.5.0"))
9
10 ;;; License:
11 ;; This program is free software: you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation, either version 3 of the License, or
14 ;; (at your option) any later version.
15 ;;
16 ;; This program is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
19 ;; GNU General Public License for more details.
20 ;;
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
23 ;;; Commentary:
24
25 ;;; Code:
26
27 (require 'cl-lib)
28 (require 'popup)
29 (require 'notifications) ; this introduced from Emacs 24
30
31 (defvar error-tip-notify-keep-messages nil
32   "If the value is non-nil, keep error messages to notification area.
33 This feature only activates when you leave from popup's message.")
34
35 (defvar error-tip-notify-last-notification nil
36   "Last notification id.")
37
38 (defvar error-tip-notify-timeout (* 60 1000)
39   "Value for time out.  The default value is 1 minute.")
40
41 (defvar error-tip-notify-parametors
42   '(:title "flycheck-tip" :category "im.error")
43   "Parameters for ‘error-tip-notify’.
44 You can add ‘notifications-notify’s parametors without :body, :replaces-id and
45 :timeout.
46
47 Example:
48
49   (setq error-tip-notify-parametors
50         (append error-tip-notify-parametors '(:app-icon \"/path/to/icon-file\")))")
51
52 ;; INTERNAL VARIABLE
53 (defvar error-tip-popup-object nil)
54 (defvar error-tip-timer-object nil)
55 (defvar error-tip-current-errors nil)
56 (defvar error-tip-timer-delay 0.3
57   "Whether how much delay showing error popup.
58 If you set nil to this variable, then do not use delay timer.")
59 (defvar error-tip-newline-character nil
60   "Use this variable if you want change specific characters to turn to newlines.")
61 (defvar error-tip-state nil)
62
63 (defun error-tip-cycle (errors &optional reverse)
64   (error-tip-delete-popup)
65   (setq error-tip-state nil)
66   (when errors
67     (let*
68         ((next     (assoc-default :next         errors))
69          (previous (assoc-default :previous     errors))
70          (cur-line (assoc-default :current-line errors))
71          (jump (lambda (errs)
72                  ;; Set errors forcefully at EOB
73                  (when (and (eobp) (eq (point) (point-at-bol)))
74                    (setq errs previous))
75                  (goto-char (point-min))
76                  (unless (line-move (1- (error-tip-get (car errs) 'line)) t)
77                    (push (cons 'eob (line-number-at-pos)) error-tip-state))
78                  (setq error-tip-current-errors errs)
79                  (if (null error-tip-timer-delay)
80                      (error-tip-popup-error-message (error-tip-get-errors))
81                    (error-tip-cancel-timer)
82                    (error-tip-register-timer))))
83          (target (if (not reverse)
84                      (or next previous cur-line)
85                    (reverse (or previous next cur-line)))))
86       (funcall jump target))))
87
88 (defun error-tip-get (err element)
89   (when (fboundp 'flycheck-tip--get)
90     (flycheck-tip--get element err)))
91
92 (defun error-tip-collect-current-file-errors (errors)
93   "Collect errors from ERRORS."
94   (cl-loop with c-line = (line-number-at-pos (point))
95            for err in errors
96            for err-line = (error-tip-get err 'line)
97            if (and buffer-file-truename ; whether file or buffer
98                    (not (equal (expand-file-name buffer-file-truename)
99                                (error-tip-get err 'file))))
100            do '() ; skip
101            else if (< c-line err-line)
102            collect err into next
103            else if (> c-line err-line)
104            collect err into previous
105            else if (= c-line err-line)
106            collect err into current-line
107            finally return (when (or next previous current-line)
108                             (list (cons :next         next)
109                                   (cons :previous     previous)
110                                   (cons :current-line current-line)))))
111
112 (defun error-tip-popup-error-message (errors &optional point)
113   "Popup error message(s) from ERRORS.
114 If there are multiple errors on current line, all current line's errors are
115 appeared.  The POINT arg is a point to show up error(s)."
116   (setq error-tip-popup-object
117         (popup-tip
118          (error-tip-format errors)
119          :nowait t
120          :point (let ((p (or point (error-tip-get-point))))
121                   (if (and (eobp) (eq (point) (point-at-bol)))
122                       (1- p)
123                     p))))
124   (add-hook 'pre-command-hook 'error-tip-delete-popup))
125
126 (defun error-tip-get-point ()
127   "Return point where the popup message emerges."
128   (1+ (point-at-bol)))
129
130 (defun error-tip-format (errors)
131   "Format ERRORS."
132   (let ((messages (format "*%s" (mapconcat 'identity errors "\n*"))))
133     (if error-tip-newline-character
134         (replace-regexp-in-string error-tip-newline-character "\n" messages)
135       messages)))
136
137 (defun error-tip-get-errors ()
138   "Get errors."
139   (cl-loop with current-line = (line-number-at-pos (point))
140            for error in error-tip-current-errors
141            for e-line = (error-tip-get error 'line)
142            for e-str  = (error-tip-get error 'message)
143            if (or (equal current-line e-line)
144                   (and (equal 1 current-line)
145                        (equal 0 e-line)))
146            collect e-str into result
147            else if (or (and (< (- 1 current-line) e-line)
148                             (> (+ 1 current-line) e-line))
149                        ;; #12
150                        (let ((line-eob (assoc-default 'eob error-tip-state)))
151                          (and line-eob (<= line-eob e-line))))
152            collect e-str into fallback
153            finally return (or result fallback)))
154
155 (defun error-tip-delete-popup ()
156   "Delete popup object."
157   (condition-case err
158       (when (popup-live-p error-tip-popup-object)
159         (popup-delete error-tip-popup-object)
160         (when error-tip-notify-keep-messages (error-tip-notify)))
161     (error err))
162   (remove-hook 'pre-command-hook 'error-tip-delete-popup))
163
164 (defun error-tip-register-timer ()
165   "Register timer that show error message."
166   (setq error-tip-timer-object
167         (run-with-timer
168          error-tip-timer-delay nil
169          (lambda ()
170            (error-tip-popup-error-message (error-tip-get-errors))))))
171
172 (defun error-tip-cancel-timer ()
173   "Cancel `error-tip-timer-object'."
174   (when (timerp error-tip-timer-object)
175     (cancel-timer error-tip-timer-object)))
176
177 ;;;###autoload
178 (defun error-tip-error-p ()
179   "Return non-nil if error is occurred in current buffer.
180 This function can catch error against flycheck, and flymake."
181   (cond
182    ((bound-and-true-p flycheck-current-errors)
183     'flycheck)
184    ((or (bound-and-true-p flymake-err-info)
185         (and (fboundp 'flymake-diagnostics)
186              (flymake-diagnostics)))
187     'flymake)
188    (t nil)))
189
190 ;;;###autoload
191 (defun error-tip-cycle-dwim (&optional reverse)
192   "Showing error function.
193 This function switches proper error showing function by context.
194  (whether flycheck or flymake) The REVERSE option jumps by inverse if
195 the value is non-nil."
196   (interactive)
197   (funcall (cl-case (error-tip-error-p)
198              (flycheck 'flycheck-tip-cycle)
199              (flymake  'flymake-tip-cycle))
200            reverse))
201
202 ;;;###autoload
203 (defun error-tip-cycle-dwim-reverse ()
204   "Same as ‘error-tip-cycle-dwim’, but it jumps to inverse direction."
205   (interactive)
206   (error-tip-cycle-dwim t))
207
208 ;; Show errors by using notifications.el(D-Bus)
209 (defun error-tip-notify ()
210   "Keep ERROR-MESSAGES on notification area.
211 See also ‘error-tip-notify-keep-messages’"
212   (setq error-tip-notify-last-notification
213         (apply
214          `((lambda ()
215              (notifications-notify
216               ,@(and error-tip-notify-parametors)
217               :body ,(format "%s"
218                              (error-tip-format
219                               (if (cl-struct-p (car error-tip-current-errors))
220                                   (error-tip-get-errors)
221                                 error-tip-current-errors)))
222               :replaces-id error-tip-notify-last-notification
223               :timeout error-tip-notify-timeout))))))
224
225 ;; Manual test:
226 ;; (defun error-tip--test-toggle-flymake-and-flycheck ()
227 ;;   (interactive)
228 ;;   (if flymake-mode
229 ;;       (flymake-mode 0)
230 ;;     (flymake-mode 1))
231 ;;   (if flycheck-mode
232 ;;       (flycheck-mode 0)
233 ;;     (flycheck-mode 1) ))
234 ;; (error-tip--test-toggle-flymake-and-flycheck)
235
236 (provide 'error-tip)
237
238 ;; Local Variables:
239 ;; coding: utf-8
240 ;; mode: emacs-lisp
241 ;; End:
242
243 ;;; error-tip.el ends here