diff options
Diffstat (limited to 'lisp/frame.el')
| -rw-r--r-- | lisp/frame.el | 269 |
1 files changed, 237 insertions, 32 deletions
diff --git a/lisp/frame.el b/lisp/frame.el index 69119b4c24f..27f99fb7d21 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -702,7 +702,9 @@ Return nil if we don't know how to interpret DISPLAY." The optional argument PARAMETERS specifies additional frame parameters." (interactive (if (fboundp 'x-display-list) (list (completing-read "Make frame on display: " - (x-display-list))) + (x-display-list) nil + nil (car (x-display-list)) + nil (car (x-display-list)))) (user-error "This Emacs build does not support X displays"))) (make-frame (cons (cons 'display display) parameters))) @@ -799,7 +801,7 @@ also select the new frame." (window-state-get (frame-root-window frame)))) (default-frame-alist (seq-remove (lambda (elem) - (memq (car elem) '(name parent-id))) + (memq (car elem) frame-internal-parameters)) (frame-parameters frame))) (new-frame (make-frame))) (when windows @@ -809,12 +811,16 @@ also select the new frame." new-frame)) (defvar before-make-frame-hook nil - "Functions to run before `make-frame' creates a new frame.") + "Functions to run before `make-frame' creates a new frame. +Note that these functions are usually not run for the initial +frame, unless you add them to the hook in your early-init file.") (defvar after-make-frame-functions nil "Functions to run after `make-frame' created a new frame. The functions are run with one argument, the newly created -frame.") +frame. +Note that these functions are usually not run for the initial +frame, unless you add them to the hook in your early-init file.") (defvar after-setting-font-hook nil "Functions to run after a frame's font has been changed.") @@ -879,7 +885,6 @@ the new frame according to its own rules." (error "Don't know how to interpret display %S" display))) (t window-system))) - (oldframe (selected-frame)) (params parameters) frame child-frame) @@ -897,8 +902,12 @@ the new frame according to its own rules." (dolist (p default-frame-alist) (unless (assq (car p) params) (push p params))) - -;; (setq frame-size-history '(1000)) + ;; Add parameters from `frame-inherited-parameters' unless they are + ;; overridden by explicit parameters. + (dolist (param frame-inherited-parameters) + (unless (assq param parameters) + (let ((val (frame-parameter nil param))) + (when val (push (cons param val) params))))) (when (eq (cdr (or (assq 'minibuffer params) '(minibuffer . t))) 'child-frame) @@ -931,12 +940,6 @@ the new frame according to its own rules." frame 'minibuffer (frame-root-window child-frame)))) (normal-erase-is-backspace-setup-frame frame) - ;; Inherit original frame's parameters unless they are overridden - ;; by explicit parameters. - (dolist (param frame-inherited-parameters) - (unless (assq param parameters) - (let ((val (frame-parameter oldframe param))) - (when val (set-frame-parameter frame param val))))) ;; We can run `window-configuration-change-hook' for this frame now. (frame-after-make-frame frame t) @@ -1586,6 +1589,11 @@ acquires focus to be automatically raised. Note that this minor mode controls Emacs's own auto-raise feature. Window managers that switch focus on mouse movement often have their own auto-raise feature." + ;; This isn't really a global minor mode; rather, it's local to the + ;; selected frame, but declaring it as global prevents a misleading + ;; "Auto-Raise mode enabled in current buffer" message from being + ;; displayed when it is turned on. + :global t :variable (frame-parameter nil 'auto-raise) (if (frame-parameter nil 'auto-raise) (raise-frame))) @@ -1634,6 +1642,8 @@ live frame and defaults to the selected one." (declare-function x-frame-geometry "xfns.c" (&optional frame)) (declare-function w32-frame-geometry "w32fns.c" (&optional frame)) (declare-function ns-frame-geometry "nsfns.m" (&optional frame)) +(declare-function pgtk-frame-geometry "pgtkfns.c" (&optional frame)) +(declare-function haiku-frame-geometry "haikufns.c" (&optional frame)) (defun frame-geometry (&optional frame) "Return geometric attributes of FRAME. @@ -1683,6 +1693,10 @@ and width values are in pixels. (w32-frame-geometry frame)) ((eq frame-type 'ns) (ns-frame-geometry frame)) + ((eq frame-type 'pgtk) + (pgtk-frame-geometry frame)) + ((eq frame-type 'haiku) + (haiku-frame-geometry frame)) (t (list '(outer-position 0 . 0) @@ -1713,7 +1727,7 @@ to the selected frame. Storing information about resize operations is off by default. If you set the variable `frame-size-history' like this -(setq frame-size-history '(100)) +(setq frame-size-history \\='(100)) then Emacs will save information about the next 100 significant operations affecting any frame's size in that variable. This @@ -1807,6 +1821,8 @@ of frames like calls to map a frame or change its visibility." (declare-function x-frame-edges "xfns.c" (&optional frame type)) (declare-function w32-frame-edges "w32fns.c" (&optional frame type)) (declare-function ns-frame-edges "nsfns.m" (&optional frame type)) +(declare-function pgtk-frame-edges "pgtkfns.c" (&optional frame type)) +(declare-function haiku-frame-edges "haikufns.c" (&optional frame type)) (defun frame-edges (&optional frame type) "Return coordinates of FRAME's edges. @@ -1830,12 +1846,18 @@ FRAME." (w32-frame-edges frame type)) ((eq frame-type 'ns) (ns-frame-edges frame type)) + ((eq frame-type 'pgtk) + (pgtk-frame-edges frame type)) + ((eq frame-type 'haiku) + (haiku-frame-edges frame type)) (t (list 0 0 (frame-width frame) (frame-height frame)))))) (declare-function w32-mouse-absolute-pixel-position "w32fns.c") (declare-function x-mouse-absolute-pixel-position "xfns.c") (declare-function ns-mouse-absolute-pixel-position "nsfns.m") +(declare-function pgtk-mouse-absolute-pixel-position "pgtkfns.c") +(declare-function haiku-mouse-absolute-pixel-position "haikufns.c") (defun mouse-absolute-pixel-position () "Return absolute position of mouse cursor in pixels. @@ -1850,12 +1872,18 @@ position (0, 0) of the selected frame's terminal." (w32-mouse-absolute-pixel-position)) ((eq frame-type 'ns) (ns-mouse-absolute-pixel-position)) + ((eq frame-type 'pgtk) + (pgtk-mouse-absolute-pixel-position)) + ((eq frame-type 'haiku) + (haiku-mouse-absolute-pixel-position)) (t (cons 0 0))))) +(declare-function pgtk-set-mouse-absolute-pixel-position "pgtkfns.c" (x y)) (declare-function ns-set-mouse-absolute-pixel-position "nsfns.m" (x y)) (declare-function w32-set-mouse-absolute-pixel-position "w32fns.c" (x y)) (declare-function x-set-mouse-absolute-pixel-position "xfns.c" (x y)) +(declare-function haiku-set-mouse-absolute-pixel-position "haikufns.c" (x y)) (defun set-mouse-absolute-pixel-position (x y) "Move mouse pointer to absolute pixel position (X, Y). @@ -1863,12 +1891,16 @@ The coordinates X and Y are interpreted in pixels relative to a position (0, 0) of the selected frame's terminal." (let ((frame-type (framep-on-display))) (cond + ((eq frame-type 'pgtk) + (pgtk-set-mouse-absolute-pixel-position x y)) ((eq frame-type 'ns) (ns-set-mouse-absolute-pixel-position x y)) ((eq frame-type 'x) (x-set-mouse-absolute-pixel-position x y)) ((eq frame-type 'w32) - (w32-set-mouse-absolute-pixel-position x y))))) + (w32-set-mouse-absolute-pixel-position x y)) + ((eq frame-type 'haiku) + (haiku-set-mouse-absolute-pixel-position x y))))) (defun frame-monitor-attributes (&optional frame) "Return the attributes of the physical monitor dominating FRAME. @@ -1961,6 +1993,9 @@ workarea attribute." (declare-function x-frame-list-z-order "xfns.c" (&optional display)) (declare-function w32-frame-list-z-order "w32fns.c" (&optional display)) (declare-function ns-frame-list-z-order "nsfns.m" (&optional display)) +;; TODO: implement this on PGTK. +;; (declare-function pgtk-frame-list-z-order "pgtkfns.c" (&optional display)) +(declare-function haiku-frame-list-z-order "haikufns.c" (&optional display)) (defun frame-list-z-order (&optional display) "Return list of Emacs' frames, in Z (stacking) order. @@ -1980,11 +2015,19 @@ Return nil if DISPLAY contains no Emacs frame." ((eq frame-type 'w32) (w32-frame-list-z-order display)) ((eq frame-type 'ns) - (ns-frame-list-z-order display))))) + (ns-frame-list-z-order display)) + ((eq frame-type 'pgtk) + ;; This is currently not supported on PGTK. + ;; (pgtk-frame-list-z-order display) + nil) + ((eq frame-type 'haiku) + (haiku-frame-list-z-order display))))) (declare-function x-frame-restack "xfns.c" (frame1 frame2 &optional above)) (declare-function w32-frame-restack "w32fns.c" (frame1 frame2 &optional above)) (declare-function ns-frame-restack "nsfns.m" (frame1 frame2 &optional above)) +(declare-function pgtk-frame-restack "pgtkfns.c" (frame1 frame2 &optional above)) +(declare-function haiku-frame-restack "haikufns.c" (frame1 frame2 &optional above)) (defun frame-restack (frame1 frame2 &optional above) "Restack FRAME1 below FRAME2. @@ -2014,7 +2057,11 @@ Some window managers may refuse to restack windows." ((eq frame-type 'w32) (w32-frame-restack frame1 frame2 above)) ((eq frame-type 'ns) - (ns-frame-restack frame1 frame2 above)))) + (ns-frame-restack frame1 frame2 above)) + ((eq frame-type 'haiku) + (haiku-frame-restack frame1 frame2 above)) + ((eq frame-type 'pgtk) + (pgtk-frame-restack frame1 frame2 above)))) (error "Cannot restack frames"))) (defun frame-size-changed-p (&optional frame) @@ -2061,8 +2108,8 @@ frame's display)." ((eq frame-type 'w32) (with-no-warnings (> w32-num-mouse-buttons 0))) - ((memq frame-type '(x ns)) - t) ;; We assume X and NeXTstep *always* have a pointing device + ((memq frame-type '(x ns haiku pgtk)) + t) ;; We assume X, NeXTstep, GTK, and Haiku *always* have a pointing device (t (or (and (featurep 'xt-mouse) xterm-mouse-mode) @@ -2087,7 +2134,7 @@ frames and several different fonts at once. This is true for displays that use a window system such as X, and false for text-only terminals. DISPLAY can be a display name, a frame, or nil (meaning the selected frame's display)." - (not (null (memq (framep-on-display display) '(x w32 ns))))) + (not (null (memq (framep-on-display display) '(x w32 ns pgtk haiku))))) (defun display-images-p (&optional display) "Return non-nil if DISPLAY can display images. @@ -2115,7 +2162,7 @@ frame's display)." ;; a Windows DOS Box. (with-no-warnings (not (null dos-windows-version)))) - ((memq frame-type '(x w32 ns)) + ((memq frame-type '(x w32 ns pgtk)) t) (t nil)))) @@ -2125,7 +2172,7 @@ frame's display)." This means that, for example, DISPLAY can differentiate between the keybinding RET and [return]." (let ((frame-type (framep-on-display display))) - (or (memq frame-type '(x w32 ns pc)) + (or (memq frame-type '(x w32 ns pc pgtk)) ;; MS-DOS and MS-Windows terminals have built-in support for ;; function (symbol) keys (memq system-type '(ms-dos windows-nt))))) @@ -2138,7 +2185,7 @@ DISPLAY should be either a frame or a display name (a string). If DISPLAY is omitted or nil, it defaults to the selected frame's display." (let ((frame-type (framep-on-display display))) (cond - ((memq frame-type '(x w32 ns)) + ((memq frame-type '(x w32 ns haiku pgtk)) (x-display-screens display)) (t 1)))) @@ -2158,7 +2205,7 @@ with DISPLAY. To get information for each physical monitor, use `display-monitor-attributes-list'." (let ((frame-type (framep-on-display display))) (cond - ((memq frame-type '(x w32 ns)) + ((memq frame-type '(x w32 ns haiku pgtk)) (x-display-pixel-height display)) (t (frame-height (if (framep display) display (selected-frame))))))) @@ -2178,7 +2225,7 @@ with DISPLAY. To get information for each physical monitor, use `display-monitor-attributes-list'." (let ((frame-type (framep-on-display display))) (cond - ((memq frame-type '(x w32 ns)) + ((memq frame-type '(x w32 ns haiku pgtk)) (x-display-pixel-width display)) (t (frame-width (if (framep display) display (selected-frame))))))) @@ -2216,7 +2263,7 @@ For graphical terminals, note that on \"multi-monitor\" setups this refers to the height in millimeters for all physical monitors associated with DISPLAY. To get information for each physical monitor, use `display-monitor-attributes-list'." - (and (memq (framep-on-display display) '(x w32 ns)) + (and (memq (framep-on-display display) '(x w32 ns haiku pgtk)) (or (cddr (assoc (or display (frame-parameter nil 'display)) display-mm-dimensions-alist)) (cddr (assoc t display-mm-dimensions-alist)) @@ -2237,7 +2284,7 @@ For graphical terminals, note that on \"multi-monitor\" setups this refers to the width in millimeters for all physical monitors associated with DISPLAY. To get information for each physical monitor, use `display-monitor-attributes-list'." - (and (memq (framep-on-display display) '(x w32 ns)) + (and (memq (framep-on-display display) '(x w32 ns haiku pgtk)) (or (cadr (assoc (or display (frame-parameter nil 'display)) display-mm-dimensions-alist)) (cadr (assoc t display-mm-dimensions-alist)) @@ -2255,7 +2302,7 @@ DISPLAY can be a display name or a frame. If DISPLAY is omitted or nil, it defaults to the selected frame's display." (let ((frame-type (framep-on-display display))) (cond - ((memq frame-type '(x w32 ns)) + ((memq frame-type '(x w32 ns haiku pgtk)) (x-display-backing-store display)) (t 'not-useful)))) @@ -2268,7 +2315,7 @@ DISPLAY can be a display name or a frame. If DISPLAY is omitted or nil, it defaults to the selected frame's display." (let ((frame-type (framep-on-display display))) (cond - ((memq frame-type '(x w32 ns)) + ((memq frame-type '(x w32 ns haiku pgtk)) (x-display-save-under display)) (t 'not-useful)))) @@ -2281,7 +2328,7 @@ DISPLAY can be a display name or a frame. If DISPLAY is omitted or nil, it defaults to the selected frame's display." (let ((frame-type (framep-on-display display))) (cond - ((memq frame-type '(x w32 ns)) + ((memq frame-type '(x w32 ns haiku pgtk)) (x-display-planes display)) ((eq frame-type 'pc) 4) @@ -2296,7 +2343,7 @@ DISPLAY can be a display name or a frame. If DISPLAY is omitted or nil, it defaults to the selected frame's display." (let ((frame-type (framep-on-display display))) (cond - ((memq frame-type '(x w32 ns)) + ((memq frame-type '(x w32 ns haiku pgtk)) (x-display-color-cells display)) ((eq frame-type 'pc) 16) @@ -2313,7 +2360,7 @@ DISPLAY can be a display name or a frame. If DISPLAY is omitted or nil, it defaults to the selected frame's display." (let ((frame-type (framep-on-display display))) (cond - ((memq frame-type '(x w32 ns)) + ((memq frame-type '(x w32 ns haiku pgtk)) (x-display-visual-class display)) ((and (memq frame-type '(pc t)) (tty-display-color-p display)) @@ -2327,6 +2374,10 @@ If DISPLAY is omitted or nil, it defaults to the selected frame's display." (&optional display)) (declare-function ns-display-monitor-attributes-list "nsfns.m" (&optional terminal)) +(declare-function pgtk-display-monitor-attributes-list "pgtkfns.c" + (&optional terminal)) +(declare-function haiku-display-monitor-attributes-list "haikufns.c" + (&optional terminal)) (defun display-monitor-attributes-list (&optional display) "Return a list of physical monitor attributes on DISPLAY. @@ -2344,6 +2395,7 @@ of attribute keys and values as follows: mm-size -- Width and height in millimeters in the form of (WIDTH HEIGHT) frames -- List of frames dominated by the physical monitor + scale-factor (*) -- Scale factor (float) name (*) -- Name of the physical monitor as a string source (*) -- Source of multi-monitor information as a string @@ -2375,6 +2427,10 @@ monitors." (w32-display-monitor-attributes-list display)) ((eq frame-type 'ns) (ns-display-monitor-attributes-list display)) + ((eq frame-type 'pgtk) + (pgtk-display-monitor-attributes-list display)) + ((eq frame-type 'haiku) + (haiku-display-monitor-attributes-list display)) (t (let ((geometry (list 0 0 (display-pixel-width display) (display-pixel-height display)))) @@ -2384,6 +2440,70 @@ monitors." ,(display-mm-height display))) (frames . ,(frames-on-display-list display))))))))) +(declare-function x-device-class "term/x-win.el" (name)) +(declare-function pgtk-device-class "term/pgtk-win.el" (name)) + +(defun device-class (frame name) + "Return the class of the device NAME for an event generated on FRAME. +NAME is a string that can be the value of `last-event-device', or +nil. FRAME is a window system frame, typically the value of +`last-event-frame' when `last-event-device' was set. On some +window systems, it can also be a display name or a terminal. + +The class of a device is one of the following symbols: + + `core-keyboard' means the device is a keyboard-like device, but + any other characteristics are unknown. + + `core-pointer' means the device is a pointing device, but any + other characteristics are unknown. + + `mouse' means the device is a computer mouse. + + `trackpoint' means the device is a joystick or trackpoint. + + `eraser' means the device is an eraser, which is typically the + other end of a stylus on a graphics tablet. + + `pen' means the device is a stylus or some other similar + device. + + `puck' means the device is a device similar to a mouse, but + reports absolute coordinates. + + `power-button' means the device is a power button, volume + button, or some similar control. + + `keyboard' means the device is a keyboard. + + `touchscreen' means the device is a touchscreen. + + `pad' means the device is a collection of buttons and rings and + strips commonly found in drawing tablets. + + `touchpad' means the device is an indirect touch device, such + as a touchpad. + + `piano' means the device is a piano, or some other kind of + musical instrument. + + `test' means the device is used by the XTEST extension to + report input. + +It can also be nil, which means the class of the device could not +be determined. Individual window systems may also return other +symbols." + (let ((frame-type (framep-on-display frame))) + (cond ((eq frame-type 'x) + (x-device-class name)) + ((eq frame-type 'pgtk) + (pgtk-device-class name)) + (t (cond + ((string= name "Virtual core pointer") + 'core-pointer) + ((string= name "Virtual core keyboard") + 'core-keyboard)))))) + ;;;; Frame geometry values @@ -2485,6 +2605,77 @@ deleting them." (if iconify (iconify-frame this) (delete-frame this))) (setq this next)))) +(defvar undelete-frame--deleted-frames nil + "Internal variable used by `undelete-frame--save-deleted-frame'.") + +(defun undelete-frame--save-deleted-frame (frame) + "Save the configuration of frames deleted with `delete-frame'. +Only the 16 most recently deleted frames are saved." + (when (and after-init-time (frame-live-p frame)) + (setq undelete-frame--deleted-frames + (cons + (list + (display-graphic-p) + (seq-remove + (lambda (elem) + (or (memq (car elem) frame-internal-parameters) + ;; When the daemon is started from a graphical + ;; environment, TTY frames have a 'display' parameter set + ;; to the value of $DISPLAY (see the note in + ;; `server--on-display-p'). Do not store that parameter + ;; in the frame data, otherwise `undelete-frame' attempts + ;; to restore a graphical frame. + (and (eq (car elem) 'display) (not (display-graphic-p))))) + (frame-parameters frame)) + (window-state-get (frame-root-window frame))) + undelete-frame--deleted-frames)) + (if (> (length undelete-frame--deleted-frames) 16) + (setq undelete-frame--deleted-frames + (butlast undelete-frame--deleted-frames))))) + +(define-minor-mode undelete-frame-mode + "Enable the `undelete-frame' command." + :group 'frames + :global t + (if undelete-frame-mode + (add-hook 'delete-frame-functions + #'undelete-frame--save-deleted-frame -75) + (remove-hook 'delete-frame-functions + #'undelete-frame--save-deleted-frame) + (setq undelete-frame--deleted-frames nil))) + +(defun undelete-frame (&optional arg) + "Undelete a frame deleted with `delete-frame'. +Without a prefix argument, undelete the most recently deleted +frame. +With a numerical prefix argument ARG between 1 and 16, where 1 is +most recently deleted frame, undelete the ARGth deleted frame. +When called from Lisp, returns the new frame." + (interactive "P") + (if (not undelete-frame-mode) + (user-error "Undelete-Frame mode is disabled") + (if (consp arg) + (user-error "Missing deleted frame number argument") + (let* ((number (pcase arg ('nil 1) ('- -1) (_ arg))) + (frame-data (nth (1- number) undelete-frame--deleted-frames)) + (graphic (display-graphic-p))) + (if (not (<= 1 number 16)) + (user-error "%d is not a valid deleted frame number argument" + number) + (if (not frame-data) + (user-error "No deleted frame with number %d" number) + (if (not (eq graphic (nth 0 frame-data))) + (user-error + "Cannot undelete a %s display frame on a %s display" + (if graphic "non-graphic" "graphic") + (if graphic "graphic" "non-graphic")) + (setq undelete-frame--deleted-frames + (delq frame-data undelete-frame--deleted-frames)) + (let* ((default-frame-alist (nth 1 frame-data)) + (frame (make-frame))) + (window-state-put (nth 2 frame-data) (frame-root-window frame) 'safe) + (select-frame-set-input-focus frame) + frame)))))))) ;;; Window dividers. (defgroup window-divider nil @@ -2776,6 +2967,12 @@ If the frame is in fullscreen state, don't change its state, but set the frame's `fullscreen-restore' parameter to `maximized', so the frame will be maximized after disabling fullscreen state. +If you wish to hide the title bar when the frame is maximized, you +can add something like the following to your init file: + + (add-hook \\='window-size-change-functions + #\\='frame-hide-title-bar-when-maximized) + Note that with some window managers you may have to set `frame-resize-pixelwise' to non-nil in order to make a frame appear truly maximized. In addition, you may have to set @@ -2829,6 +3026,7 @@ See also `toggle-frame-maximized'." (define-key ctl-x-5-map "o" #'other-frame) (define-key ctl-x-5-map "5" #'other-frame-prefix) (define-key ctl-x-5-map "c" #'clone-frame) +(define-key ctl-x-5-map "u" #'undelete-frame) (define-key global-map [f11] #'toggle-frame-fullscreen) (define-key global-map [(meta f10)] #'toggle-frame-maximized) (define-key esc-map [f10] #'toggle-frame-maximized) @@ -2890,6 +3088,13 @@ Offer NUMBER as default value, if it is a natural number." bidi-display-reordering bidi-inhibit-bpa)) +(defun frame-hide-title-bar-when-maximized (frame) + "Hide the title bar if FRAME is maximized. +If FRAME isn't maximized, show the title bar." + (set-frame-parameter + frame 'undecorated + (eq (alist-get 'fullscreen (frame-parameters frame)) 'maximized))) + (provide 'frame) ;;; frame.el ends here |