switch single header to not erase buffer uncessarily

1 files changed, 28 insertions, 36 deletions

diff --git a/emacs/site-lisp/single-header.el b/emacs/site-lisp/single-header.el
index bf48c48..8e55e40 100755
--- a/emacs/site-lisp/single-header.el
+++ b/emacs/site-lisp/single-header.el
@@ -1,4 +1,9 @@
-;; single-header --- Display a topline inside a frame with global info -*- lexical-binding: t; -*-
+;; single-header --- Display a topline inside each frame with global info -*- lexical-binding: t; -*-
+
+;; Author: Thomas Ulmer <tccq@proton.me>
+;; Package-Requires: ((ednc) (battery) (s) (dash))
+;; Package-Version 1.0
+
 (require 'ednc)
 (require 'battery)
 (require 's)
@@ -36,37 +41,23 @@
   :group 'single-header)
 (defvar single-header--active-notifs nil)
 
-(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))))))))
+(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'."
@@ -243,10 +234,11 @@ arg, dismiss all the notifications."
           (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)))
-            (erase-buffer)
-            (insert str)))))))
+          (single-header--time-lock
+           force frame "header-lock"
+           (let ((str (single-header-format frame win buf)))
+             (erase-buffer)
+             (insert str))))))))
 
 (define-minor-mode single-header-mode
   "Global minor mode to enable a single info line at the top of each frame."