summaryrefslogtreecommitdiff
path: root/config/emacs/site-lisp/single-header.el
blob: dc653353305aa1e79513e932ae48fa6c6afcfb5c (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
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