diff options
Diffstat (limited to 'config/emacs/site-lisp/single-header.el')
| -rwxr-xr-x | config/emacs/site-lisp/single-header.el | 257 |
1 files changed, 257 insertions, 0 deletions
diff --git a/config/emacs/site-lisp/single-header.el b/config/emacs/site-lisp/single-header.el new file mode 100755 index 0000000..dc65335 --- /dev/null +++ b/config/emacs/site-lisp/single-header.el @@ -0,0 +1,257 @@ +;; single-header --- Display a topline inside each frame with global info -*- lexical-binding: t; -*- + +;; Author: Thomas Ulmer +;; Package-Requires: ((ednc) (battery) (s) (dash)) +;; Package-Version 1.0 + +(require 'battery) +(require 's) +(require 'dash) + +(use-package ednc ; make emacs a dbus notify reciever + ) + +;;; Commentary: +;;; + +;;; Code: + +;; testing +;; (require 'notifications) +;; (notifications-notify :title "2st test" :body "hello, world" :app-name "EDNC" +;; :actions '("default" "default")) + +(defgroup single-header + '((single-header-face custom-face) + (single-header-update-increment custom-variable)) + "Custom variables for the single header package." + :prefix "single-header" + :group 'emacs) +(defface single-header-face + '((default . (:background "#000000" :family "Source Code Pro"))) + "Base face for the header line." + :group 'single-header) +(defcustom single-header-update-increment + 3 + "Number of seconds before updating the header again." + :type 'natnum + :group 'single-header) +(defvar single-header--active-notifs nil) +(defvar single-header--timer nil) + +(defmacro single-header--time-lock (force frame name &rest body) + "" + (let* ((last-t-str (concat name "--last-time")) + (last-t (or (intern-soft last-t-str) (make-symbol last-t-str)))) + ;; cache contains the symol of the cache variable + ;; last-t contains the symbol of the last time it was evaluated + `(if force + (progn + (set-frame-parameter ,frame (quote ,last-t) (time-convert (current-time) 'integer)) + ,@body) + (let ((cur-time (time-convert (current-time) 'integer)) + (next-time (time-add (or (frame-parameter ,frame (quote ,last-t)) 0) + single-header-update-increment))) + (when (time-less-p next-time cur-time) + (progn + (set-frame-parameter ,frame (quote ,last-t) cur-time) + ,@body)))))) + +(defun single-header--with-face (str &rest face-plist) + "Convenience wrapper for `add-face-text-property'." + (add-face-text-property 0 (length str) face-plist t str) + str) + +(defun single-header--register-notif-change (old new) + "Function to hook `ednc-notification-presentation-functions'." + (when new + (push new single-header--active-notifs)) + (when (and old + (member old single-header--active-notifs)) + (setq single-header--active-notifs + (remove old single-header--active-notifs))) + (when (or new old) + (single-header-update t))) + +(defun single-header--make-notif-string () + "Produce a string representation of the active notifications." + (mapconcat (lambda (e) + (format "[%s | %s | %s] " + (s-truncate 8 (ednc-notification-app-name e)) + (s-truncate 8 (ednc-notification-summary e)) + (s-truncate 20 (ednc-notification-body e))) + ) + (ednc-notifications) + "")) + +(defun single-header-dismiss (num) + "Dismiss the most recent notification from the header line. With a prefix +arg, dismiss all the notifications." + (interactive "p") + (cond ((and (natnump num) (>= num 4)) + (mapc 'ednc-dismiss-notification (ednc-notifications))) + (t + (let ((notifs (ednc-notifications))) + (when notifs + (ednc-dismiss-notification (car notifs)))))) + (single-header-update t)) + +(defun single-header--make-header-info-string () + "Generates the mode line string that contains all the info to the right." + (let ((str (concat + (single-header--with-face (battery-format "[%b%p%%] " (and battery-status-function (funcall battery-status-function))) + :weight 'bold) + (single-header--with-face (let* ((mi (memory-info)) + (tm (float (car mi))) + (fm (float (cadr mi))) + (ts (float (caddr mi))) + (fs (float (cadddr mi)))) + (format "{%.2f %.2f} " (- 1 (/ fm tm)) (- 1 (/ fs ts)))) + :foreground "#00ced1") + (single-header--with-face (format "<%03.2f> " (car (load-average 1))) + :foreground "#da70d6") + (format-time-string "%a, %b %+4Y-%0m-%0d ") + (single-header--with-face (format-time-string "%R") + :weight 'bold) + ))) + (single-header--with-face str 'single-header-face))) + +(defun single-header--init-buffer (buf) + (with-current-buffer buf + (insert "header test") + (jit-lock-mode nil) + (font-lock-mode -1) + (buffer-disable-undo) + (setq-local mode-line-format nil) + (setq-local header-line-format nil) + (setq-local cursor-type nil) + (setq-local cursor-in-non-selected-windows nil) + (setq-local overflow-newline-into-fringe nil) + (setq-local word-wrap nil) + (setq-local show-trailing-whitespace nil))) + +(defun single-header--init-window (win) + (with-selected-window win + (set-window-dedicated-p win t) + (set-window-parameter win 'no-other-window t) + (set-window-parameter win 'no-delete-other-windows t) + (set-window-margins win 0 0) + (set-window-fringes win 0 0) + (set-window-scroll-bars win 0 nil 0 nil) + (setq-local window-min-height 1) + (setq-local window-safe-min-height 1) + (let + (window-size-fixed) + (fit-window-to-buffer win 1)) + (setq-local window-size-fixed t) + (when + (fboundp 'window-preserve-size) + (window-preserve-size win nil t)))) + +(defun single-header--init-frame (&optional frame) + (setq frame (or frame (selected-frame))) + (with-selected-frame frame + (let* ((buf (generate-new-buffer "*header*")) + (win (display-buffer-in-side-window buf '((side . top) + (slot . -100))))) + (single-header--init-buffer buf) + (single-header--init-window win) + (set-frame-parameter frame 'single-header-buf buf) + (set-frame-parameter frame 'single-header-win win)))) + +(defun single-header-update (&optional force) + "" + (mapc (lambda (f) (single-header-update-frame f force)) + (visible-frame-list))) + +(defun single-header-format (frame win buf) + "Evaluated in the header buffer when empty to fill the buffer." + (let* ((win-width (window-max-chars-per-line win 'single-header-face)) + (info (single-header--make-header-info-string)) + (info-width (string-width info)) + (notifs (s-truncate (- win-width info-width 2) + (single-header--make-notif-string))) + (notifs-width (string-width notifs)) + (filled (min win-width (+ info-width notifs-width))) + (padding-width (- win-width filled)) + (padding (make-string padding-width ? ))) + (setq notifs (single-header--with-face notifs 'single-header-face)) + (setq padding (single-header--with-face padding 'single-header-face)) + (setq info (single-header--with-face info 'single-header-face)) + (concat notifs padding info))) + +(defun single-header-update-frame (frame &optional force) + "" + (with-selected-frame frame + (let ((buf (frame-parameter frame 'single-header-buf)) + (win (frame-parameter frame 'single-header-win))) + (when (and buf win) + (with-current-buffer buf + (single-header--time-lock + force frame "header-lock" + (let ((str (single-header-format frame win buf))) + (erase-buffer) + (insert str)))))))) + +(defun single-header-make () + "Create the header and show it." + (let ((registered + (or (equal 'single-header--register-notif-change + ednc-notification-presentation-functions) + (and (listp ednc-notification-presentation-functions) + (-contains? ednc-notification-presentation-functions + 'single-header--register-notif-change))))) + (unless registered + (if (listp ednc-notification-presentation-functions) + (push 'single-header--register-notif-change + ednc-notification-presentation-functions) + (list 'single-header--register-notif-change + ednc-notification-presentation-functions)))) + (mapc (lambda (f) + (when (frame-live-p f) + (single-header--init-frame f))) + (frame-list)) + ;; TODO frame creation hook + (add-hook 'after-make-frame-functions #'single-header--init-frame) + (when single-header--timer + (cancel-timer single-header--timer)) + (setq single-header--timer + (run-with-timer 0 single-header-update-increment 'single-header-update))) + +(defun single-header-delete () + "Remove an existing header buffer." + (let ((reg-list (and (listp ednc-notification-presentation-functions) + (-contains? ednc-notification-presentation-functions + 'single-header--register-notif-change))) + (reg-equal (or (equal 'single-header--register-notif-change + ednc-notification-presentation-functions)))) + (when reg-list + (delete 'single-header--register-notif-change + ednc-notification-presentation-functions)) + (when reg-equal + (setq ednc-notification-presentation-functions + 'ednc--update-log-buffer))) + (cancel-timer single-header--timer) + (setq single-header--timer nil) + (remove-hook 'after-make-frame-functions 'single-header--init-frame) + (mapc (lambda (f) + (delete-window (frame-parameter f 'single-header-win)) + (kill-buffer (frame-parameter f 'single-header-buf)) + (set-frame-parameter f 'single-header-buf nil) + (set-frame-parameter f 'single-header-win nil)) + (frame-list))) + +(define-minor-mode single-header-mode + "Global minor mode to enable a single info line at the top of each frame." + :group 'single-header + :global t + :init-value nil + :keymap `((,(kbd "M-L d") . single-header-dismiss) + (,(kbd "M-L t") . single-header-mode)) + :interactive t + (if (not single-header-mode) + (single-header-delete) + (single-header-make))) + +(provide 'single-header) +;;; single-header.el ends here |