1
0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2025-01-21 18:23:59 +00:00

* lisp/frame.el (make-frame-on-monitor): New command. (Bug#34516)

(make-frame-on-display): Add completion on available display names.
This commit is contained in:
Juri Linkov 2019-02-25 23:11:34 +02:00
parent e73adad837
commit 57d2f24005
2 changed files with 39 additions and 1 deletions

View File

@ -1140,6 +1140,10 @@ when given in a string. Previously, '(any "\x80-\xff")' would match
characters U+0080...U+00FF. Now the expression matches raw bytes in
the 128...255 range, as expected.
** Frames
*** New command 'make-frame-on-monitor' makes a frame on the specified monitor.
* New Modes and Packages in Emacs 27.1

View File

@ -644,9 +644,43 @@ Return nil if we don't know how to interpret DISPLAY."
(defun make-frame-on-display (display &optional parameters)
"Make a frame on display DISPLAY.
The optional argument PARAMETERS specifies additional frame parameters."
(interactive "sMake frame on display: ")
(interactive (list (completing-read
(format "Make frame on display: ")
(delete-dups
(mapcar (lambda (frame)
(frame-parameter frame 'display))
(frame-list))))))
(make-frame (cons (cons 'display display) parameters)))
(defun make-frame-on-monitor (monitor &optional display parameters)
"Make a frame on monitor MONITOR.
The optional argument DISPLAY can be a display name, and the optional
argument PARAMETERS specifies additional frame parameters."
(interactive (list (completing-read
(format "Make frame on monitor: ")
(mapcar (lambda (a)
(cdr (assq 'name a)))
(display-monitor-attributes-list)))))
(let* ((monitor-geometry
(car (delq nil (mapcar (lambda (a)
(when (equal (cdr (assq 'name a)) monitor)
(cdr (assq 'workarea a))))
(display-monitor-attributes-list display)))))
(frame-geometry
(when monitor-geometry
(x-parse-geometry (format "%dx%d+%d+%d"
(nth 2 monitor-geometry)
(nth 3 monitor-geometry)
(nth 0 monitor-geometry)
(nth 1 monitor-geometry)))))
(frame-geometry-in-pixels
(when frame-geometry
`((top . ,(cdr (assq 'top frame-geometry)))
(left . ,(cdr (assq 'left frame-geometry)))
(height . (text-pixels . ,(cdr (assq 'height frame-geometry))))
(width . (text-pixels . ,(cdr (assq 'width frame-geometry))))))))
(make-frame (append frame-geometry-in-pixels parameters))))
(declare-function x-close-connection "xfns.c" (terminal))
(defun close-display-connection (display)