diff options
Diffstat (limited to 'emacs/site-lisp/single-header.el')
| -rwxr-xr-x | emacs/site-lisp/single-header.el | 257 |
1 files changed, 0 insertions, 257 deletions
diff --git a/emacs/site-lisp/single-header.el b/emacs/site-lisp/single-header.el deleted file mode 100755 index dc65335..0000000 --- a/emacs/site-lisp/single-header.el +++ /dev/null @@ -1,257 +0,0 @@ -;; 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 |