;;; flymake-posframe.el --- Show Emacs 26 flymake diagnostics using posframe.el -*- lexical-binding: t -*-

;;; Copyright (C) 2018 Alex Smith

;; Author: Alex Smith <xeals@pm.me>
;; Maintainer: Alex Smth <xeals@pm.me>
;; URL: https://github.com/xeals/flymake-posframe
;; Version: 0.1.0
;; Package-Requires: ((emacs "26") (posframe "0.3.0"))

;; This file is not part of GNU Emacs.

;; 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:
;; Show Emacs 26 flymake diagnostics using posframe.el

;;; Setup:

;; (with-eval-after-load 'flymake
;;   (require 'flymake-posframe)
;;   (add-hook 'flymake-mode-hook #'flymake-posframe-mode))

;;; Code:
(require 'flymake)
(require 'posframe)
(require 'flymake-diagnostic-at-point)

(defgroup flymake-posframe nil
  "Display Emacs 26 flymake diagnostics using posframe.el."
  :prefix "flymake-posframe-"
  :group 'flymake
  :link '(url-link :tag "Github" "https://github.com/xeals/flymake-posframe"))

(defcustom flymake-posframe-display-delay
  flymake-diagnostic-at-point-timer-delay
  "Delay in seconds before showing the diagnostic at point.")

(defcustom flymake-posframe-display-function
  'flymake-posframe-show-posframe
  "The function used to display the diagnostic message posframe."
  :type '(choice (const flymake-posframe-show-posframe)
                 (function :tag "Diagnostic display function")))

(defcustom flymake-posframe-prefix "➤ "
  "String to be displayed before every message in posframe."
  :group 'flymake-posframe
  :type 'string)

(defcustom flymake-posframe-note-prefix flymake-posframe-prefix
  "String to be displayed before every note message in posframe."
  :group 'flymake-posframe
  :type 'string)

(defcustom flymake-posframe-warning-prefix flymake-posframe-prefix
  "String to be displayed before every warning message in posframe."
  :group 'flymake-posframe
  :type 'string)

(defcustom flymake-posframe-error-prefix flymake-posframe-prefix
  "String to be displayed before every error message in posframe."
  :group 'flymake-posframe
  :type 'string)

(defface flymake-posframe-face '((t :inherit default))
  "Face used to display diagnostics in posframe."
  :group 'flymake-posframe)

(defface flymake-posframe-note-face '((t :inherit flymake-posframe-face))
  "Face used to display note messages in posframe."
  :group 'flymake-posframe)

(defface flymake-posframe-warning-face '((t :inherit flymake-posframe-face))
  "Face used to display warning messages in posframe."
  :group 'flymake-posframe)

(defface flymake-posframe-error-face '((t :inherit flymake-posframe-face))
  "Face used to display error messages in posframe."
  :group 'flymake-posframe)

(defvar flymake-posframe-buffer-name "*flymake-posframe-buffer*"
  "Name of the posframe buffer used to display flymake errors.")

(defvar flymake-posframe-hide-buffer-hooks
  '(pre-command-hook post-command-hook focus-out-hook)
  "Hooks that should trigger removal of the posframe buffer.")

(defvar flymake-posframe-old-diagnostic-function nil
  "Old value of `flymake-diagnostic-at-point-display-diagnostic-function'.")

(defun flymake-posframe-maybe-show-at-point ()
  "Display the flymake diagnostic for the thing at point."
  (let ((diag (get-char-property (point) 'flymake-diagnostic)))
    (when (and flymake-mode diag)
      (funcall flymake-posframe-display-function diag))))

(defun flymake-posframe-get-prefix-for-diagnostic (diag)
  "Get the prefix used to format DIAG."
  (pcase (flymake-diagnostic-type diag)
    (:error flymake-posframe-error-prefix)
    (:warning flymake-posframe-warning-prefix)
    (:note flymake-posframe-note-prefix)
    (_ flymake-posframe-prefix)))

(defun flymake-posframe-get-face-for-diagnostic (diag)
  "Get the face used to format DIAG."
  (pcase (flymake-diagnostic-type diag)
    (:error 'flymake-posframe-error-face)
    (:warning 'flymake-posframe-warning-face)
    (:note 'flymake-posframe-note-face)
    (_ flymake-posframe-face)))

(defun flymake-posframe-format-diagnostic (diag)
  "Format DIAG for display."
  (propertize (concat
               (flymake-posframe-get-prefix-for-diagnostic diag)
               (flymake--diag-text diag))
              'face
              `(:inherit ,(flymake-posframe-get-face-for-diagnostic diag))))

(defun flymake-posframe-hide-posframe ()
  "Hides any messages currently being displayed."
  (posframe-hide flymake-posframe-buffer-name)
  (dolist (hook flymake-posframe-hide-buffer-hooks)
    (remove-hook hook #'flymake-posframe-hide-posframe t)))

(defun flymake-posframe-show-posframe (text)
  "Display TEXT using a posframe."
  (flymake-posframe-hide-posframe)
  (when text
    (posframe-show
     flymake-posframe-buffer-name
     :string (flymake-posframe-format-diagnostic text)
     :background-color (face-background 'default nil t)
     :position (point))
    (dolist (hook flymake-posframe-hide-buffer-hooks)
      (add-hook hook #'flymake-posframe-hide-posframe nil t))))

(defun flymake-posframe-init ()
  "Set up hooks and overrides for `flymake-posframe-mode'."
  ;; No point doing all this if we don't want to use diag-at-point anyway.
  (when (> flymake-posframe-display-delay 0)
    ;; Remember the old display function, but only if we haven't already set it.
    (when (and flymake-posframe-mode
               (not (eq flymake-diagnostic-at-point-display-diagnostic-function
                        #'flymake-posframe-show-posframe)))
      (setq-local flymake-posframe-old-diagnostic-function
                  flymake-diagnostic-at-point-display-diagnostic-function)
      (setq-local flymake-diagnostic-at-point-display-diagnostic-function
                  #'flymake-posframe-show-posframe))
    ;; We want to pass the entire diagnostic to `flymake-posframe-show-posframe', so the entire
    ;; handler has to be overriden.
    (advice-add #'flymake-diagnostic-at-point-maybe-display
                :override
                #'flymake-posframe-maybe-show-at-point)
    ;; Piggyback off diagnostic-at-point-mode.
    (setq flymake-diagnostic-at-point-timer-delay flymake-posframe-display-delay)
    (flymake-diagnostic-at-point-mode +1)))

(defun flymake-posframe-finish ()
  "Remove hooks and overrides for `flymake-posframe-mode'."
  ;; Reset the display function.
  (when (and (not flymake-posframe-mode)
        (eq flymake-diagnostic-at-point-display-diagnostic-function
            #'flymake-posframe-show-posframe))
   (setq-local flymake-diagnostic-at-point-display-diagnostic-function
               flymake-posframe-old-diagnostic-function)
   (setq-local flymake-posframe-old-diagnostic-function nil))
  (advice-remove #'flymake-diagnostic-at-point-maybe-display
                 #'flymake-posframe-maybe-show-at-point)
  (flymake-diagnostic-at-point-mode -1))

;;;###autoload
(define-minor-mode flymake-posframe-mode
  "Minor mode to display flymake diagnostics in a posframe."
  :lighter nil
  :group 'flymake-posframe
  (cond
   (flymake-posframe-mode
    (flymake-posframe-init))
   (t
    (flymake-posframe-finish))))

(provide 'flymake-posframe)
;;; flymake-posframe.el ends here