From: "Clément Pit--Claudel" <cpitcla@mit.edu>
To: martin rudalics <rudalics@gmx.at>,
Arthur Miller <arthur.miller.no1@gmail.com>
Cc: 25408@debbugs.gnu.org
Subject: bug#25408: Remove Decorations Around Emacs Frame (Windows OS)
Date: Sat, 11 Feb 2017 16:10:57 -0500 [thread overview]
Message-ID: <0eca254d-1775-35b0-1db1-ad31e0654812@mit.edu> (raw)
In-Reply-To: <301ed349-64c7-12c6-d843-e73eb1e20e83@gmail.com>
[-- Attachment #1.1: Type: text/plain, Size: 98 bytes --]
> I've posted the code I used to test this with company.
Of course, I forgot the attachment.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.2: company-tooltip.el --]
[-- Type: text/x-emacs-lisp; name="company-tooltip.el", Size: 5973 bytes --]
;;; company-tooltip.el --- Use a real ppup to show company candidates
;;; Commentary:
;;
;;; Code:
(require 'company)
(defun company-tooltip--frame-params (parent-frame)
`(;; Initial state
(fullscreen . nil)
(line-spacing . 0)
;; Size
(min-height . 0)
(min-width . 0)
;; Borders and fringes
(left-fringe . 0)
(right-fringe . 0)
(right-divider-width . 0)
(bottom-divider-width . 0)
(border-width . 0)
(internal-border-width . 0)
;; UI components
(undecorated . t)
(menu-bar-lines . 0)
(tool-bar-lines . 0)
(vertical-scroll-bars . nil)
(horizontal-scroll-bars . nil)
;; Buffers
(minibuffer . nil)
(unsplittable . t)
;; Appearance
(cursor-type . nil) ;; FIXME Also use cursor-type and cursor-in-non-selected-windows variables
(background-color . ,(face-attribute 'company-tooltip :background))
;; Behavior
(delete-before . ,parent-frame)
(no-focus-on-map . t)
(skip-taskbar . t)
(no-other-frame . t)
(no-accept-focus . t)
(z-group . above)))
(defvar company-tooltip--frame nil)
(defvar company-tooltip--buffer nil)
(defun company-tooltip--adjust-frame (x y width height)
"Move company tooltip to X, Y and resize to WIDTH, HEIGHT."
(set-frame-position company-tooltip--frame x y)
(set-frame-width company-tooltip--frame width)
(set-frame-height company-tooltip--frame height))
(defun company-tooltip--ensure-frame (x y width height)
"Create or return the company tooltip frame.
X, Y, WIDTH, HEIGHT: see `company-tooltip--adjust-frame'."
(unless (frame-live-p company-tooltip--frame)
;; (cl-letf (((symbol-function 'face-set-after-frame-default)
;; (symbol-function 'ignore)))
(setq company-tooltip--frame (make-frame `((top . ,y)
(left . ,x)
(width . ,width)
(height . ,height)
,@(company-tooltip--frame-params (selected-frame))))))
(company-tooltip--adjust-frame x y width height)
;; (make-frame-visible company-tooltip--frame)
;; FIXME raise-frame doesn't work when called right after make-frame-visible
(raise-frame company-tooltip--frame))
(defvar company-tooltip--map
(let ((map (make-keymap)))
;; FIXME this doesn't cause mouse events to be ignored
(define-key map [t] 'ignore)
map))
(define-derived-mode company-tooltip--mode fundamental-mode "tooltip"
"Major mode for company tooltip frames."
(setq-local overriding-local-map company-tooltip--map)
(setq-local truncate-lines t)
(setq-local mode-line-format nil)
(setq-local cursor-type nil)
(setq-local cursor-in-non-selected-windows nil))
;; (kill-buffer "*company-tooltip*")
(defun company-tooltip--ensure-buffer ()
"Create or return the company tooltip buffer."
(unless company-tooltip--buffer
(with-current-buffer (get-buffer-create "*company-tooltip*")
(company-tooltip--mode)
(setq company-tooltip--buffer (current-buffer)))))
(defun company-tooltip--set-buffer ()
"Set buffer of company tooltip frame."
(company-tooltip--ensure-buffer)
(set-window-buffer (frame-root-window company-tooltip--frame) company-tooltip--buffer))
(defun company-tooltip--posn-x-y (position)
"Return X and Y coordinates of bottom-left corner of POSITION."
(let* ((point-x-y (posn-x-y position))
(window (posn-window position))
(win-edges (window-edges window nil t t))
(win-x-y (cons (nth 0 win-edges) (nth 1 win-edges)))
(frame-x-y (cons (frame-parameter (selected-frame) 'top)
(frame-parameter (selected-frame) 'left))))
(cons (+ (car point-x-y) (car win-x-y))
(+ (cdr point-x-y) (cdr win-x-y)
(line-pixel-height) (window-header-line-height window)))))
(defun company-tooltip--update-1 (width height contents)
"Update position, WIDTH, HEIGHT, CONTENTS, and visibility of tooltip frame."
(let* ((x-y (company-tooltip--posn-x-y (save-excursion
(backward-char (length company-prefix))
(posn-at-point)))))
(company-tooltip--ensure-frame (car x-y) (cdr x-y) width (abs height))
(company-tooltip--set-buffer)
(with-current-buffer company-tooltip--buffer
(erase-buffer)
(insert contents))))
(defun company-tooltip--update (height selection)
"Wrapper around `company-tooltip--update'.
HEIGHT is passed unmodified. SELECTION is used to compute width
and contents."
(let* ((lines (company--create-lines selection (abs height)))
(contents (mapconcat (lambda (l) (concat l "")) lines "\n")))
(company-tooltip--update-1 (string-width (car lines)) height contents)))
(defun company-tooltip-show (row column selection)
(company-tooltip--update (company--pseudo-tooltip-height) selection))
(defun company-tooltip-edit (selection)
(company-tooltip--update (overlay-get company-pseudo-tooltip-overlay 'company-height) selection))
(defun company-tooltip-hide ()
(when (frame-live-p company-tooltip--frame)
;; FIXME: this should work: (make-frame-invisible company-tooltip--frame)
(delete-frame company-tooltip--frame)))
(defun company-tooltip--add-advice ()
(interactive)
(advice-add 'company-pseudo-tooltip-show :after 'company-tooltip-show)
(advice-add 'company-pseudo-tooltip-edit :after 'company-tooltip-edit)
(advice-add 'company-pseudo-tooltip-hide :after 'company-tooltip-hide))
(defun company-tooltip--remove-advice ()
(interactive)
(advice-remove 'company-pseudo-tooltip-show 'company-tooltip-show)
(advice-remove 'company-pseudo-tooltip-edit 'company-tooltip-edit)
(advice-remove 'company-pseudo-tooltip-hide 'company-tooltip-hide))
(provide 'company-tooltip)
;;; company-tooltip.el ends here
[-- Attachment #2: S/MIME Cryptographic Signature --]
[-- Type: application/pkcs7-signature, Size: 1979 bytes --]
next prev parent reply other threads:[~2017-02-11 21:10 UTC|newest]
Thread overview: 85+ messages / expand[flat|nested] mbox.gz Atom feed top
2017-01-09 22:20 bug#25408: Remove Decorations Around Emacs Frame (Windows OS) Arthur Miller
2017-01-10 8:23 ` martin rudalics
2017-01-10 17:07 ` Eli Zaretskii
2017-01-10 18:07 ` martin rudalics
2017-01-10 18:27 ` Eli Zaretskii
2017-01-10 20:39 ` Clément Pit--Claudel
2017-01-11 7:08 ` Arthur Miller
2017-01-11 7:24 ` Arthur Miller
2017-01-11 7:48 ` Arthur Miller
2017-01-11 7:50 ` Arthur Miller
2017-01-11 8:15 ` Arthur Miller
2017-01-11 8:39 ` martin rudalics
2017-01-11 9:17 ` Arthur Miller
2017-01-11 10:20 ` Arthur Miller
2017-01-11 13:55 ` martin rudalics
2017-02-07 5:28 ` Clément Pit--Claudel
2017-02-07 6:53 ` martin rudalics
2017-02-07 13:05 ` Clément Pit--Claudel
2017-02-11 14:27 ` martin rudalics
2017-02-11 21:02 ` Clément Pit--Claudel
2017-02-11 21:10 ` Clément Pit--Claudel [this message]
2017-02-12 11:13 ` martin rudalics
2017-02-15 19:49 ` Arthur Miller
2017-02-16 8:04 ` martin rudalics
2017-02-16 13:22 ` Arthur Miller
2017-02-16 14:06 ` Arthur Miller
2017-02-17 7:03 ` martin rudalics
2017-02-17 7:03 ` martin rudalics
2017-04-12 9:27 ` martin rudalics
2017-05-06 0:06 ` Clément Pit-Claudel
2017-05-06 7:13 ` Eli Zaretskii
2017-05-06 13:26 ` Clément Pit-Claudel
2017-05-06 7:40 ` martin rudalics
2017-05-06 9:41 ` martin rudalics
2017-05-06 13:28 ` Clément Pit-Claudel
2017-05-06 14:20 ` Eli Zaretskii
2017-05-06 21:01 ` Clément Pit-Claudel
2017-05-07 2:30 ` Eli Zaretskii
2017-05-07 8:41 ` martin rudalics
2017-05-07 8:40 ` martin rudalics
2017-05-07 17:19 ` Eli Zaretskii
2017-05-07 18:07 ` martin rudalics
2017-05-07 18:33 ` Eli Zaretskii
2017-05-08 6:48 ` martin rudalics
2017-05-08 14:41 ` Eli Zaretskii
2017-06-25 11:02 ` martin rudalics
2017-06-25 16:23 ` Clément Pit-Claudel
2017-04-12 17:38 ` Alan Third
2017-04-12 19:13 ` martin rudalics
2017-04-12 19:51 ` Alan Third
2017-04-13 7:10 ` martin rudalics
2017-04-13 10:30 ` Alan Third
2017-04-13 11:56 ` martin rudalics
2017-04-15 16:29 ` Alan Third
2017-04-15 19:39 ` martin rudalics
2017-04-17 14:56 ` bug#25408: Remove Decorations Around Emacs Frame (NS port) Alan Third
2017-04-17 15:43 ` martin rudalics
2017-04-17 16:21 ` Alan Third
2017-04-17 17:20 ` martin rudalics
2017-04-17 18:55 ` Alan Third
2017-04-19 7:26 ` martin rudalics
2017-04-19 14:33 ` Alan Third
2017-04-19 16:01 ` martin rudalics
2017-04-19 17:04 ` Alan Third
2017-04-19 18:07 ` martin rudalics
2017-06-10 15:38 ` Alan Third
2017-06-11 8:10 ` martin rudalics
2017-06-11 16:35 ` Alan Third
2017-06-12 6:09 ` martin rudalics
2017-06-12 17:59 ` Alan Third
2017-06-13 7:24 ` martin rudalics
2017-06-22 9:10 ` martin rudalics
2017-06-25 14:22 ` Alan Third
2017-06-25 15:58 ` martin rudalics
2017-07-15 21:27 ` Alan Third
2017-07-16 8:28 ` martin rudalics
2017-04-19 11:24 ` Anders Lindgren
2017-04-19 12:50 ` martin rudalics
2017-04-19 13:51 ` Alan Third
2017-01-11 8:38 ` bug#25408: Remove Decorations Around Emacs Frame (Windows OS) martin rudalics
2017-01-11 16:39 ` Richard Stallman
2017-01-10 19:36 ` Richard Stallman
2017-01-11 13:50 ` bug#25408: SV: " arthur.miller.no1
2017-01-11 13:57 ` martin rudalics
2017-01-11 14:59 ` arthur.miller.no1
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=0eca254d-1775-35b0-1db1-ad31e0654812@mit.edu \
--to=cpitcla@mit.edu \
--cc=25408@debbugs.gnu.org \
--cc=arthur.miller.no1@gmail.com \
--cc=rudalics@gmx.at \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.