FG42/core/fg42/statusbar.el

589 lines
22 KiB
EmacsLisp

;;; FG42 --- The mighty editor for the emacsians -*- lexical-binding: t; -*-
;;
;; Copyright (c) 2010-2022 Sameer Rahmani <lxsameer@gnu.org>
;;
;; Author: Sameer Rahmani <lxsameer@gnu.org>
;; URL: https://gitlab.com/FG42/FG42
;; Version: 3.0.0
;;
;; 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:
;;; Code:
;;; Require
(require 'minibuffer)
(require 'dash)
(require 'frame)
(require 'timer)
(require 'face-remap)
;;; Code:
(defgroup fg42/statusbar nil
"Modular tray bar."
:group 'fg42/statusbar)
(defcustom fg42/statusbar-mode-line-active-color "DarkRed"
"Active color."
:type 'string
:group 'fg42/statusbar)
(defcustom fg42/statusbar-mode-line-inactive-color "Gray10"
"Inactive color."
:type 'string
:group 'fg42/statusbar)
(defcustom fg42/statusbar-components
'("random" (buffer-name))
"Default active components."
:type 'list
:group 'fg42/statusbar)
(defcustom fg42/statusbar-truncate-p t
"Truncates fg42/statusbar or not."
:type 'boolean
:group 'fg42/statusbar)
(defcustom fg42/statusbar-echo-duration 5
"Duration to keep display echo."
:type 'integer
:group 'fg42/statusbar)
(defcustom fg42/statusbar-refresh-idle-delay 0.1
"Update idle delay of awesome tray, in seconds."
:type 'double
:group 'fg42/statusbar)
(defcustom fg42/statusbar-frame nil
"Frame to display fg42/statusbar on.
Nil means current selected frame."
:type 'sexp
:group 'fg42/statusbar)
(defface fg42/statusbar-default-face '((t :inherit default))
"Face for string constant ouside modules."
:group 'fg42/statusbar)
(defface fg42/statusbar-mode-line
'((((background light))
:background "#55ced1" :height 0.14 :box nil)
(t
:background "#008b8b" :height 0.14 :box nil))
"Modeline face for active window."
:group 'fg42/statusbar)
(defface fg42/statusbar-mode-line-inactive
'((((background light))
:background "#dddddd" :height 0.1 :box nil)
(t
:background "#333333" :height 0.1 :box nil))
"Modeline face for inactive window."
:group 'fg42/statusbar)
;;;###autoload
(define-minor-mode fg42/statusbar-mode
"Modular status bar."
:require 'fg42/statusbar-mode
:lighter "SB"
:global t
(if fg42/statusbar-mode
(fg42/statusbar-enable)
(fg42/statusbar-disable)))
(defvar fg42/statusbar-info-padding-right 0)
(defvar fg42/statusbar-mode-line-colors nil)
(defvar fg42/statusbar-timer nil)
(defvar fg42/statusbar-active-p nil)
(defvar fg42/statusbar-belong-last-time 0)
(defvar fg42/statusbar-belong-last-buffer nil)
(defvar fg42/statusbar-belong-cache "")
(defvar fg42/statusbar--cache nil)
(defvar fg42/statusbar-mode-line-default-height 1)
(defvar fg42/statusbar--minibuffer nil)
(defvar fg42/statusbar--echo-keystrokes echo-keystrokes)
(defvar fg42/statusbar-command-state 'begin
"The state of current executed command begin -> [exec exec-read] -> end.")
(defmacro fg42/statusbar-wrap (func &rest body)
"Add an advice around FUNC with name fg42/statusbar--%s.
BODY will be supplied with orig-func and args."
(let ((name (intern (format "fg42/statusbar--%s" func))))
`(advice-add #',func :around
(lambda (orig-func &rest args)
,@body)
'((name . ,name)))))
(defsubst fg42/statusbar-pre-cmd ()
"Pre command hook of fg42/statusbar."
(setq fg42/statusbar-command-state 'begin))
(defsubst fg42/statusbar-post-cmd ()
"Post command hook of fg42/statusbar."
(setq fg42/statusbar-command-state 'end
echo-keystrokes fg42/statusbar--echo-keystrokes))
(defvar fg42/statusbar--orig-resize-mini-windows resize-mini-windows)
(defsubst fg42/statusbar-enter-minibuffer ()
"`minibuffer-setup-hook' of fg42/statusbar."
(fg42/statusbar--set-buffer-face)
(setq resize-mini-windows 'grow-only))
(defsubst fg42/statusbar-exit-minibuffer ()
"`minibuffer-exit-hook' of fg42/statusbar."
(with-current-buffer fg42/statusbar--minibuffer
(fg42/statusbar--set-buffer-face))
(setq resize-mini-windows nil))
(defcustom fg42/statusbar-display-gui-line t
"Display thin line at the bottom of the window."
:type 'boolean
:group 'fg42/statusbar)
(defvar-local fg42/statusbar--orig-mode-line mode-line-format)
(defcustom fg42/statusbar-face-attr `(:background ,(face-attribute 'mode-line :background))
"Plist of face attribute/value pair for fg42/statusbar."
:type '(plist)
:group 'fg42/statusbar)
(defun fg42/statusbar--set-buffer-face ()
"Set buffer default face for current buffer."
(setq fg42/statusbar--face-cookie
(face-remap-add-relative 'default fg42/statusbar-face-attr)))
(defun fg42/statusbar-enable ()
"Enable the statusbar."
;; Save mode-line colors when first time.
;; Don't change `fg42/statusbar-mode-line-colors' anymore.
;; (unless fg42/statusbar-mode-line-colors
;; (setq fg42/statusbar-mode-line-colors
;; (list (face-attribute 'mode-line :foreground)
;; (face-attribute 'mode-line :background)
;; (face-attribute 'mode-line :family)
;; (face-attribute 'mode-line :box)
;; (face-attribute 'mode-line-inactive :foreground)
;; (face-attribute 'mode-line-inactive :background)
;; (face-attribute 'mode-line-inactive :family)
;; (face-attribute 'mode-line-inactive :box))))
;; (setq fg42/statusbar-mode-line-default-height (face-attribute 'mode-line :height))
;; ;; Disable mode line.
;; (set-face-attribute 'mode-line nil
;; :foreground fg42/statusbar-mode-line-active-color
;; :background fg42/statusbar-mode-line-active-color
;; :height 0.1
;; :box nil)
;; (set-face-attribute 'mode-line-inactive nil
;; :foreground fg42/statusbar-mode-line-inactive-color
;; :background fg42/statusbar-mode-line-inactive-color
;; :height 0.1
;; :box nil
;; :inherit 'unspecified)
;; Hide modeline for terminal, or use empty modeline for GUI.
(setq-default fg42/statusbar--orig-mode-line mode-line-format)
(setq-default mode-line-format (when (and fg42/statusbar-display-gui-line
(display-graphic-p))
'(" ")))
;; Do the same thing with opening buffers.
(mapc
(lambda (buf)
(with-current-buffer buf
(when (local-variable-p 'mode-line-format)
(setq fg42/statusbar--orig-mode-line mode-line-format)
(setq mode-line-format (when (and fg42/statusbar-display-gui-line
(display-graphic-p))
'(" "))))
(when (or (minibufferp buf)
(string-prefix-p " *Echo Area" (buffer-name)))
(fg42/statusbar--set-buffer-face))
;; Make the modeline in GUI a thin bar.
(when (and fg42/statusbar-display-gui-line
(local-variable-p 'face-remapping-alist)
(display-graphic-p))
(setf (alist-get 'mode-line face-remapping-alist)
'fg42/statusbar-mode-line
(alist-get 'mode-line-inactive face-remapping-alist)
'fg42/statusbar-mode-line-inactive))))
(buffer-list))
;; Make the modeline in GUI a thin bar.
(when (and fg42/statusbar-display-gui-line
(display-graphic-p))
(let ((face-remaps (default-value 'face-remapping-alist)))
(setf (alist-get 'mode-line face-remaps)
'fg42/statusbar-mode-line
(alist-get 'mode-line-inactive face-remaps)
'fg42/statusbar-mode-line-inactive
(default-value 'face-remapping-alist) face-remaps)))
(setq fg42/statusbar--orig-resize-mini-windows resize-mini-windows)
(setq resize-mini-windows nil)
(redisplay)
(advice-add #'message :around #'fg42/statusbar-message-advice)
;; (advice-add #'current-message :around #'fg42/statusbar-current-message-advice)
;; (advice-add #'end-of-buffer :around #'fg42/statusbar-end-of-buffer-advice)
;; (advice-add #'beginning-of-buffer :around #'fg42/statusbar-beginning-of-buffer-advice)
;; Add update timer.
(setq fg42/statusbar-timer
;; (run-with-timer 0 fg42/statusbar-refresh-idle-delay 'fg42/statusbar-show-info)
(run-with-timer 0 fg42/statusbar-refresh-idle-delay 'fg42/statusbar-display))
(add-hook 'minibuffer-setup-hook #'fg42/statusbar-enter-minibuffer)
(add-hook 'minibuffer-exit-hook #'fg42/statusbar-exit-minibuffer)
(add-hook 'pre-command-hook #'fg42/statusbar-pre-cmd)
(add-hook 'post-command-hook #'fg42/statusbar-post-cmd)
;;(add-hook 'focus-in-hook 'fg42/statusbar-show-info)
;;(add-function :after after-focus-change-function #'fg42/statusbar-show-info)
(add-function :after after-focus-change-function #'fg42/statusbar-display)
;; read-key-sequence
(fg42/statusbar-wrap
read-key-sequence
(progn
(setq fg42/statusbar-command-state 'exec-read)
(apply orig-func args)))
(fg42/statusbar-wrap
read-key-sequence-vector
(progn
(setq fg42/statusbar-command-state 'exec-read)
(apply orig-func args)))
(setq fg42/statusbar-active-p t))
(defvar-local fg42/statusbar--face-cookie nil)
(defvar fg42/statusbar--orig-mode-line-remap
(or (alist-get 'mode-line face-remapping-alist) 'mode-line))
(defvar fg42/statusbar--orig-mode-line-inactive-remap
(or (alist-get 'mode-line-inactive face-remapping-alist) 'mode-line-inactive))
(defun fg42/statusbar-disable ()
"Disable the status bar."
;; ;; Restore mode-line colors.
;; (set-face-attribute 'mode-line nil
;; :foreground (nth 0 fg42/statusbar-mode-line-colors)
;; :background (nth 1 fg42/statusbar-mode-line-colors)
;; :family (nth 2 fg42/statusbar-mode-line-colors)
;; :box (nth 3 fg42/statusbar-mode-line-colors)
;; :height fg42/statusbar-mode-line-default-height)
;; (set-face-attribute 'mode-line-inactive nil
;; :foreground (nth 4 fg42/statusbar-mode-line-colors)
;; :background (nth 5 fg42/statusbar-mode-line-colors)
;; :family (nth 6 fg42/statusbar-mode-line-colors)
;; :box (nth 7 fg42/statusbar-mode-line-colors)
;; :height fg42/statusbar-mode-line-default-height)
(setq-default mode-line-format (default-value 'fg42/statusbar--orig-mode-line))
(when (display-graphic-p)
(let ((face-remaps (default-value 'face-remapping-alist)))
(setf (alist-get 'mode-line face-remaps)
fg42/statusbar--orig-mode-line-remap
(alist-get 'mode-line-inactive face-remaps)
fg42/statusbar--orig-mode-line-inactive-remap
(default-value 'face-remapping-alist) face-remaps)))
(mapc
(lambda (buf)
(with-current-buffer buf
(when (local-variable-p 'mode-line-format)
(setq mode-line-format fg42/statusbar--orig-mode-line))
(when fg42/statusbar--face-cookie
(face-remap-remove-relative fg42/statusbar--face-cookie))
(when (and (local-variable-p 'face-remapping-alist)
(display-graphic-p))
(setf (alist-get 'mode-line face-remapping-alist)
fg42/statusbar--orig-mode-line-remap
(alist-get 'mode-line-inactive face-remapping-alist)
fg42/statusbar--orig-mode-line-inactive-remap))))
(buffer-list))
(setq resize-mini-windows fg42/statusbar--orig-resize-mini-windows)
(redisplay)
(advice-remove #'message #'fg42/statusbar-message-advice)
;; (advice-remove #'current-message #'fg42/statusbar-current-message-advice)
;; (advice-remove #'end-of-buffer #'fg42/statusbar-end-of-buffer-advice)
;; (advice-remove #'beginning-of-buffer #'fg42/statusbar-beginning-of-buffer-advice)
(advice-remove #'read-key-sequence 'fg42/statusbar--read-key-sequence)
(advice-remove #'read-key-sequence-vector 'fg42/statusbar--read-key-sequence-vector)
(remove-hook 'minibuffer-setup-hook #'fg42/statusbar-enter-minibuffer)
(remove-hook 'minibuffer-exit-hook #'fg42/statusbar-exit-minibuffer)
(remove-hook 'pre-command-hook #'fg42/statusbar-pre-cmd)
(remove-hook 'post-command-hook #'fg42/statusbar-post-cmd)
;; Cancel timer.
(when (timerp fg42/statusbar-timer)
(cancel-timer fg42/statusbar-timer))
;;(remove-hook 'focus-in-hook 'fg42/statusbar-show-info)
;;(remove-function after-focus-change-function #'fg42/statusbar-show-info)
(remove-function after-focus-change-function #'fg42/statusbar-display)
;; Update mode-line.
(force-mode-line-update)
(redraw-display)
(with-current-buffer " *Minibuf-0*"
(erase-buffer))
(setq fg42/statusbar-active-p nil))
(defun fg42/statusbar-build-active-info ()
"Collect the information from active components."
(mapconcat
(lambda (form)
(let ((result (eval form)))
(when (not (stringp result))
(error "The result of %s is not string" result))
(when (> (length result) 0)
(fg42/statusbar--log "fg42/statusbar: ---%s\n" result)
result)))
fg42/statusbar-components
" "))
;; (defun fg42/statusbar-show-info ()
;; "Display the status bar when there in no message in echo area."
;; ;; Only flush tray info when current message is empty.
;; (unless (current-message)
;; (fg42/statusbar-flush-info)))
(defun fg42/statusbar-get-frame-width ()
"Only calculating a main Frame width, to avoid wrong width when new frame, such
as `snails'."
(if (display-graphic-p)
(with-selected-frame (car (last (frame-list)))
(frame-width))
(frame-width)))
;; (defun fg42/statusbar-flush-info ()
;; "Create the string of data for the status bar."
;; (let* ((info (fg42/statusbar-build-active-info)))
;; (with-current-buffer " *Minibuf-0*"
;; (erase-buffer)
;; (insert
;; (concat
;; (make-string (max 0
;; (- (fg42/statusbar-get-frame-width)
;; (string-width info)
;; fg42/statusbar-info-padding-right))
;; ?\ )
;; info)))))
(defun fg42/statusbar-get-echo-format-string (info message-string)
(let* ((blank-length (- (fg42/statusbar-get-frame-width)
(string-width info)
(string-width (or message-string ""))
fg42/statusbar-info-padding-right)))
(cond
;; Fill message's end with whitespace to keep tray info at right of minibuffer.
((> blank-length 0)
(progn
(let* ((inhibit-message t))
(concat message-string
(make-string (max 0 (- (fg42/statusbar-get-frame-width)
(string-width (or message-string ""))
(string-width info)
fg42/statusbar-info-padding-right)) ?\ )
info))))
(t message-string))))
(defsubst fg42/statusbar--overduep (since duration)
"Check if time already pass DURATION from SINCE."
(>= (float-time (time-since since)) duration))
(defvar fg42/statusbar--msg-message nil
"Store the string from `message'.")
(defvar fg42/statusbar--last-update (current-time))
(defvar fg42/statusbar--last-change-size (current-time))
(defvar fg42/statusbar--last-echoed nil)
(defvar fg42/statusbar--msg nil)
(defun fg42/statusbar--log (&rest args)
"Log message into message buffer with ARGS as same parameters in `message'."
(save-excursion
(with-current-buffer "*Messages*"
(let ((inhibit-read-only t))
(goto-char (point-max))
(insert (apply #'format args))))))
(defun fg42/statusbar-display (&optional arg)
"Update fg42/statusbar.
When ARG is:
- `force', force update the minibuffer.
- `clear', clear the minibuffer. This implies `force'."
(save-match-data
(let ((bar-info (fg42/statusbar-build-active-info)))
(condition-case err
(cl-letf (((symbol-function 'completion-all-completions) #'ignore))
(unless (or (active-minibuffer-window)
(input-pending-p))
(setq fg42/statusbar--minibuffer
(window-buffer (minibuffer-window fg42/statusbar-frame)))
(with-current-buffer fg42/statusbar--minibuffer
(let ((truncate-lines fg42/statusbar-truncate-p)
(inhibit-read-only t)
(inhibit-redisplay t)
(buffer-undo-list t)
modeline-content)
(when (or (memq arg '(force clear))
(fg42/statusbar--overduep fg42/statusbar--last-update
fg42/statusbar-refresh-idle-delay))
(when-let ((msg (or fg42/statusbar--msg-message (current-message))))
;; Clear echo area and start new timer for echo message
(message nil)
(setq fg42/statusbar--last-echoed (current-time))
;; we proritize the message from `message'
;; or the message when we're not in middle of a command running.
(when (or fg42/statusbar--msg-message
(eq fg42/statusbar-command-state 'begin))
(setq fg42/statusbar-command-state 'exec)
;; Don't echo keystrokes when in middle of command
(setq echo-keystrokes 0))
(setq fg42/statusbar--msg msg))
;; Reset echo message when timeout and not in middle of command
(when (and fg42/statusbar--msg
(not (memq fg42/statusbar-command-state '(exec exec-read)))
(fg42/statusbar--overduep fg42/statusbar--last-echoed
fg42/statusbar-echo-duration))
(setq fg42/statusbar--msg nil))
;; Showing fg42/statusbar
(if (eq arg 'clear)
(setq modeline-content nil)
(setq modeline-content
(fg42/statusbar-get-echo-format-string bar-info fg42/statusbar--msg))
(setq fg42/statusbar--last-update (current-time)))
;; write to minibuffer
(unless (equal modeline-content
fg42/statusbar--cache))
(setq fg42/statusbar--cache modeline-content)
(erase-buffer)
(when fg42/statusbar--cache
(let (
;;let fg42/statusbar take control of mini-buffer size
(resize-mini-windows t))
(insert fg42/statusbar--cache))))))))
((error debug)
(fg42/statusbar--log "fg42/statusbar: %s\n" err))))))
;; Wrap `message' make status bar information visible always
;; even other plugins call `message' to flush minibufer.
(defun fg42/statusbar-message-advice (f &rest args)
;; (let ((ret
;; (condition-case err
;; ;; Ignore the errors because collecting the info might raise an error
;; ;; which should not interfier with `message'
;; (cond
;; ;; Don't wrap status info if `fg42/statusbar-active-p' is nil or
;; ;; if variable `inhibit-message' is non-nil.
;; ((or (not fg42/statusbar-active-p) inhibit-message)
;; (apply old-message (cons "E %s" arguments)))
;; ;; Just flush the bar info if message string is empty.
;; ((not (car arguments))
;; (progn
;; (apply old-message (cons "A %s" arguments))
;; (fg42/statusbar-flush-info)))
;; ;; Otherwise, wrap message string with the info and show it in echo area,
;; ;; logging origin message at `*Messages*' buffer if allowed.
;; (t
;; ;; To debug: just run the below expression in a shell
;; (apply
;; old-message
;; "%s"
;; (list
;; (fg42/statusbar-get-echo-format-string (apply 'format arguments)))))))))
;; ;; (with-current-buffer (window-buffer (minibuffer-window))
;; ;; (apply old-message '("here"))
;; ;; (erase-buffer)
;; ;; (insert ret))
;; (apply #'format (cons "Err %s" arguments))
;; ;; Return origin message string. if not, `message' function will always return `nil'.
;; ;; (when (car arguments)
;; ;; (apply 'format (cons "bla " arguments)))
;; ;; (apply old-message (cons "Err" arguments))
;; )
(if inhibit-message
(apply f args)
(let* ((inhibit-message t)
(fg42/statusbar--msg-message (apply f args)))
(fg42/statusbar-display 'force)
fg42/statusbar--msg-message)))
;; (defun fg42/statusbar-current-message-advice (old-func &rest arguments)
;; (let ((message-string (apply old-func arguments)))
;; (if (and message-string fg42/statusbar-last-info)
;; (progn
;; (string-trim-right (replace-regexp-in-string fg42/statusbar-last-info "" message-string)))
;; message-string)))
;; (defun fg42/statusbar-end-of-buffer-advice (old-func &rest arguments)
;; (apply old-func arguments)
;; (message ""))
;; (defun fg42/statusbar-beginning-of-buffer-advice (old-func &rest arguments)
;; (apply old-func arguments)
;; (message ""))
(provide 'fg42/statusbar)
;;; statusbar.el ends here