931 lines
34 KiB
EmacsLisp
931 lines
34 KiB
EmacsLisp
;;; awesome-tray.el --- Modular tray bar
|
|
|
|
;; Filename: awesome-tray.el
|
|
;; Description: Modular tray bar
|
|
;; Author: Andy Stewart <lazycat.manatee@gmail.com>
|
|
;; Maintainer: Andy Stewart <lazycat.manatee@gmail.com>
|
|
;; Copyright (C) 2018, Andy Stewart, all rights reserved.
|
|
;; Created: 2018-10-07 07:30:16
|
|
;; Version: 4.2
|
|
;; Last-Updated: 2020-06-18 21:02:39
|
|
;; By: Andy Stewart
|
|
;; URL: http://www.emacswiki.org/emacs/download/awesome-tray.el
|
|
;; Keywords:
|
|
;; Compatibility: GNU Emacs 27.0.50
|
|
;;
|
|
;; Features that might be required by this library:
|
|
;;
|
|
;; `cl-lib'
|
|
;; `subr-x'
|
|
;; `battery'
|
|
;;
|
|
|
|
;;; This file is NOT part of GNU Emacs
|
|
|
|
;;; License
|
|
;;
|
|
;; 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, 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; see the file COPYING. If not, write to
|
|
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
|
|
;; Floor, Boston, MA 02110-1301, USA.
|
|
|
|
;;; Commentary:
|
|
;;
|
|
;; Modular tray bar.
|
|
;;
|
|
;; I don't like mode-line, it's too high, affect me to read the code.
|
|
;; With Emacs, we only need to focus on very little information, such as time, current mode, git branch.
|
|
;; Excessive information can seriously interfere with our attention.
|
|
;;
|
|
|
|
;;; Installation:
|
|
;;
|
|
;; Put awesome-tray.el to your load-path.
|
|
;; The load-path is usually ~/elisp/.
|
|
;; It's set in your ~/.emacs like this:
|
|
;; (add-to-list 'load-path (expand-file-name "~/elisp"))
|
|
;;
|
|
;; And the following to your ~/.emacs startup file.
|
|
;;
|
|
;; (require 'awesome-tray)
|
|
;; (awesome-tray-mode 1)
|
|
;;
|
|
;; No need more.
|
|
|
|
;;; Customize:
|
|
;;
|
|
;; `awesome-tray-mode-line-active-color'
|
|
;; `awesome-tray-mode-line-inactive-color'
|
|
;; `awesome-tray-active-modules'
|
|
;; `awesome-tray-git-update-duration'
|
|
;; `awesome-tray-refresh-idle-delay'
|
|
;; `awesome-tray-buffer-name-buffer-changed'
|
|
;; `awesome-tray-buffer-name-buffer-changed-style'
|
|
;; `awesome-tray-input-method-en-style'
|
|
;; `awesome-tray-input-method-zh-style'
|
|
;; `awesome-tray-buffer-read-only-style'
|
|
;;
|
|
;; All of the above can customize by:
|
|
;; M-x customize-group RET awesome-tray RET
|
|
;;
|
|
|
|
;;; Change log:
|
|
;;
|
|
;; 2020/06/18
|
|
;; * Shorter date info.
|
|
;;
|
|
;; 2020/05/06
|
|
;; * Just show origin message if got any error, easy to debug.
|
|
;;
|
|
;; 2020/04/01
|
|
;; * Shorter tray info.
|
|
;;
|
|
;; 2020/02/27
|
|
;; * Adapter the latest version of the snails.
|
|
;; * Adjust algorithm of `awesome-tray-get-frame-width'.
|
|
;;
|
|
;; 2020/02/19
|
|
;; * Add week info in date.
|
|
;;
|
|
;; 2020/02/14
|
|
;; * Add `awesome-tray-battery-update-duration' to fix `set-mark-command' failed.
|
|
;;
|
|
;; 2020/02/10
|
|
;; * Add battery remaining time.
|
|
;;
|
|
;; 2020/02/05
|
|
;; * Add battery status.
|
|
;;
|
|
;; 2020/01/05
|
|
;; * Hide awesome-tab info if it is too long.
|
|
;;
|
|
;; 2019/08/20
|
|
;; * Use variable `awesome-tray-mode-line-default-height' fix issue #34.
|
|
;;
|
|
;; 2019/08/14
|
|
;; * Remove notify message when toggle awesome-tray status.
|
|
;;
|
|
;; 2019/08/13
|
|
;; * Keep tray info align right when message is very long, thanks QiangF.
|
|
;;
|
|
;; 2019/07/26
|
|
;; * Support snails framework.
|
|
;;
|
|
;; 2019/07/16
|
|
;; * Use `format-mode-line' improve performance of `awesome-tray-module-location-info'.
|
|
;;
|
|
;; 2019/07/15
|
|
;; * Use current-line save value of `line-number-at-pos', improve the performance of `awesome-tray-module-location-info'.
|
|
;; * Use `ignore-errors' catch error of awesome-tray.
|
|
;;
|
|
;; 2019/07/14
|
|
;; * Don't wrap awesome-tray info if variable `inhibit-message' is non-nil.
|
|
;;
|
|
;; 2019/06/23
|
|
;; * Support `awesome-tab' group indicator.
|
|
;; * Fix crash cause by `awesome-tray-module-awesome-tab-info'
|
|
;;
|
|
;; 2019/05/08
|
|
;; * Disable git modulde default, it have performance when we change buffer too fast.
|
|
;;
|
|
;; 2019/04/29
|
|
;; * Fix position not update when execute command `beginning-of-buffer' or `end-of-buffer'.
|
|
;;
|
|
;; 2019/04/25
|
|
;; * Add 'circe' module displaying circe tracking-buffer modeline info.
|
|
;; * The circe module is not activated by default, it's added to `awesome-tray-all-modules'.
|
|
;;
|
|
;; 2018/11/25
|
|
;; * Add `RVM' support.
|
|
;; * The rvm module is not activated by default, I move it to `awesome-tray-all-modules'.
|
|
;;
|
|
;; 2018/11/18
|
|
;; * Fix the problem of displaying duplicate information when the mouse is in the minibuffer window.
|
|
;;
|
|
;; 2018/11/12
|
|
;; * Remove Mac color, use hex color instead.
|
|
;;
|
|
;; 2018/11/03
|
|
;; * Add percent information in location module.
|
|
;; * Fix error: Not enough arguments for format string.
|
|
;;
|
|
;; 2018/10/29
|
|
;; * Use `unspecified' attribute fix black block of mode-line inactive status.
|
|
;; * Add `awesome-tray-git-update-duration' option.
|
|
;;
|
|
;; 2018/10/21
|
|
;; * Use `advice-add' re-implmenet `awesome-tray-message-advice'
|
|
;; * Add parent-dir module.
|
|
;; * Don't show parent-dir if current mode is `dired-mode'.
|
|
;;
|
|
;; 2018/10/13
|
|
;; * Use `awesome-tray-process-exit-code-and-output' fetch git current branch for better error handling.
|
|
;;
|
|
;; 2018/10/11
|
|
;; * Reimplement `awesome-tray-module-git-info' don't depend on magit.
|
|
;; * Add last-command module, handy for debug emacs.
|
|
;;
|
|
;; 2018/10/09
|
|
;; * Add new option `awesome-tray-active-modules'.
|
|
;;
|
|
;; 2018/10/07
|
|
;; * First released.
|
|
;; * Add row/column information.
|
|
;; * Add `awesome-tray-message-advice' make tray information visible always.
|
|
;; * Use `frame-width' instead `window-width' to handle blank characters fill.
|
|
;; * Don't fill blank if message string is wider than frame width.
|
|
;;
|
|
|
|
;;; Acknowledgements:
|
|
;;
|
|
;;
|
|
;;
|
|
|
|
;;; TODO
|
|
;;
|
|
;;
|
|
;;
|
|
|
|
;;; Require
|
|
(require 'cl-lib)
|
|
(require 'subr-x)
|
|
(require 'battery)
|
|
|
|
;;; Code:
|
|
(defgroup awesome-tray nil
|
|
"Modular tray bar."
|
|
:group 'awesome-tray)
|
|
|
|
(defcustom awesome-tray-mode-line-active-color "DarkRed"
|
|
"Active color."
|
|
:type 'string
|
|
:group 'awesome-tray)
|
|
|
|
(defcustom awesome-tray-mode-line-inactive-color "Gray10"
|
|
"Inactive color."
|
|
:type 'string
|
|
:group 'awesome-tray)
|
|
|
|
(defcustom awesome-tray-active-modules
|
|
'("location" "buffer-name" "belong" "file-path" "mode-name" "input-method" "battery" "date")
|
|
"Default active modules."
|
|
:type 'list
|
|
:group 'awesome-tray)
|
|
|
|
(defcustom awesome-tray-essential-modules
|
|
'("location" "buffer-name" "belong" "file-path")
|
|
"Default ellipsis modules, show when minibuffer is too long."
|
|
:type 'list
|
|
:group 'awesome-tray)
|
|
|
|
(defcustom awesome-tray-buffer-name-max-length 20
|
|
"Max length of buffer name."
|
|
:group 'awesome-tray
|
|
:type 'int)
|
|
|
|
(defcustom awesome-tray-file-name-max-length 20
|
|
"Max length of file name."
|
|
:group 'awesome-tray
|
|
:type 'int)
|
|
|
|
(defcustom awesome-tray-git-update-duration 5
|
|
"Update duration of git command, in seconds.
|
|
|
|
It's very slow start new process in Windows platform.
|
|
Maybe you need set this option with bigger value to speedup on Windows platform."
|
|
:type 'integer
|
|
:group 'awesome-tray)
|
|
|
|
(defcustom awesome-tray-belong-update-duration 5
|
|
"Update duration of which class, in seconds."
|
|
:type 'integer
|
|
:group 'awesome-tray)
|
|
|
|
(defcustom awesome-tray-battery-update-duration 5
|
|
"Update duration of battery status, in seconds.
|
|
|
|
It will make command `set-mark-command' failed if not use duration."
|
|
:type 'integer
|
|
:group 'awesome-tray)
|
|
|
|
(defcustom awesome-tray-refresh-idle-delay 0.5
|
|
"Update idle delay of awesome tray, in seconds."
|
|
:type 'double
|
|
:group 'awesome-tray)
|
|
|
|
(defcustom awesome-tray-buffer-name-buffer-changed-style "*"
|
|
"`awesome-tray-buffer-name-buffer-changed' style."
|
|
:type 'string
|
|
:group 'awesome-tray)
|
|
|
|
(defcustom awesome-tray-buffer-name-buffer-changed nil
|
|
"Show the current buffer changes after buffer-name."
|
|
:type 'boolean
|
|
:group 'awesome-tray)
|
|
|
|
(defcustom awesome-tray-input-method-en-style "EN"
|
|
"English input method display style for input-method module."
|
|
:type 'string
|
|
:group 'awesome-tray)
|
|
|
|
(defcustom awesome-tray-input-method-zh-style "ZH"
|
|
"Chinese input method display style for input-method module."
|
|
:type 'string
|
|
:group 'awesome-tray)
|
|
|
|
(defcustom awesome-tray-buffer-read-only-style "R-O"
|
|
"Display style for buffer-read-only module."
|
|
:type 'string
|
|
:group 'awesome-tray)
|
|
|
|
(defcustom awesome-tray-file-path-show-filename nil
|
|
"Show filename in file-path module or not."
|
|
:type 'boolean
|
|
:group 'awesome-tray)
|
|
|
|
(defcustom awesome-tray-file-path-truncated-name-length 1
|
|
"In file-path module, how many letters to leave when truncate dirname.
|
|
|
|
Beginning dots are not counted."
|
|
:type 'integer
|
|
:group 'awesome-tray)
|
|
|
|
(defcustom awesome-tray-file-path-full-dirname-levels 2
|
|
"In file-path module, how many levels of parent directories should be shown in
|
|
their full name."
|
|
:type 'integer
|
|
:group 'awesome-tray)
|
|
|
|
(defcustom awesome-tray-file-path-truncate-dirname-levels 0
|
|
"In file-path module, how many levels of parent directories should be shown in
|
|
their first character.
|
|
|
|
These goes before those shown in their full names."
|
|
:type 'integer
|
|
:group 'awesome-tray)
|
|
|
|
(defface awesome-tray-default-face '((t :inherit default))
|
|
"Face for string constant ouside modules."
|
|
:group 'awesome-tray)
|
|
|
|
(defface awesome-tray-module-git-face
|
|
'((((background light))
|
|
:foreground "#cc2444" :bold t)
|
|
(t
|
|
:foreground "#ff2d55" :bold t))
|
|
"Git face."
|
|
:group 'awesome-tray)
|
|
|
|
(defface awesome-tray-module-rvm-face
|
|
'((((background light))
|
|
:foreground "#2832cc" :bold t)
|
|
(t
|
|
:foreground "#333fff" :bold t))
|
|
"RVM face."
|
|
:group 'awesome-tray)
|
|
|
|
(defface awesome-tray-module-circe-face
|
|
'((((background light))
|
|
:foreground "#2832cc" :bold t)
|
|
(t
|
|
:foreground "#333fff" :bold t))
|
|
"Circe face."
|
|
:group 'awesome-tray)
|
|
|
|
(defface awesome-tray-module-mode-name-face
|
|
'((((background light))
|
|
:foreground "#00a400" :bold t)
|
|
(t
|
|
:foreground "green3" :bold t))
|
|
"Mode name face."
|
|
:group 'awesome-tray)
|
|
|
|
(defface awesome-tray-module-location-face
|
|
'((((background light))
|
|
:foreground "#cc7700" :bold t)
|
|
(t
|
|
:foreground "#ff9500" :bold t))
|
|
"Location face."
|
|
:group 'awesome-tray)
|
|
|
|
(defface awesome-tray-module-date-face
|
|
'((((background light))
|
|
:foreground "#717175" :bold t)
|
|
(t
|
|
:foreground "#8e8e93" :bold t))
|
|
"Date face."
|
|
:group 'awesome-tray)
|
|
|
|
(defface awesome-tray-module-last-command-face
|
|
'((((background light))
|
|
:foreground "#0061cc" :bold t)
|
|
(t
|
|
:foreground "#007aff" :bold t))
|
|
"Date face."
|
|
:group 'awesome-tray)
|
|
|
|
(defface awesome-tray-module-buffer-name-face
|
|
'((((background light))
|
|
:foreground "#cc7700" :bold t)
|
|
(t
|
|
:foreground "#ff9500" :bold t))
|
|
"Buffer name face."
|
|
:group 'awesome-tray)
|
|
|
|
(defface awesome-tray-module-parent-dir-face
|
|
'((((background light))
|
|
:foreground "#5e8e2e" :bold t)
|
|
(t
|
|
:foreground "#9ded4d" :bold t))
|
|
"Parent dir face."
|
|
:group 'awesome-tray)
|
|
|
|
(defface awesome-tray-module-file-path-face
|
|
'((((background light))
|
|
:foreground "#5e8e2e" :bold t)
|
|
(t
|
|
:foreground "#9ded4d" :bold t))
|
|
"Parent dir face."
|
|
:group 'awesome-tray)
|
|
|
|
(defface awesome-tray-module-awesome-tab-face
|
|
'((((background light))
|
|
:foreground "#b83059" :bold t)
|
|
(t
|
|
:foreground "#e73c70" :bold t))
|
|
"Awesome tab face."
|
|
:group 'awesome-tray)
|
|
|
|
(defface awesome-tray-module-evil-face
|
|
'((((background light))
|
|
:foreground "#008080" :bold t)
|
|
(t
|
|
:foreground "#00ced1" :bold t))
|
|
"Evil state face."
|
|
:group 'awesome-tray)
|
|
|
|
(defface awesome-tray-module-battery-face
|
|
'((((background light))
|
|
:foreground "#008080" :bold t)
|
|
(t
|
|
:foreground "#00ced1" :bold t))
|
|
"Battery state face."
|
|
:group 'awesome-tray)
|
|
|
|
(defface awesome-tray-module-buffer-read-only-face
|
|
'((((background light))
|
|
:foreground "#cc2444" :bold t)
|
|
(t
|
|
:foreground "#ff2d55" :bold t))
|
|
"Buffer read only face."
|
|
:group 'awesome-tray)
|
|
|
|
(defface awesome-tray-module-belong-face
|
|
'((((background light))
|
|
:foreground "#cc2444" :bold t)
|
|
(t
|
|
:foreground "#ff2d55" :bold t))
|
|
"Buffer read only face."
|
|
:group 'awesome-tray)
|
|
|
|
(defface awesome-tray-module-input-method-face
|
|
'((((background light))
|
|
:foreground "#008080" :bold t)
|
|
(t
|
|
:foreground "#00ced1" :bold t))
|
|
"Input method face."
|
|
:group 'awesome-tray)
|
|
|
|
;;;###autoload
|
|
(define-minor-mode awesome-tray-mode
|
|
"Modular tray bar."
|
|
:require 'awesome-tray-mode
|
|
:global t
|
|
(if awesome-tray-mode
|
|
(awesome-tray-enable)
|
|
(awesome-tray-disable)))
|
|
|
|
(defvar awesome-tray-info-padding-right 0)
|
|
|
|
(defvar awesome-tray-mode-line-colors nil)
|
|
|
|
(defvar awesome-tray-timer nil)
|
|
|
|
(defvar awesome-tray-active-p nil)
|
|
|
|
(defvar awesome-tray-git-command-last-time 0)
|
|
|
|
(defvar awesome-tray-git-command-cache "")
|
|
|
|
(defvar awesome-tray-belong-last-time 0)
|
|
|
|
(defvar awesome-tray-belong-last-buffer nil)
|
|
|
|
(defvar awesome-tray-belong-cache "")
|
|
|
|
(defvar awesome-tray-battery-status-last-time 0)
|
|
|
|
(defvar awesome-tray-battery-status-cache "")
|
|
|
|
(defvar awesome-tray-last-tray-info nil)
|
|
|
|
(defvar awesome-tray-mode-line-default-height 1)
|
|
|
|
(defvar awesome-tray-module-alist
|
|
'(("awesome-tab" . (awesome-tray-module-awesome-tab-info awesome-tray-module-awesome-tab-face))
|
|
("buffer-name" . (awesome-tray-module-buffer-name-info awesome-tray-module-buffer-name-face))
|
|
("circe" . (awesome-tray-module-circe-info awesome-tray-module-circe-face))
|
|
("date" . (awesome-tray-module-date-info awesome-tray-module-date-face))
|
|
("evil" . (awesome-tray-module-evil-info awesome-tray-module-evil-face))
|
|
("file-path" . (awesome-tray-module-file-path-info awesome-tray-module-file-path-face))
|
|
("git" . (awesome-tray-module-git-info awesome-tray-module-git-face))
|
|
("last-command" . (awesome-tray-module-last-command-info awesome-tray-module-last-command-face))
|
|
("location" . (awesome-tray-module-location-info awesome-tray-module-location-face))
|
|
("parent-dir" . (awesome-tray-module-parent-dir-info awesome-tray-module-parent-dir-face))
|
|
("mode-name" . (awesome-tray-module-mode-name-info awesome-tray-module-mode-name-face))
|
|
("rvm" . (awesome-tray-module-rvm-info awesome-tray-module-rvm-face))
|
|
("battery" . (awesome-tray-module-battery-info awesome-tray-module-battery-face))
|
|
("input-method" . (awesome-tray-module-input-method-info awesome-tray-module-input-method-face))
|
|
("buffer-read-only" . (awesome-tray-module-buffer-read-only-info awesome-tray-module-buffer-read-only-face))
|
|
("belong" . (awesome-tray-module-belong-info awesome-tray-module-belong-face))
|
|
))
|
|
|
|
(defun awesome-tray-enable ()
|
|
;; Save mode-line colors when first time.
|
|
;; Don't change `awesome-tray-mode-line-colors' anymore.
|
|
(unless awesome-tray-mode-line-colors
|
|
(setq awesome-tray-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 awesome-tray-mode-line-default-height (face-attribute 'mode-line :height))
|
|
;; Disable mode line.
|
|
(set-face-attribute 'mode-line nil
|
|
:foreground awesome-tray-mode-line-active-color
|
|
:background awesome-tray-mode-line-active-color
|
|
:height 0.1
|
|
:box nil)
|
|
(set-face-attribute 'mode-line-inactive nil
|
|
:foreground awesome-tray-mode-line-inactive-color
|
|
:background awesome-tray-mode-line-inactive-color
|
|
:height 0.1
|
|
:box nil
|
|
:inherit 'unspecified)
|
|
;; Add update timer.
|
|
(setq awesome-tray-timer
|
|
(run-with-timer 0 awesome-tray-refresh-idle-delay 'awesome-tray-show-info))
|
|
(add-hook 'focus-in-hook 'awesome-tray-show-info)
|
|
(setq awesome-tray-active-p t))
|
|
|
|
(defun awesome-tray-disable ()
|
|
;; Restore mode-line colors.
|
|
(set-face-attribute 'mode-line nil
|
|
:foreground (nth 0 awesome-tray-mode-line-colors)
|
|
:background (nth 1 awesome-tray-mode-line-colors)
|
|
:family (nth 2 awesome-tray-mode-line-colors)
|
|
:box (nth 3 awesome-tray-mode-line-colors)
|
|
:height awesome-tray-mode-line-default-height)
|
|
(set-face-attribute 'mode-line-inactive nil
|
|
:foreground (nth 4 awesome-tray-mode-line-colors)
|
|
:background (nth 5 awesome-tray-mode-line-colors)
|
|
:family (nth 6 awesome-tray-mode-line-colors)
|
|
:box (nth 7 awesome-tray-mode-line-colors)
|
|
:height awesome-tray-mode-line-default-height)
|
|
;; Cancel timer.
|
|
(when (timerp awesome-tray-timer)
|
|
(cancel-timer awesome-tray-timer))
|
|
(remove-hook 'focus-in-hook 'awesome-tray-show-info)
|
|
;; Update mode-line.
|
|
(force-mode-line-update)
|
|
(redraw-display)
|
|
(with-current-buffer " *Minibuf-0*"
|
|
(erase-buffer))
|
|
(setq awesome-tray-active-p nil))
|
|
|
|
(defun awesome-tray-build-active-info ()
|
|
(condition-case nil
|
|
(mapconcat 'identity (cl-remove-if #'(lambda (n) (equal (length n) 0))
|
|
(mapcar 'awesome-tray-get-module-info awesome-tray-active-modules)) " ")
|
|
(format "Awesome Tray broken.")))
|
|
|
|
(defun awesome-tray-build-essential-info ()
|
|
(condition-case nil
|
|
(mapconcat 'identity (cl-remove-if #'(lambda (n) (equal (length n) 0))
|
|
(mapcar 'awesome-tray-get-module-info awesome-tray-essential-modules)) " ")
|
|
(format "Awesome Tray broken.")))
|
|
|
|
(defun awesome-tray-get-module-info (module-name)
|
|
(let* ((func (ignore-errors (cadr (assoc module-name awesome-tray-module-alist))))
|
|
(face-param (ignore-errors (caddr (assoc module-name awesome-tray-module-alist))))
|
|
(face (cond ((functionp face-param) (funcall face-param))
|
|
((facep face-param) face-param)
|
|
(t nil)))
|
|
(raw-info (ignore-errors (funcall func)))
|
|
(info (ignore-errors (if face (propertize raw-info 'face face) raw-info))))
|
|
(if func
|
|
(if info
|
|
info
|
|
(propertize "" 'face face))
|
|
(propertize module-name 'face 'awesome-tray-default-face))))
|
|
|
|
(defun awesome-tray-module-git-info ()
|
|
(if (executable-find "git")
|
|
(let ((current-seconds (awesome-tray-current-seconds)))
|
|
(if (> (- current-seconds awesome-tray-git-command-last-time) awesome-tray-git-update-duration)
|
|
(progn
|
|
(setq awesome-tray-git-command-last-time current-seconds)
|
|
(awesome-tray-update-git-command-cache))
|
|
awesome-tray-git-command-cache))
|
|
""))
|
|
|
|
(defun awesome-tray-module-circe-info ()
|
|
"Display circe tracking buffers"
|
|
(if (listp tracking-mode-line-buffers)
|
|
(apply 'concat (cl-loop for entry in tracking-mode-line-buffers
|
|
collect (or (plist-get entry :propertize) "")))
|
|
""))
|
|
|
|
(defun awesome-tray-module-rvm-info ()
|
|
(if (executable-find "rvm-prompt")
|
|
(format "rvm:%s" (replace-regexp-in-string
|
|
"\n" ""
|
|
(nth 1 (awesome-tray-process-exit-code-and-output "rvm-prompt")))
|
|
)
|
|
""))
|
|
|
|
(defun awesome-tray-module-battery-info ()
|
|
(let ((current-seconds (awesome-tray-current-seconds)))
|
|
(if (> (- current-seconds awesome-tray-battery-status-last-time) awesome-tray-battery-update-duration)
|
|
(let* ((battery-info (funcall battery-status-function))
|
|
(battery-type (battery-format "%L" battery-info))
|
|
battery-status)
|
|
(setq awesome-tray-battery-status-last-time current-seconds)
|
|
|
|
;; Short battery type.
|
|
(cond ((string-equal battery-type "on-line")
|
|
(setq battery-type "ON")
|
|
(setq battery-status (battery-format "-%p%%" battery-info)))
|
|
((string-equal battery-type "off-line")
|
|
(setq battery-type "OFF")
|
|
(setq battery-status (battery-format "-%p%% %t" battery-info))))
|
|
|
|
;; Update battery cache.
|
|
(setq awesome-tray-battery-status-cache (concat battery-type battery-status)))
|
|
awesome-tray-battery-status-cache)))
|
|
|
|
(defun awesome-tray-module-mode-name-info ()
|
|
(car (split-string (format "%s" major-mode) "-mode")))
|
|
|
|
(defun awesome-tray-module-location-info ()
|
|
(format "%s:%s %s"
|
|
(format-mode-line "%l")
|
|
(format-mode-line "%c")
|
|
(format-mode-line "%p")
|
|
))
|
|
|
|
(defun awesome-tray-module-date-info ()
|
|
(format-time-string "%m-%d %H:%M %a"))
|
|
|
|
(defun awesome-tray-module-last-command-info ()
|
|
(format "%s" last-command))
|
|
|
|
(defun awesome-tray-module-buffer-name-info ()
|
|
(let ((ellipsis "...")
|
|
bufname)
|
|
(setq bufname (if awesome-tray-buffer-name-buffer-changed
|
|
(if (and (buffer-modified-p)
|
|
(not (eq buffer-file-name nil)))
|
|
(concat (buffer-name) awesome-tray-buffer-name-buffer-changed-style)
|
|
(buffer-name))
|
|
(format "%s" (buffer-name))))
|
|
(if (> (length bufname) awesome-tray-buffer-name-max-length)
|
|
(format "%s%s" (substring bufname 0 (- awesome-tray-buffer-name-max-length (length ellipsis))) ellipsis)
|
|
bufname)))
|
|
|
|
(defun awesome-tray-module-buffer-read-only-info ()
|
|
(if (and (eq buffer-read-only t)
|
|
(not (eq buffer-file-name nil)))
|
|
(format "%s" awesome-tray-buffer-read-only-style)))
|
|
|
|
(defun awesome-tray-module-input-method-info ()
|
|
(if (eq current-input-method nil)
|
|
(format "%s" awesome-tray-input-method-en-style)
|
|
(format "%s" awesome-tray-input-method-zh-style)))
|
|
|
|
(defun awesome-tray-module-parent-dir-info ()
|
|
(format "%s" (file-name-nondirectory (directory-file-name default-directory))))
|
|
|
|
(defun awesome-tray-shrink-dir-name (name)
|
|
"Shrink NAME to be its first letter, or the first two if starts \".\"
|
|
|
|
NAME is a string, typically a directory name."
|
|
(let ((dot-num (if (string-match "^\\.+" name)
|
|
(length (match-string 0 name))
|
|
0)))
|
|
(substring name 0 (min (length name) (+ dot-num awesome-tray-file-path-truncated-name-length)))))
|
|
|
|
(defun awesome-tray-module-file-path-info ()
|
|
(if (not buffer-file-name)
|
|
(let ((ellipsis "...")
|
|
(bufname (buffer-name)))
|
|
(setq bufname (if awesome-tray-buffer-name-buffer-changed
|
|
(if (and (buffer-modified-p)
|
|
(not (eq buffer-file-name nil)))
|
|
(concat (buffer-name) awesome-tray-buffer-name-buffer-changed-style)
|
|
(buffer-name))
|
|
(format "%s" (buffer-name))))
|
|
(if (> (length bufname) awesome-tray-file-name-max-length)
|
|
(format "%s%s" (substring bufname 0 (- awesome-tray-file-name-max-length (length ellipsis))) ellipsis)
|
|
bufname))
|
|
(let* ((file-path (split-string (buffer-file-name) "/" t))
|
|
(shown-path)
|
|
(path-len (length file-path))
|
|
(modp (if (buffer-modified-p) "*" ""))
|
|
(full-num awesome-tray-file-path-full-dirname-levels)
|
|
(trunc-num awesome-tray-file-path-truncate-dirname-levels)
|
|
(show-name awesome-tray-file-path-show-filename))
|
|
(when (> path-len (+ 1 full-num))
|
|
(push (string-join
|
|
(mapcar #'awesome-tray-shrink-dir-name
|
|
(cl-subseq file-path
|
|
(max 0 (- path-len (+ 1 full-num trunc-num)))
|
|
(- path-len (1+ full-num)))) "/")
|
|
shown-path))
|
|
(when (> path-len 1)
|
|
(push (string-join
|
|
(cl-subseq file-path
|
|
(max 0 (- path-len (1+ full-num)))
|
|
(1- path-len)) "/")
|
|
shown-path))
|
|
(when show-name
|
|
(push (car (last file-path)) shown-path))
|
|
(concat modp
|
|
(if (<= path-len (+ 1 full-num trunc-num))
|
|
"/"
|
|
".../")
|
|
(string-join (nreverse (cl-remove "" shown-path)) "/")
|
|
(when (and shown-path (not show-name)) "/")))))
|
|
|
|
(defun awesome-tray-module-awesome-tab-info ()
|
|
(with-demoted-errors
|
|
""
|
|
(if (featurep 'awesome-tab)
|
|
(let ((tab-info (format "%s" (cdr (awesome-tab-selected-tab (awesome-tab-current-tabset t))))))
|
|
(if (> (string-width tab-info) 30)
|
|
""
|
|
tab-info))
|
|
"")))
|
|
|
|
(defun awesome-tray-module-evil-info ()
|
|
(with-demoted-errors
|
|
""
|
|
(if (featurep 'evil)
|
|
(let ((state
|
|
(cond ((evil-normal-state-p) "<N>")
|
|
((evil-emacs-state-p) "<E>")
|
|
((evil-insert-state-p) "<I>")
|
|
((evil-motion-state-p) "<M>")
|
|
((evil-visual-state-p) "<V>")
|
|
((evil-operator-state-p) "<O>")
|
|
((evil-replace-state-p) "<R>")
|
|
(t ""))))
|
|
state)
|
|
"")))
|
|
|
|
(defun awesome-tray-module-belong-info ()
|
|
(if (featurep 'tree-sitter)
|
|
(let ((current-seconds (awesome-tray-current-seconds)))
|
|
(if (or (not (eq (current-buffer) awesome-tray-belong-last-buffer))
|
|
(> (- current-seconds awesome-tray-belong-last-time) awesome-tray-belong-update-duration))
|
|
(progn
|
|
(setq awesome-tray-belong-last-time current-seconds)
|
|
(setq awesome-tray-belong-last-buffer (current-buffer))
|
|
(awesome-tray-update-belong-cache))
|
|
awesome-tray-belong-cache))
|
|
""))
|
|
|
|
(defun awesome-tray-update-belong-cache ()
|
|
(setq awesome-tray-belong-cache
|
|
(let* ((class-nodes (append (awesome-tray-get-match-nodes "(class_definition name: (symbol) @x)")
|
|
(awesome-tray-get-match-nodes "(class_definition name: (identifier) @x)")))
|
|
(function-nodes (append (awesome-tray-get-match-nodes "(function_definition name: (symbol) @x)")
|
|
(awesome-tray-get-match-nodes "(function_definition name: (identifier) @x)")))
|
|
which-belong-info
|
|
which-class-info
|
|
which-func-info)
|
|
(setq which-class-info (catch 'found
|
|
(dolist (class-node class-nodes)
|
|
(when (and (> (point) (tsc-node-start-position (tsc-get-parent class-node)))
|
|
(< (point) (tsc-node-end-position (tsc-get-parent class-node))))
|
|
(throw 'found (tsc-node-text class-node)))
|
|
)
|
|
(throw 'found "")))
|
|
(setq which-func-info (catch 'found
|
|
(dolist (function-node function-nodes)
|
|
(when (and (> (point) (tsc-node-start-position (tsc-get-parent function-node)))
|
|
(< (point) (tsc-node-end-position (tsc-get-parent function-node))))
|
|
(throw 'found (tsc-node-text function-node)))
|
|
)
|
|
(throw 'found "")))
|
|
(setq which-belong-info (string-trim (concat which-class-info " " which-func-info)))
|
|
(if (string-equal which-belong-info "")
|
|
""
|
|
(format "[%s]" which-belong-info))))
|
|
awesome-tray-belong-cache)
|
|
|
|
(defun awesome-tray-get-match-nodes (match-rule)
|
|
(ignore-errors
|
|
(let* ((query (tsc-make-query tree-sitter-language match-rule))
|
|
(root-node (tsc-root-node tree-sitter-tree))
|
|
(captures (mapcar #'cdr (tsc-query-captures query root-node #'tsc--buffer-substring-no-properties))))
|
|
captures)))
|
|
|
|
(defun awesome-tray-show-info ()
|
|
;; Only flush tray info when current message is empty.
|
|
(unless (current-message)
|
|
(awesome-tray-flush-info)))
|
|
|
|
(defun awesome-tray-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 awesome-tray-flush-info ()
|
|
(let* ((tray-info (awesome-tray-build-active-info)))
|
|
(with-current-buffer " *Minibuf-0*"
|
|
(erase-buffer)
|
|
(insert (concat (make-string (max 0 (- (awesome-tray-get-frame-width) (string-width tray-info) awesome-tray-info-padding-right)) ?\ ) tray-info)))))
|
|
|
|
(defun awesome-tray-get-echo-format-string (message-string)
|
|
(let* ((tray-info (awesome-tray-build-active-info))
|
|
(blank-length (- (awesome-tray-get-frame-width) (string-width tray-info) (string-width message-string) awesome-tray-info-padding-right)))
|
|
(prog1
|
|
(cond
|
|
;; Fill message's end with whitespace to keep tray info at right of minibuffer.
|
|
((> blank-length 0)
|
|
(concat message-string
|
|
(make-string (max 0 (- (awesome-tray-get-frame-width)
|
|
(string-width message-string)
|
|
(string-width tray-info)
|
|
awesome-tray-info-padding-right)) ?\ )
|
|
tray-info))
|
|
;; Fill empty whitespace if new message contain duplicate tray-info (cause by move mouse on minibuffer window).
|
|
((and awesome-tray-last-tray-info
|
|
message-string
|
|
(string-suffix-p awesome-tray-last-tray-info message-string))
|
|
(concat (make-string (max 0 (- (awesome-tray-get-frame-width)
|
|
(string-width tray-info)
|
|
awesome-tray-info-padding-right)) ?\ )
|
|
tray-info))
|
|
(t
|
|
(let* ((essential-info (awesome-tray-build-essential-info))
|
|
(fill-string (make-string (max 0 (- (awesome-tray-get-frame-width)
|
|
(string-width essential-info)
|
|
(string-width message-string)
|
|
awesome-tray-info-padding-right)) ?\ )))
|
|
(if (> (+ (string-width message-string) (string-width fill-string) (string-width essential-info))
|
|
(awesome-tray-get-frame-width))
|
|
;; Don't show tray information if message is too long.
|
|
message-string
|
|
(concat message-string fill-string essential-info))
|
|
)))
|
|
;; Record last tray information.
|
|
(setq awesome-tray-last-tray-info tray-info))))
|
|
|
|
(defun awesome-tray-process-exit-code-and-output (program &rest args)
|
|
"Run PROGRAM with ARGS and return the exit code and output in a list."
|
|
(with-temp-buffer
|
|
(list (apply 'call-process program nil (current-buffer) nil args)
|
|
(buffer-string))))
|
|
|
|
(defun awesome-tray-current-seconds ()
|
|
(string-to-number (format-time-string "%s")))
|
|
|
|
(defun awesome-tray-update-git-command-cache ()
|
|
(let* ((git-info (awesome-tray-process-exit-code-and-output "git" "symbolic-ref" "--short" "HEAD"))
|
|
(status (nth 0 git-info))
|
|
(result (format "git:%s" (nth 1 git-info))))
|
|
(setq awesome-tray-git-command-cache
|
|
(if (equal status 0)
|
|
(replace-regexp-in-string "\n" "" result)
|
|
""))
|
|
awesome-tray-git-command-cache))
|
|
|
|
;; Wrap `message' make tray information visible always
|
|
;; even other plugins call `message' to flush minibufer.
|
|
(defun awesome-tray-message-advice (old-message &rest arguments)
|
|
(if (ignore-errors
|
|
(cond
|
|
;; Don't wrap tray info if `awesome-tray-active-p' is nil.
|
|
((not awesome-tray-active-p)
|
|
(apply old-message arguments))
|
|
|
|
;; Don't wrap awesome-tray info if variable `inhibit-message' is non-nil.
|
|
(inhibit-message
|
|
(apply old-message arguments))
|
|
|
|
;; Just flush tray info if message string is empty.
|
|
((not (car arguments))
|
|
(apply old-message arguments)
|
|
(awesome-tray-flush-info))
|
|
|
|
;; Otherwise, wrap message string with tray info and show it in echo area,
|
|
;; logging origin message at `*Messages*' buffer if allowed.
|
|
(t
|
|
(if message-log-max
|
|
(let ((inhibit-message t))
|
|
(apply old-message arguments)))
|
|
(let ((message-log-max nil))
|
|
(apply old-message "%s" (cons (awesome-tray-get-echo-format-string (apply 'format arguments)) '())))))
|
|
|
|
;; Return t if everything is okay.
|
|
t)
|
|
;; Return origin message string. if not, `message' function will always return `nil'.
|
|
(if (car arguments)
|
|
(apply 'format arguments))
|
|
(apply old-message arguments)))
|
|
|
|
(advice-add #'message :around #'awesome-tray-message-advice)
|
|
|
|
(defun awesome-tray-current-message-advice (old-func &rest arguments)
|
|
(let ((message-string (apply old-func arguments)))
|
|
(if (and message-string awesome-tray-last-tray-info)
|
|
(string-trim-right (replace-regexp-in-string awesome-tray-last-tray-info "" message-string))
|
|
message-string)))
|
|
|
|
(advice-add #'current-message :around #'awesome-tray-current-message-advice)
|
|
|
|
(defun awesome-tray-end-of-buffer-advice (old-func &rest arguments)
|
|
(apply old-func arguments)
|
|
(message ""))
|
|
|
|
(advice-add #'end-of-buffer :around #'awesome-tray-end-of-buffer-advice)
|
|
|
|
(defun awesome-tray-beginning-of-buffer-advice (old-func &rest arguments)
|
|
(apply old-func arguments)
|
|
(message ""))
|
|
|
|
(advice-add #'beginning-of-buffer :around #'awesome-tray-beginning-of-buffer-advice)
|
|
|
|
(provide 'awesome-tray)
|
|
|
|
;;; awesome-tray.el ends here
|