The ultimate editor for true believers https://fg42.org
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
 

501 lines
17 KiB

;;; 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:
;; Some of the functions in this module are borrowed from `mini-modeline'
;; at https://github.com/kiennq/emacs-mini-modeline (GPL). I modified to
;; fit my needs.
;;; Require
(require 'minibuffer)
(require 'frame)
(require 'timer)
(require 'face-remap)
;; ============================================================================
;; customizations
;; ============================================================================
(defgroup fg42/statusbar nil
"Status bar group."
: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 bar 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)
(defcustom fg42/statusbar-display-gui-line t
"Display thin line at the bottom of the window."
:type 'boolean
:group 'fg42/statusbar)
(defvar fg42/statusbar-height 4)
(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)
;; ============================================================================
;; Faces
;; ============================================================================
(defface fg42/statusbar-mode-line
'((((background light))
:background "#55ced1" :height 0.1 :box nil)
(t
:background "#3f3f3f" :height 0.2 :box nil))
"Modeline face for active window."
:group 'fg42/statusbar)
(defface fg42/statusbar-components
'((t :inherit t :height 0.7))
"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)
;; ============================================================================
;; Vars
;; ============================================================================
(defvar fg42/statusbar-info-padding-right 0)
(defvar fg42/statusbar--msg nil)
(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-timer nil)
(defvar fg42/statusbar-active-p nil)
(defvar fg42/statusbar--cache nil)
(defvar fg42/statusbar--orig-resize-mini-windows resize-mini-windows)
(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.")
(defvar fg42/statusbar-enable-hook nil)
(defvar fg42/statusbar-disable-hook nil)
(defvar-local fg42/statusbar--orig-mode-line mode-line-format)
(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))
;; ============================================================================
;; Definitions
;; ============================================================================
(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)))))
(defmacro defbar-unit (name interval default &rest body)
"Create a status bar unit with a dedicated timer.
It will create a unit with the given NAME and DEFAULT value and a timer
that runs the given BODY at the given INTERVAL."
(declare (indent defun))
(let ((timer-name (intern (format "$%s-timer" name))))
`(progn
(defvar ,name ,default)
(defvar ,timer-name)
(let ((fn (lambda () ,@body)))
(add-hook 'fg42/statusbar-enable-hook
(lambda ()
(setq ,timer-name
(run-with-timer 0 ,interval
(lambda ()
(setq ,name (funcall fn))))))))
(add-hook 'fg42/statusbar-disable-hook
(lambda ()
(when (timerp ,timer-name)
(cancel-timer ,timer-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))
(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))
(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."
;; 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)
;; Add update timer.
(setq fg42/statusbar-timer
(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-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)))
(run-hooks 'fg42/statusbar-enable-hook)
(setq fg42/statusbar-active-p t))
(defun fg42/statusbar-disable ()
"Disable the status bar."
(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 #'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-function after-focus-change-function #'fg42/statusbar-display)
;; Update mode-line.
(force-mode-line-update)
(redraw-display)
(with-current-buffer " *Minibuf-0*"
(erase-buffer))
(run-hooks 'fg42/statusbar-disable-hook)
(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)
result)))
fg42/statusbar-components
""))
(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-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 the 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))
(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))))))
(defun fg42/statusbar-message-advice (f &rest args)
"Wrap `message' make status bar information visible always
even other plugins call `message' to flush minibufer."
(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)))
;;;###autoload
(define-minor-mode fg42/statusbar-mode
"Super simple status bar for FG42."
:require 'fg42/statusbar-mode
:lighter "SB"
:global t
(if fg42/statusbar-mode
(fg42/statusbar-enable)
(fg42/statusbar-disable)))
(provide 'fg42/statusbar)
;;; statusbar.el ends here