;;; jao-minibuffer.el --- using the minibuffer to report status  -*- lexical-binding: t; -*-

;; Copyright (C) 2020, 2021, 2022  jao

;; Author: jao <mail@jao.io>
;; Keywords: extensions

;; 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 <https://www.gnu.org/licenses/>.

;;; Commentary:

;; Simple asynchronous display of information in the minibuffer and echo area.

;;; Code:

(defvar jao-minibuffer-info ())
(defvar jao-minibuffer-msg-info '(""))
(defvar jao-minibuffer-align-right-p t)
(defvar jao-minibuffer-right-margin (if window-system "" "   "))
(defvar jao-minibuffer-maximized-frames-p t)
(defvar jao-minibuffer-frame-width nil)
(defvar jao-minibuffer-active-buffer-line-color "azure4")
(defvar jao-minibuffer-inactive-buffer-line-color "grey25")

(defconst jao-minibuffer--name " *Minibuf-0*")
(defvar jao-minibuffer--overlays nil)

(defun jao-minibuffer--create-overlays ()
  (dolist (buf '(" *Echo Area 0*" " *Echo Area 1*"))
    (with-current-buffer buf
      (remove-overlays (point-min) (point-max))
      (push (make-overlay (point-min) (point-max) nil nil t)
            jao-minibuffer--overlays))))

(defun jao-minibuffer--remove-overlays ()
  (mapc 'delete-overlay jao-minibuffer--overlays)
  (setq jao-minibuffer--overlays nil))

(defun jao-minibuffer--set-overlays (txt)
  (let* ((wid (+ (string-width txt)))
         (align `(space :align-to (- right-fringe ,wid)))
         (spc (propertize " " 'cursor 1 'display align))
         (txt (concat spc txt)))
    ;; Remove any dead overlays from the minibuffer from the beginning of the list
    (while (null (overlay-buffer (car jao-minibuffer--overlays)))
      (pop jao-minibuffer--overlays))

    ;; Add the correct text to each echo bar overlay
    (dolist (o jao-minibuffer--overlays)
      (when (overlay-buffer o) (overlay-put o 'after-string txt)))))

(defun jao-minibuffer--trim (s w)
  (if (<= (string-width (or s "")) w)
      (format (format "%%%ds" (if jao-minibuffer-align-right-p w (- w))) s)
    (substring s 0 w)))

(defun jao-minibuffer--width ()
  (cond ((numberp jao-minibuffer-frame-width) jao-minibuffer-frame-width)
        (jao-minibuffer-maximized-frames-p (frame-width))
        (t (min (frame-width) (window-width (minibuffer-window))))))

(defun jao-minibuffer--format-info (&optional info)
  (mapconcat 'string-trim
             (seq-filter (lambda (s) (not (string-blank-p s)))
                         (mapcar 'format-mode-line
                                 (if jao-minibuffer-align-right-p
                                     (or info jao-minibuffer-info)
                                   (reverse (or info jao-minibuffer-info)))))
             " "))

(defun jao-minibuffer--aligned (&optional w msg)
  (let* ((msg (or msg (jao-minibuffer--format-info)))
         (msg (cond (jao-minibuffer-align-right-p (string-trim msg))
                    (t (string-trim-left msg))))
         (msg (propertize msg :minibuffer-message t)))
    (unless (string-empty-p msg)
      (let* ((mw (jao-minibuffer--width))
             (w (- mw (mod w mw) (string-width jao-minibuffer-right-margin) -1)))
        (if (> w 0) (jao-minibuffer--trim msg w) "")))))

(defun jao-minibuffer--insert (msg)
  (let ((hack (derived-mode-p 'pdf-view-mode 'doc-view-mode)))
    (with-current-buffer jao-minibuffer--name
      (delete-region (point-min) (point-max))
      (insert msg)
      (when hack (other-window 1) (other-window -1)))))

(defun jao-minibuffer--strip-prev (msg)
  (if-let* ((l (length msg))
            (n (text-property-any 0 l :minibuffer-message t msg)))
      (string-trim (substring msg 0 n))
    msg))

(defvar exwm-class-name nil)

(defvar jao-minibuffer--mode-line-position
  '(exwm-class-name
    ("")
    ("%n %2c %l " (:eval (format "%d" (line-number-at-pos (point-max)))))))

(defvar jao-minibuffer--mode-line-bid
  '(:eval (cond ((derived-mode-p 'gnus-group-mode
                                 'gnus-article-mode
                                 'gnus-summary-mode)
                 mode-line-buffer-identification)
                ((derived-mode-p 'circe-channel-mode)
                 (format "%s [%d]" (buffer-name) (length (circe-channel-nicks))))
                (t "%b"))))

(defvar jao-minibuffer--mode-line-format
  `("%[" (:propertize ,jao-minibuffer--mode-line-bid face jao-themes-f00) "%]"
    (:propertize " (" face jao-themes-dimm)
    (:propertize mode-name face jao-themes-f00)
    (:propertize ("" minor-mode-alist) face jao-themes-f11)
    (:propertize ")" face jao-themes-dimm)
    (:propertize (vc-mode vc-mode) face jao-themes-f10)
    (:propertize mode-line-position face jao-themes-f12)
    " "
    global-mode-string
    (:propertize (" %Z%*%+ " (current-input-method current-input-method-title))
                 face jao-themes-warning)
    (:propertize "·" display "")))

(defvar jao-minibuffer--original-modeline nil)

(defun jao-minibuffer--add-variable (list-name variable-name &optional order)
  (let ((v `(:eval ,variable-name)))
    (set list-name (remove v (symbol-value list-name)))
    (add-to-ordered-list list-name v order)))

;;;###autoload
(defun jao-minibuffer-add-variable (variable-name &optional order)
  (jao-minibuffer--add-variable 'jao-minibuffer-info variable-name order))

;;;###autoload
(defun jao-minibuffer-add-msg-variable (variable-name &optional order)
  (jao-minibuffer--add-variable 'jao-minibuffer-msg-info variable-name order))

(defun jao-minibuffer-adjust-mode-line-faces ()
  (let ((bg (frame-parameter nil 'background-color)))
    (set-face-attribute 'mode-line nil :box nil :height 1
                        :background bg :foreground bg
                        :overline jao-minibuffer-active-buffer-line-color
                        :underline jao-minibuffer-inactive-buffer-line-color
                        :extend t)
    (set-face-attribute 'mode-line-inactive nil :box nil :height 1
                        :background bg :foreground bg
                        :overline bg
                        :underline jao-minibuffer-inactive-buffer-line-color
                        :extend t)))

;;;###autoload
(defun jao-minibuffer-add-mode-line (order)
  (setq jao-minibuffer--original-modeline mode-line-format)
  (setq-default mode-line-format '(" "))
  (setq-default mode-line-position jao-minibuffer--mode-line-position)
  (dolist (b (buffer-list))
    (with-current-buffer b (setq-local mode-line-format '(" "))))
  (jao-minibuffer-add-variable 'jao-minibuffer--mode-line-format order)
  (jao-minibuffer-adjust-mode-line-faces))

;;;###autoload
(define-minor-mode jao-minibuffer-mode
  "Show minibuffer status"
  :global t :lighter "" :group 'jao
  (if jao-minibuffer-mode
      (progn (advice-add 'select-window :after #'jao-minibuffer-refresh)
             (advice-add 'force-mode-line-update :after #'jao-minibuffer-refresh)
             (jao-minibuffer--create-overlays)
             (jao-minibuffer-refresh))
    (advice-remove 'select-window #'jao-minibuffer-refresh)
    (advice-remove 'force-mode-line-update #'jao-minibuffer-refresh)
    (jao-minibuffer--remove-overlays)
    (jao-minibuffer--insert "")))

;;;###autoload
(defun jao-minibuffer-refresh (&rest _ignore)
  (interactive)
  (when jao-minibuffer-mode
    (let* ((jao-minibuffer-mode nil)
           (window-selection-change-functions nil)
           (msg (jao-minibuffer--format-info))
           (msg-left (jao-minibuffer--format-info jao-minibuffer-msg-info))
           (msg-right (jao-minibuffer--aligned (string-width msg-left) msg)))
      (jao-minibuffer--set-overlays msg)
      (jao-minibuffer--insert (concat msg-left msg-right)))))

;; (add-hook 'window-selection-change-functions #'jao-minibuffer-refresh)

(provide 'jao-minibuffer)
;;; jao-minibuffer.el ends here