;;; FG42 --- The mighty editor for the emacsians -*- lexical-binding: t; -*- ;; ;; Copyright (c) 2010-2022 Sameer Rahmani ;; ;; Author: Sameer Rahmani ;; 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 . ;; ;;; 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