emacs-config/lib/eos/jao-minibuffer.el

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

;; Copyright (C) 2020, 2021, 2022, 2024  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.

;;; Code:

(defvar jao-minibuffer-info ())
(defvar jao-minibuffer-msg-info '(""))
(defvar jao-minibuffer-align-right t)
(defvar jao-minibuffer-adaptive-alignment t)
(defvar jao-minibuffer-right-margin (if window-system 0 1))
(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")
(defvar jao-minibuffer-inhibit nil)

(defconst jao-minibuffer--name " *Minibuf-0*")

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

(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)
  (let* ((info (or info jao-minibuffer-info))
         (info (if jao-minibuffer-align-right info (reverse info))))
    (mapconcat #'string-trim
               (seq-remove #'string-blank-p (mapcar 'format-mode-line info))
               " ")))

(defun jao-minibuffer--aligned (w)
  (let* ((msg (jao-minibuffer--format-info))
         (msg (cond (jao-minibuffer-align-right (string-trim msg))
                    (t (string-trim-left msg)))))
    (unless (string-empty-p msg)
      (let ((msg (propertize msg 'minibuffer-message t))
            (w (- (jao-minibuffer--width) w jao-minibuffer-right-margin)))
        (if (> w 0) (jao-minibuffer--trim msg w) "")))))

(defun jao-minibuffer--insert (msg)
  (with-current-buffer jao-minibuffer--name
    (delete-region (point-min) (point-max))
    (insert msg)))

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

(defun jao-minibuffer--prefix (msgs)
  (when-let (p (string-join (butlast msgs) "\n"))
    (unless (string-blank-p p) (concat p "\n"))))

(defun jao-minibuffer--format-msg (msg)
   (let* ((msgs (mapcar #'jao-minibuffer--strip-prev (split-string msg "\n" t)))
          (msgs (cl-remove-if (lambda (s) (get-text-property 0 'invisible s)) msgs))
          (prefix (jao-minibuffer--prefix msgs))
          (msg (or (car (last msgs)) ""))
          (w (string-width msg)))
     (if jao-minibuffer-align-right
         (concat prefix msg (jao-minibuffer--aligned w))
       (concat prefix (jao-minibuffer--aligned (+ 3 w)) "   " msg))))

(defun jao-minibuffer--set-message (msg)
  (when jao-minibuffer-mode
    (or (and (string= jao-minibuffer--name (or (buffer-name) "")) msg)
        jao-minibuffer-inhibit
        (let* ((info (and jao-minibuffer-msg-info
                          (jao-minibuffer--format-info jao-minibuffer-msg-info)))
               (info (or (and info msg (propertize info 'face 'jao-themes-dimm))
                         info))
               (sep (if msg "  -  " ""))
               (pref (when info
                       (let ((len (+ (length info) (length sep))))
                         (format (format "\n%%%ds" len) ""))))
               (msg (if (and msg pref)
                        (replace-regexp-in-string "\n" pref msg)
                      msg))
               (left (if jao-minibuffer-align-right info (or msg "")))
               (right (if jao-minibuffer-align-right (or msg "") info))
               (msg (or (if info (format "%s%s%s" left sep right) msg) "")))
          (if cursor-in-echo-area msg (jao-minibuffer--format-msg msg))))))

(defun jao-minibuffer--clear-message ()
  (let ((jao-minibuffer-inhibit nil))
    (or (jao-minibuffer--insert (jao-minibuffer--set-message nil)) t)))

(setq set-message-function #'jao-minibuffer--set-message)

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

(defun jao-minibuffer--adjust-alignment (&rest _)
  (when jao-minibuffer-adaptive-alignment
    (setq jao-minibuffer-align-right
          (< (or (car (window-absolute-pixel-edges)) 0)
             (/ (or (cadr (assoc 'outer-size (frame-geometry))) 0) 2))))
  (jao-minibuffer-refresh))

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

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

(defun jao-minibuffer-remove-variable (variable-name)
  (let ((v `(:eval ,variable-name)))
    (setq jao-minibuffer-info (remove v jao-minibuffer-info))
    (setq jao-minibuffer-msg-info (remove v jao-minibuffer-msg-info))))

(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 'select-window :after #'jao-minibuffer--adjust-alignment)
             (advice-add 'force-mode-line-update :after #'jao-minibuffer-refresh)
             (setq clear-message-function #'jao-minibuffer--clear-message)
             (jao-minibuffer-refresh))
    (advice-remove 'select-window #'jao-minibuffer-refresh)
    (advice-remove 'force-mode-line-update #'jao-minibuffer-refresh)
    (setq clear-message-function nil)
    (jao-minibuffer--insert "")))

(defun jao-minibuffer-refresh (&rest _ignore)
  (interactive)
  (when jao-minibuffer-mode
    (let ((jao-minibuffer-mode nil)
          (msg (when jao-minibuffer-msg-info
                 (jao-minibuffer--format-info jao-minibuffer-msg-info))))
      (jao-minibuffer--insert (jao-minibuffer--format-msg (or msg ""))))))

(defun jao-minibuffer-toggle-adaptive-alignment ()
  (interactive)
  (setq jao-minibuffer-adaptive-alignment
        (not jao-minibuffer-adaptive-alignment))
  (jao-minibuffer-refresh))

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