331 lines
12 KiB
EmacsLisp
331 lines
12 KiB
EmacsLisp
;;; notibox.el --- PosFrame-based notification UI -*- lexical-binding: t; -*-
|
|
|
|
;; Copyright (C) 2023 mir
|
|
|
|
;; Author: mir <mirmarq428@gmail.com>
|
|
;; Keywords:frames,convenience,help
|
|
;; Package-Requires: ((posframe) (alert) (dash))
|
|
|
|
;; This file is NOT part of GNU Emacs.
|
|
|
|
;; This program is free software; you can redistribute it and/or modify
|
|
;; it under the terms of the GNU General Public License as published by
|
|
;; the Free Software Foundation, either version 3 of the License, or
|
|
;; (at your option) any later version.
|
|
|
|
;; This program is distributed in the hope that it will be useful,
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;; GNU General Public License for more details.
|
|
|
|
;; You should have received a copy of the GNU General Public License
|
|
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
|
|
|
|
;;; Commentary:
|
|
|
|
;; This package shows a temporary child frame which mirrors the contents of the
|
|
;; echo area. It was designed to be used with configurations that hide the echo
|
|
;; area by splitting it into a `minibuffer-frame'.
|
|
|
|
;; it even shows multiple notifications in a stack!
|
|
|
|
;;; Code:
|
|
|
|
;; imports
|
|
(require 'posframe)
|
|
(require 'alert)
|
|
(require 'dash)
|
|
(if (not (fboundp #'string-pixel-width))
|
|
(progn
|
|
(require 'shr) ;for `shr-string-pixel-width'
|
|
(defalias #'string-pixel-width #'shr-string-pixel-width)))
|
|
|
|
;; variables / customizations
|
|
(defvar notibox-width 40) ; characters
|
|
(defvar notibox-height 4) ; characters
|
|
(defvar notibox-border-color "#808080") ; just a global default
|
|
(defvar notibox-current-posframes nil)
|
|
(defvar last-message nil
|
|
"Previous value of `current-message', stored for notibox.")
|
|
(defvar mir/framove-update-interval 0.05
|
|
"How many seconds to wait before updating incremental frame positions.")
|
|
(defgroup notibox nil
|
|
"The notification box.")
|
|
(defcustom notibox-corner 'bottomright
|
|
"Corner in which to show the NotiBox."
|
|
:type '(choice
|
|
(const :tag "Top Left" 'topleft)
|
|
(const :tag "Bottom Left" 'bottomleft)
|
|
(const :tag "Top Right" 'topright)
|
|
(const :tag "Bottom Right" 'bottomright)))
|
|
(defvar notibox-padding 30)
|
|
(defvar alert-fade-time 5); seconds, also provided by `alert' package
|
|
(defvar notibox--refresh-delay 0.1) ; seconds. Probably don't change this one.
|
|
|
|
;; functions - static frame ----------------------------------------------------
|
|
(defun notibox--get-position (&optional stackdepth)
|
|
"Return the starting coordinate at which to place the next notibox, as cons.
|
|
|
|
If STACKDEPTH is non-nil and nonzero, return a position that far down."
|
|
(let* (
|
|
;; need to not overlap the gtk scrollbar
|
|
(scrollbar-width (or (if (eq x-toolkit-scroll-bars 'gtk)
|
|
30) ; educated guess...
|
|
0))
|
|
;; (stackdepth (or stackdepth 0))
|
|
(stackdepth 0) ; we do not care actually
|
|
(parent-width (frame-pixel-width))
|
|
(child-width (* notibox-width (string-pixel-width " ")))
|
|
(parent-height (frame-pixel-height))
|
|
(child-height (* notibox-height (line-pixel-height)))
|
|
(padded-height (+ child-height notibox-padding))
|
|
(x-justify (pcase notibox-corner
|
|
((or 'topleft 'bottomleft) notibox-padding)
|
|
((or 'topright 'bottomright)
|
|
(- (- parent-width scrollbar-width)
|
|
(+ child-width notibox-padding)))))
|
|
(y-justify (pcase notibox-corner
|
|
((or 'topleft 'topright) notibox-padding)
|
|
((or 'bottomleft 'bottomright)
|
|
(- parent-height (+ child-height notibox-padding)))))
|
|
(y-direction (pcase notibox-corner
|
|
((or 'topleft 'topright) #'+)
|
|
((or 'bottomleft 'bottomright) #'-)))
|
|
(y-coord (funcall y-direction y-justify (* stackdepth padded-height)))
|
|
)
|
|
(cons x-justify y-coord)))
|
|
(cl-defun notibox--show (&key timeout &key depth &key buf)
|
|
"Show the notibox currently prepared, with optional TIMEOUT, at DEPTH, in BUF."
|
|
(let ((this-notibox
|
|
(let ((buffer (get-buffer-create (or buf "*notibox*"))))
|
|
(posframe-show buffer
|
|
:position (notibox--get-position depth)
|
|
:left-fringe 0
|
|
:right-fringe 0
|
|
:max-width notibox-width
|
|
:max-height notibox-height
|
|
:min-width notibox-width
|
|
:min-height notibox-height
|
|
:border-width 2
|
|
:border-color notibox-border-color
|
|
;; :timeout timeout
|
|
))
|
|
))
|
|
(run-with-timer timeout nil #'notibox-delete this-notibox)
|
|
(mir/push-notibox this-notibox)
|
|
;; (add-to-list 'notibox-current-posframes
|
|
;; this-notibox)
|
|
)
|
|
nil)
|
|
(defun notibox-alert (info)
|
|
"Show a notibox corresponding with INFO. Can* be used as a backend for `alert'."
|
|
(let* ((message (plist-get info :message))
|
|
(title (plist-get info :title))
|
|
(timeout (plist-get info :persistent))
|
|
(depth (plist-get info :depth)))
|
|
;; gotta make it move the others down...
|
|
(notibox--show :timeout (unless timeout alert-fade-time)
|
|
;; :depth (or depth (- (length notibox-current-posframes) 1))
|
|
:buf (notibox--prepare-buffer title message))))
|
|
(defun notibox--resolve-frame (object)
|
|
"Return the /frame reference/ signified by OBJECT, whatever it may be."
|
|
(cond
|
|
((framep object) object) ;this is the easy one
|
|
((windowp object) (window-frame object))
|
|
((bufferp object) (window-frame (get-window-buffer object)))
|
|
((stringp object)
|
|
(window-frame (get-buffer-window (get-buffer object))))
|
|
((symbolp object)
|
|
(window-frame (get-buffer-window (get-buffer (format "%s" object)))))
|
|
))
|
|
;; (notibox--resolve-frame "*notibox*")
|
|
|
|
(defun notibox--hide (frame)
|
|
"Stop showing FRAME."
|
|
(if (frame-live-p frame)
|
|
(posframe-delete (window-buffer (frame-selected-window frame)))))
|
|
|
|
(defun notibox-delete (frame)
|
|
"Delete the notibox FRAME.
|
|
|
|
If FRAME is the root Emacs window, or some other symbol, hide all notiboxes."
|
|
(let ((frame (notibox--resolve-frame frame)))
|
|
(if frame
|
|
(notibox--hide frame)
|
|
(notibox--hide (car notibox-current-posframes))
|
|
))
|
|
|
|
(pop notibox-current-posframes))
|
|
(defun notibox/setup-timer ()
|
|
"Start running notibox."
|
|
(interactive)
|
|
(run-with-timer notibox--refresh-delay notibox--refresh-delay #'notibox--tail-echoarea))
|
|
(defun notibox-test-alert ()
|
|
"Show a sample notibox to prove we can."
|
|
(interactive)
|
|
(notibox-alert `(:title ,(random 8096) :message "test of notibox")))
|
|
(defun notibox-test-message ()
|
|
"Send a message and see if it gets picked up by notibox."
|
|
(message "test message %s: %s is a number" (random 40) (random 500)))
|
|
|
|
|
|
;; functions - frame moving ----------------------------------------------------
|
|
(defun mir/move-frame (frame pos)
|
|
"Move FRAME to POS, a cons of (top . left)."
|
|
(if (frame-live-p frame)
|
|
(modify-frame-parameters frame
|
|
`(
|
|
(top . ,(car pos))
|
|
(left . ,(cdr pos))
|
|
))))
|
|
(defun mir/framove-gradual (frame newpos duration)
|
|
"Move FRAME to NEWPOS ( a cons of top and left) over DURATION.
|
|
|
|
intermediate positions are calculated via `mir/framove-update-interval'."
|
|
(let* (
|
|
(how-many-steps (/ duration mir/framove-update-interval))
|
|
(updates-num-seq (number-sequence 1 how-many-steps))
|
|
(timestamps (--map (* mir/framove-update-interval it) updates-num-seq))
|
|
(beg-top (frame-parameter frame 'top))
|
|
(beg-left (frame-parameter frame 'left))
|
|
(end-top (car newpos))
|
|
(end-left (cdr newpos))
|
|
(top-diff (/ (- end-top beg-top) (float how-many-steps)))
|
|
(left-diff (/ (- end-left beg-left) (float how-many-steps)))
|
|
(tops (or (number-sequence beg-top end-top top-diff) 0))
|
|
(lefts (or (number-sequence beg-left end-left left-diff) 0))
|
|
(uhm
|
|
(--map (list
|
|
(or (elt timestamps it) duration)
|
|
(or (elt tops it) beg-top)
|
|
(or (elt lefts it) beg-left)
|
|
)
|
|
updates-num-seq
|
|
))
|
|
(timerfun (lambda (threelist)
|
|
(let ((timestamp (-first-item threelist))
|
|
(top (-second-item threelist))
|
|
(left (-third-item threelist)))
|
|
(if (and top left)
|
|
(run-with-timer timestamp nil ;no repeat
|
|
#'mir/move-frame
|
|
frame
|
|
(cons (round top) (round left))
|
|
)
|
|
;; (message "%s" threelist)
|
|
))))
|
|
)
|
|
(mapcar timerfun uhm)
|
|
)
|
|
nil
|
|
)
|
|
|
|
(defun mir/notibox-down-one (frame)
|
|
"Move FRAME down by `notibox-padding'."
|
|
(if (frame-live-p frame)
|
|
(let* ((parms (frame-parameters frame))
|
|
(old-y (alist-get 'top parms))
|
|
(old-x (alist-get 'left parms)))
|
|
(mir/framove-gradual frame (cons
|
|
(+ old-y ;; (- (* notibox-height
|
|
;; (window-text-height))
|
|
;; notibox-padding)
|
|
(/
|
|
(+ (* (window-text-height) notibox-height)
|
|
notibox-padding)
|
|
2))
|
|
old-x
|
|
) 0.125))))
|
|
;; (notibox-test-alert)
|
|
;; (notibox-test-message)
|
|
|
|
(defun mir/push-notibox (frame)
|
|
"Push FRAME onto `notibox-current-posframes' and display it at the top of the stack."
|
|
(--map (mir/notibox-down-one it) ; move each by the interval - need more infra first
|
|
(reverse notibox-current-posframes))
|
|
(push frame notibox-current-posframes)
|
|
)
|
|
|
|
;; functions - message parsing -------------------------------------------------
|
|
(defun notibox--prepare-buffer (title body &optional buffer)
|
|
"Return the notibox buffer containing TITLE and BODY, properly formatted"
|
|
(let ((buf (get-buffer-create (format " *notibox-- %s: %s *" title body))))
|
|
(with-current-buffer buf
|
|
(let ((inhibit-read-only t))
|
|
(erase-buffer)
|
|
(insert (format "%s\n%s\n%s" ;; (buttonize title #'view-echo-area-messages)
|
|
title
|
|
(propertize (make-string notibox-width ?─)
|
|
'face `((:foreground ,notibox-border-color)))
|
|
body))))
|
|
buf))
|
|
(defun notibox--parse-message (msg)
|
|
"Given string MSG, return a cons of source and contents.
|
|
If the source is not obvious, use `current-buffer'."
|
|
(let* (source
|
|
contents
|
|
(splooted (split-string msg ": ")))
|
|
(pcase (length splooted)
|
|
;; problem: the echo area shows only cdr, whereas messages buffer shows the source fn we want..
|
|
(1 (progn
|
|
(setq source
|
|
(format "%s"
|
|
(current-buffer)))
|
|
(setq contents
|
|
(car splooted))))
|
|
(2 (progn
|
|
(setq source (car splooted))
|
|
(setq contents (cadr splooted))))
|
|
(3 (progn
|
|
(setq source (car splooted))
|
|
(setq contents (format "%s: %s" (cadr splooted) (caddr splooted)))))
|
|
)
|
|
(cons source contents)))
|
|
(defun buflast (buffer)
|
|
"Return the last line of BUFFER as a string, without linebreaks."
|
|
(with-current-buffer buffer
|
|
(save-excursion
|
|
(goto-char (- (point-max) 1)) ; there is a \n at the end of every buffer
|
|
(buffer-substring-no-properties (point-at-bol) (point-max)))))
|
|
(defun notibox--tail-echoarea ()
|
|
"Show `current-message' in the notibox. If that does not exist, probably hide it."
|
|
(if (current-message)
|
|
(unless (string= last-message (current-message))
|
|
(let* ((notibox-border-color "#0faa0f") ; hacky, can we set it elsewhere?
|
|
(parsed-msg
|
|
(notibox--parse-message
|
|
;; (current-message)
|
|
(buflast (get-buffer "*Messages*")) ; workaround for abbreviated stuff
|
|
))
|
|
(title (car parsed-msg))
|
|
(contents (cdr parsed-msg)))
|
|
(notibox-alert `( :title ,title
|
|
:message ,contents
|
|
)))
|
|
(setq last-message (current-message)))
|
|
;; (if notibox-current-posframes
|
|
;; (notibox-delete (car notibox-current-posframes)))
|
|
)
|
|
)
|
|
|
|
|
|
|
|
|
|
;; (add-variable-watcher 'notibox-current-posframes
|
|
;; (lambda (symbol newval operation where)
|
|
;; "Display the variable in *watched* buffer."
|
|
;; (with-current-buffer (get-buffer-create "*watched*")
|
|
;; (goto-char (point-max))
|
|
;; (insert
|
|
;; (format "\n%s:\n was: %s\n now: %s"
|
|
;; symbol
|
|
;; (eval symbol)
|
|
;; newval)))
|
|
;; ))
|
|
;; (--map (remove-variable-watcher 'notibox-current-posframes it)
|
|
;; (get-variable-watchers 'notibox-current-posframes))
|
|
|
|
|
|
(provide 'notibox)
|
|
;;; notibox.el ends here
|