move frames. some stuff is still broken but the theory is vindicated by laboratory experiments
This commit is contained in:
parent
0970d7800f
commit
1a24b9d5f6
115
notibox.el
115
notibox.el
@ -78,39 +78,43 @@ If STACKDEPTH is non-nil and nonzero, return a position that far down."
|
||||
(y-direction (pcase notibox-corner
|
||||
((or 'topleft 'topright) #'+)
|
||||
((or 'bottomleft 'bottomright) #'-)))
|
||||
(y-coord (funcall y-direction y-justify (* stackdepth child-height)))
|
||||
(y-coord (funcall y-direction y-justify (* stackdepth padded-height)))
|
||||
)
|
||||
(cons x-justify y-coord)
|
||||
))
|
||||
;; (notibox--get-position 3)
|
||||
|
||||
(defun notibox--prepare-buffer (title body)
|
||||
"Populate the `*notibox*' buffer with TITLE and BODY properly formatted."
|
||||
(with-current-buffer (get-buffer-create "*notibox*")
|
||||
(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)))))
|
||||
;; (notibox--prepare-buffer "test" "this better work gadangit")
|
||||
(defun notibox--prepare-buffer (title body &optional buffer)
|
||||
"Populate the `*notibox*' buffer (or BUFFER if specified) with TITLE and BODY properly formatted."
|
||||
(let ((buf (get-buffer-create (or buffer "*notibox*"))))
|
||||
(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))))))
|
||||
;; (notibox--prepare-buffer "test" "this better work gadahgit" (or nil "*notibox-2*"))
|
||||
;; (get-buffer-create "*notibox-2*")
|
||||
;; wait, we need to be actually basing the things on the buffers huh
|
||||
|
||||
(defvar notibox-current-posframes nil)
|
||||
(cl-defun notibox--show (&key timeout &key depth)
|
||||
"Show the notibox currently prepared, with optional TIMEOUT, at DEPTH."
|
||||
(cl-defun notibox--show (&key timeout &key depth &key buf)
|
||||
"Show the notibox currently prepared, with optional TIMEOUT, at DEPTH, in BUF."
|
||||
(add-to-list 'notibox-current-posframes
|
||||
(posframe-show (get-buffer-create "*notibox*")
|
||||
: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))
|
||||
(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)))
|
||||
nil)
|
||||
|
||||
(defun notibox-alert (info)
|
||||
@ -219,5 +223,66 @@ If the source is not obvious, use `current-buffer'."
|
||||
(notibox-alert '(:title "five" :message "six")))
|
||||
;; (notibox-alert '(:title "一" :message "二" :timeout 5 :depth 0))
|
||||
|
||||
;; begin frame moving experiments. thought we already did this...
|
||||
(setq test-frame (posframe-show "*Messages*"
|
||||
:position '(800 . 50)
|
||||
:width 30
|
||||
:height 16))
|
||||
(defun mir/move-frame (frame pos)
|
||||
"Move FRAME to POS, a cons of (top . left)."
|
||||
(modify-frame-parameters frame
|
||||
`(
|
||||
(top . ,(car pos))
|
||||
(left . ,(cdr pos))
|
||||
)))
|
||||
;; (frame-parameters test-frame)
|
||||
;; (mir/move-frame test-frame '(300 . 1200))
|
||||
(defvar mir/framove-update-interval 0.05
|
||||
"How many seconds to wait before updating incremental frame positions.")
|
||||
|
||||
(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
|
||||
)
|
||||
;; (mir/framove-gradual test-frame '(500 . 1400) 1)
|
||||
;; (mir/move-frame test-frame '(500 . 500))
|
||||
|
||||
(provide 'notibox)
|
||||
;;; notibox.el ends here
|
||||
|
||||
Loading…
Reference in New Issue
Block a user