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

(make-frame-on-display): Add completion on available display names.

2 files changed, 39 insertions, 1 deletions

diff --git a/etc/NEWS b/etc/NEWS
index 587d20cce35..26b0a931d8d 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -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
 
diff --git a/lisp/frame.el b/lisp/frame.el
index dc81302939e..8a4a0b6639b 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -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)