;; 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 'ednc)
(require 'battery)
(require 's)
(require 'dash)

;;; 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
  :interactive t
  (if (not single-header-mode)
      (single-header-delete)
    (single-header-make)))

(provide 'single-header)
;;; single-header.el ends here