Skip to content

Instantly share code, notes, and snippets.

@junyi-hou

junyi-hou/posframe-control.el

Last active June 5, 2019 04:53
Show Gist options
  • Save junyi-hou/ecd82e27aa1a436961974acedf4dbcf8 to your computer and use it in GitHub Desktop.
Save junyi-hou/ecd82e27aa1a436961974acedf4dbcf8 to your computer and use it in GitHub Desktop.
Download ZIP
posframe wrapper that allow keyboard control
Raw
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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment