diff options
Diffstat (limited to 'emacs/site-lisp')
| -rwxr-xr-x | emacs/site-lisp/single-header.el | 141 |
1 files changed, 92 insertions, 49 deletions
diff --git a/emacs/site-lisp/single-header.el b/emacs/site-lisp/single-header.el index e9cce2a..1378384 100755 --- a/emacs/site-lisp/single-header.el +++ b/emacs/site-lisp/single-header.el @@ -25,18 +25,48 @@ "Custom variables for the single header package." :prefix "single-header" :group 'emacs) - -(defface single-header-face '((default . (:background "#000000" :family "Source Code Pro"))) +(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 10 +(defcustom single-header-update-increment + 3 "Number of seconds before updating the header again." :type 'natnum :group 'single-header) -(defvar single-header--current-header-buffer nil) (defvar single-header--active-notifs nil) -(defvar single-header--last-update-time 0) + +(defmacro single-header--time-memo (force frame function &rest args) + "Call FUNCTION on ARGS like with `funcall', but only evaluate FUNCTION +once per `single-header-update-increment', returning the last result on +more frequent calls. Caching and time checking is per-frame. Skip the +frequency check and write update the cache regardless if FORCE evaluates +to non-nil. The last update time is in a frame parameter +`function--last-time' of FRAME, and the cached value is in +`function--cache'." + (let ((name (if (symbolp function) + (symbol-name function) + (error "Function wasn't a symbol")))) + (let* ((last-t-str (concat name "--last-time")) + (cache-str (concat name "--cache")) + (last-t (or (intern-soft last-t-str) (make-symbol last-t-str))) + (cache (or (intern-soft cache-str) (make-symbol cache-str)))) + ;; cache contains the symol of the cache variable + ;; last-t contains the symbol of the last time it was evaluated + `(if force + (let ((v (funcall ',function ,@args))) + (set-frame-parameter ,frame (quote ,cache) v) + (set-frame-parameter ,frame (quote ,last-t) (time-convert (current-time) 'integer)) + v) + (let ((cur-time (time-convert (current-time) 'integer)) + (next-time (time-add (or (frame-parameter ,frame (quote ,last-t)) 0) + single-header-update-increment))) + (if (time-less-p next-time cur-time) + (let ((v (funcall ',function ,@args))) + (set-frame-parameter ,frame (quote ,cache) v) + (set-frame-parameter ,frame (quote ,last-t) cur-time) + v) + (frame-parameter ,frame (quote ,cache)))))))) (defun single-header--with-face (str &rest face-plist) "Convenience wrapper for `add-face-text-property'." @@ -76,23 +106,6 @@ arg, dismiss all the notifications." (ednc-dismiss-notification (car notifs)))))) (single-header-update)) -(defun single-header-format () - "Evaluated in the header buffer when empty to fill the buffer." - (let* ((win (get-buffer-window (current-buffer))) - (win-width (window-max-chars-per-line win 'single-header)) - (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)) - (insert notifs padding info))) - (defun single-header--make-header-info-string () "Generates the mode line string that contains all the info to the right." (let ((str (concat @@ -113,7 +126,7 @@ arg, dismiss all the notifications." ))) (single-header--with-face str 'single-header-face))) -(defun single-header-init-buffer (buf) +(defun single-header--init-buffer (buf) (with-current-buffer buf (insert "header test") (jit-lock-mode nil) @@ -127,7 +140,7 @@ arg, dismiss all the notifications." (setq-local word-wrap nil) (setq-local show-trailing-whitespace nil))) -(defun single-header-init-window (win) +(defun single-header--init-window (win) (with-selected-window win (set-window-dedicated-p win t) (set-window-parameter win 'no-other-window t) @@ -145,13 +158,16 @@ arg, dismiss all the notifications." (fboundp 'window-preserve-size) (window-preserve-size win nil t)))) -(defun single-header-show (buf) - "Show the header, making it if necessary." - (if (buffer-live-p buf) - (let ((win (display-buffer-in-side-window buf '((side . top) - (slot . -100))))) - (single-header-init-window win)) - (single-header-make))) +(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-make () "Create the header and show it." @@ -167,11 +183,12 @@ arg, dismiss all the notifications." ednc-notification-presentation-functions) (list 'single-header--register-notif-change ednc-notification-presentation-functions)))) - (unless (buffer-live-p single-header--current-header-buffer) - (let ((buf (generate-new-buffer "*header*"))) - (single-header-init-buffer buf) - (setq single-header--current-header-buffer buf) - (single-header-show buf))) + (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) (add-hook 'post-command-hook #'single-header-update)) (defun single-header-delete () @@ -188,20 +205,46 @@ arg, dismiss all the notifications." (setq ednc-notification-presentation-functions 'ednc--update-log-buffer))) (remove-hook 'post-command-hook 'single-header-update) - (when (buffer-live-p single-header--current-header-buffer) - (kill-buffer single-header--current-header-buffer))) + (remove-hook 'after-make-frame-functions 'single-header--init-frame) + ;; TODO frame creation hook + (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))) (defun single-header-update (&optional force) - "Update the contents of the header line by calling `single-header-format' -with the header buffer current and empty." - (let ((cur-time (time-convert (current-time) 'integer)) - (next-time (time-add single-header--last-update-time - single-header-update-increment))) - (when (or force (time-less-p next-time cur-time)) - (with-current-buffer single-header--current-header-buffer - (erase-buffer) - (single-header-format)) - (setq single-header--last-update-time cur-time)))) + "" + (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 + (let ((str (single-header--time-memo force frame + single-header-format frame win buf))) + (replace-region-contents (point-min) (point-max) str))))))) (define-minor-mode single-header-mode "Global minor mode to enable a single info line at the top of each frame." |