| 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 | |
