posframe wrapper that allow keyboard control

posframe-control.el

;;; posframe-control.el -- supporting keyboard control for posframe -*- lexical-binding: t; -*-

;; Package-requires: ((emacs "26") (posframe "0.3.0") (dash "2.16.0"))

;;; Commentary:

;; This snippet provides keyboard interaction support for posframe
;; (https://github.com/tumashu/posframe). This is achieved by 1.) assigning a
;; name to the posframe-frame via specifying `override-parameters'; 2.) defining
;; command using `with-selected-frame' to operate on the posframe.
;;
;; In order to overshadow current keymapings, I using `set-transient-map' to
;; temporarily activate keymap to control posframe. This keymap is automatically
;; deactivated when `posframe-hide' is called.


;; usage:

;; define posframe using `posframe-control-show' instead of `posframe-show'.
;; Customize `posframe-control-keymap' to suit your need. For any additional
;; command, define them using `posframe-control--define-command'

;; example:
;;
;; define new command:
;; (defun posframe-control-scroll-up ()
;;   (interactive)
;;   (posframe-control--define-command 'score-up))
;;
;; customize keymap
;; (define-key posframe-control-keymap (kbd "C-v") ;posframe-control-scroll-up)
;;
;; call posframe
;; (posframe-control-show
;;   "foo-buffer"
;;   :string "this posframe can be controlled")

;;; Code:

(require 'posframe)
(require 'dash)

(defgroup posframe-control nil
  "Group for posframe-control"
  :group 'posframe
  :prefix "posframe-control-")

(defcustom posframe-control-keymap
  (let ((map (make-sparse-keymap)))
    (suppress-keymap map t)
    (define-key map (kbd "q") 'posframe-control-hide)
    (define-key map (kbd "<escape>") 'posframe-control-hide)
    (define-key map (kbd "C-d") 'posframe-control-scroll-down)
    (define-key map (kbd "C-u") 'posframe-control-scroll-up)
    (define-key map (kbd "J") 'posframe-control-scroll-down)
    (define-key map (kbd "K") 'posframe-control-scroll-up)
    map)
  "Keymap for controlling posframes."
  :type 'keymap
  :group 'posframe-control)

(defvar-local posframe-control--deactivate-fn nil)
(defvar-local posframe-control--frame nil)
(defvar-local posframe-control--buffer nil)


(defun posframe-control--define-command (command &rest arg)
  "Run COMMAND with ARG in `posframe-control--frame'."
  (if posframe-control--frame
      (with-selected-frame posframe-control--frame
        (apply command arg))
    (error "No posframe-control frame found")))

(defun posframe-control-scroll-down ()
  "Scroll half page down."
  (interactive)
  (posframe-control--define-command
   'scroll-up
   (max 1 (/ (1- (window-height (selected-window))) 2))))

(defun posframe-control-scroll-up ()
  "Scroll half page up."
  (interactive)
  (posframe-control--define-command
   'scroll-down
   (max 1 (/ (1- (window-height (selected-window))) 2))))

(defun posframe-control-hide ()
  "Hide posframe."
  (interactive)
  (setq-local posframe-control--frame nil)
  (posframe-hide posframe-control--buffer)
  (ignore-errors
   (-when-let (fn posframe-control--deactivate-fn)
    (setq posframe-control--deactivate-fn nil)
    (funcall fn))))

(defun posframe-control--get-posframe ()
  "Return the frame object for the posframe."
  (-some (lambda (frame)
           (when (equal "posframe-control--frame" (frame-parameter frame 'name))
             frame))
         (frame-list)))

(defun posframe-control-show (posframe-buffer &rest args)
  "Wrapper around `posframe-show'. Create a child-frame that is controlable."
  (posframe-show
   posframe-buffer
   :string (plist-get args :string)
   :position (plist-get args :position)
   :poshandler (plist-get args :poshandler)
   :width (plist-get args :width)
   :height (plist-get args :height)
   :min-width (plist-get args :min-width)
   :min-height (plist-get args :min-height)
   :x-pixel-offset (plist-get args :x-pixel-offset)
   :y-pixel-offset (plist-get args :y-pixel-offset)
   :left-fringe (plist-get args :left-fringe)
   :right-fringe (plist-get args :right-fringe)
   :internal-border-width (plist-get args :internal-border-width)
   :internal-border-color (plist-get args :internal-border-color)
   :font (plist-get args :font)
   :foreground-color (plist-get args :foreground-color)
   :background-color (plist-get args :background-color)
   :respect-header-line (plist-get args :respect-header-line)
   :respect-mode-line (plist-get args :respect-mode-line)
   :face-remap (plist-get args :face-remap)
   :initialize (plist-get args :initialize)
   :no-properties (plist-get args :no-properties)
   :keep-ratio (plist-get args :keep-ratio)
   :timeout (plist-get args :timeout)
   :refresh (plist-get args :refresh)
   :override-parameters '((name . "posframe-control--frame")
                          (no-accept-focus . nil)))

  (setq-local posframe-control--buffer posframe-buffer)
  (setq-local posframe-control--frame (posframe-control--get-posframe))
  (setq-local posframe-control--deactivate-fn (set-transient-map
                                               posframe-control-keymap
                                               t
                                               'posframe-control-hide)))


(provide 'posframe-control)
;;; posframe-control.el ends here