LCOV - code coverage report
Current view: top level - lisp - frame.el (source / functions) Hit Total Coverage
Test: tramp-tests.info Lines: 33 890 3.7 %
Date: 2017-08-27 09:44:50 Functions: 8 103 7.8 %

          Line data    Source code
       1             : ;;; frame.el --- multi-frame management independent of window systems  -*- lexical-binding:t -*-
       2             : 
       3             : ;; Copyright (C) 1993-1994, 1996-1997, 2000-2017 Free Software
       4             : ;; Foundation, Inc.
       5             : 
       6             : ;; Maintainer: emacs-devel@gnu.org
       7             : ;; Keywords: internal
       8             : ;; Package: emacs
       9             : 
      10             : ;; This file is part of GNU Emacs.
      11             : 
      12             : ;; GNU Emacs is free software: you can redistribute it and/or modify
      13             : ;; it under the terms of the GNU General Public License as published by
      14             : ;; the Free Software Foundation, either version 3 of the License, or
      15             : ;; (at your option) any later version.
      16             : 
      17             : ;; GNU Emacs is distributed in the hope that it will be useful,
      18             : ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
      19             : ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
      20             : ;; GNU General Public License for more details.
      21             : 
      22             : ;; You should have received a copy of the GNU General Public License
      23             : ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
      24             : 
      25             : ;;; Commentary:
      26             : 
      27             : ;;; Code:
      28             : (eval-when-compile (require 'cl-lib))
      29             : 
      30             : (cl-defgeneric frame-creation-function (params)
      31             :   "Method for window-system dependent functions to create a new frame.
      32             : The window system startup file should add its frame creation
      33             : function to this method, which should take an alist of parameters
      34             : as its argument.")
      35             : 
      36             : (cl-generic-define-context-rewriter window-system (value)
      37             :   ;; If `value' is a `consp', it's probably an old-style specializer,
      38             :   ;; so just use it, and anyway `eql' isn't very useful on cons cells.
      39          18 :   `(window-system ,(if (consp value) value `(eql ,value))))
      40             : 
      41             : (cl-defmethod frame-creation-function (params &context (window-system nil))
      42             :   ;; It's tempting to get rid of tty-create-frame-with-faces and turn it into
      43             :   ;; this method (i.e. move this method to faces.el), but faces.el is loaded
      44             :   ;; much earlier from loadup.el (before cl-generic and even before
      45             :   ;; cl-preloaded), so we'd first have to reorder that part.
      46           0 :   (tty-create-frame-with-faces params))
      47             : 
      48             : (defvar window-system-default-frame-alist nil
      49             :   "Window-system dependent default frame parameters.
      50             : The value should be an alist of elements (WINDOW-SYSTEM . ALIST),
      51             : where WINDOW-SYSTEM is a window system symbol (as returned by `framep')
      52             : and ALIST is a frame parameter alist like `default-frame-alist'.
      53             : Then, for frames on WINDOW-SYSTEM, any parameters specified in
      54             : ALIST supersede the corresponding parameters specified in
      55             : `default-frame-alist'.")
      56             : 
      57             : (defvar display-format-alist nil
      58             :   "Alist of patterns to decode display names.
      59             : The car of each entry is a regular expression matching a display
      60             : name string.  The cdr is a symbol giving the window-system that
      61             : handles the corresponding kind of display.")
      62             : 
      63             : ;; The initial value given here used to ask for a minibuffer.
      64             : ;; But that's not necessary, because the default is to have one.
      65             : ;; By not specifying it here, we let an X resource specify it.
      66             : (defcustom initial-frame-alist nil
      67             :   "Alist of parameters for the initial X window frame.
      68             : You can set this in your init file; for example,
      69             : 
      70             :  (setq initial-frame-alist
      71             :        \\='((top . 1) (left . 1) (width . 80) (height . 55)))
      72             : 
      73             : Parameters specified here supersede the values given in
      74             : `default-frame-alist'.
      75             : 
      76             : If the value calls for a frame without a minibuffer, and you have
      77             : not created a minibuffer frame on your own, a minibuffer frame is
      78             : created according to `minibuffer-frame-alist'.
      79             : 
      80             : You can specify geometry-related options for just the initial
      81             : frame by setting this variable in your init file; however, they
      82             : won't take effect until Emacs reads your init file, which happens
      83             : after creating the initial frame.  If you want the initial frame
      84             : to have the proper geometry as soon as it appears, you need to
      85             : use this three-step process:
      86             : * Specify X resources to give the geometry you want.
      87             : * Set `default-frame-alist' to override these options so that they
      88             :   don't affect subsequent frames.
      89             : * Set `initial-frame-alist' in a way that matches the X resources,
      90             :   to override what you put in `default-frame-alist'."
      91             :   :type '(repeat (cons :format "%v"
      92             :                        (symbol :tag "Parameter")
      93             :                        (sexp :tag "Value")))
      94             :   :group 'frames)
      95             : 
      96             : (defcustom minibuffer-frame-alist '((width . 80) (height . 2))
      97             :   "Alist of parameters for the initial minibuffer frame.
      98             : This is the minibuffer frame created if `initial-frame-alist'
      99             : calls for a frame without a minibuffer.  The parameters specified
     100             : here supersede those given in `default-frame-alist', for the
     101             : initial minibuffer frame.
     102             : 
     103             : You can set this in your init file; for example,
     104             : 
     105             :  (setq minibuffer-frame-alist
     106             :        \\='((top . 1) (left . 1) (width . 80) (height . 2)))
     107             : 
     108             : It is not necessary to include (minibuffer . only); that is
     109             : appended when the minibuffer frame is created."
     110             :   :type '(repeat (cons :format "%v"
     111             :                        (symbol :tag "Parameter")
     112             :                        (sexp :tag "Value")))
     113             :   :group 'frames)
     114             : 
     115             : (defun handle-delete-frame (event)
     116             :   "Handle delete-frame events from the X server."
     117             :   (interactive "e")
     118           0 :   (let* ((frame (posn-window (event-start event))))
     119           0 :     (if (catch 'other-frame
     120           0 :           (dolist (frame-1 (frame-list))
     121             :             ;; A valid "other" frame is visible, has its `delete-before'
     122             :             ;; parameter unset and is not a child frame.
     123           0 :             (when (and (not (eq frame-1 frame))
     124           0 :                        (frame-visible-p frame-1)
     125           0 :                        (not (frame-parent frame-1))
     126           0 :                        (not (frame-parameter frame-1 'delete-before)))
     127           0 :               (throw 'other-frame t))))
     128           0 :         (delete-frame frame t)
     129             :       ;; Gildea@x.org says it is ok to ask questions before terminating.
     130           0 :       (save-buffers-kill-emacs))))
     131             : 
     132             : (defun handle-focus-in (_event)
     133             :   "Handle a focus-in event.
     134             : Focus-in events are usually bound to this function.
     135             : Focus-in events occur when a frame has focus, but a switch-frame event
     136             : is not generated.
     137             : This function runs the hook `focus-in-hook'."
     138             :   (interactive "e")
     139           0 :   (run-hooks 'focus-in-hook))
     140             : 
     141             : (defun handle-focus-out (_event)
     142             :   "Handle a focus-out event.
     143             : Focus-out events are usually bound to this function.
     144             : Focus-out events occur when no frame has focus.
     145             : This function runs the hook `focus-out-hook'."
     146             :   (interactive "e")
     147           0 :   (run-hooks 'focus-out-hook))
     148             : 
     149             : (defun handle-move-frame (event)
     150             :   "Handle a move-frame event.
     151             : This function runs the abnormal hook `move-frame-functions'."
     152             :   (interactive "e")
     153           0 :   (let ((frame (posn-window (event-start event))))
     154           0 :     (run-hook-with-args 'move-frame-functions frame)))
     155             : 
     156             : ;;;; Arrangement of frames at startup
     157             : 
     158             : ;; 1) Load the window system startup file from the lisp library and read the
     159             : ;; high-priority arguments (-q and the like).  The window system startup
     160             : ;; file should create any frames specified in the window system defaults.
     161             : ;;
     162             : ;; 2) If no frames have been opened, we open an initial text frame.
     163             : ;;
     164             : ;; 3) Once the init file is done, we apply any newly set parameters
     165             : ;; in initial-frame-alist to the frame.
     166             : 
     167             : ;; If we create the initial frame, this is it.
     168             : (defvar frame-initial-frame nil)
     169             : 
     170             : ;; Record the parameters used in frame-initialize to make the initial frame.
     171             : (defvar frame-initial-frame-alist)
     172             : 
     173             : (defvar frame-initial-geometry-arguments nil)
     174             : 
     175             : ;; startup.el calls this function before loading the user's init
     176             : ;; file - if there is no frame with a minibuffer open now, create
     177             : ;; one to display messages while loading the init file.
     178             : (defun frame-initialize ()
     179             :   "Create an initial frame if necessary."
     180             :   ;; Are we actually running under a window system at all?
     181           0 :   (if (and initial-window-system
     182           0 :            (not noninteractive)
     183           0 :            (not (eq initial-window-system 'pc)))
     184           0 :       (progn
     185             :         ;; If there is no frame with a minibuffer besides the terminal
     186             :         ;; frame, then we need to create the opening frame.  Make sure
     187             :         ;; it has a minibuffer, but let initial-frame-alist omit the
     188             :         ;; minibuffer spec.
     189           0 :         (or (delq terminal-frame (minibuffer-frame-list))
     190           0 :             (progn
     191           0 :               (setq frame-initial-frame-alist
     192           0 :                     (append initial-frame-alist default-frame-alist nil))
     193           0 :               (setq frame-initial-frame-alist
     194           0 :                     (cons (cons 'window-system initial-window-system)
     195           0 :                           frame-initial-frame-alist))
     196           0 :               (setq default-minibuffer-frame
     197           0 :                     (setq frame-initial-frame
     198           0 :                           (make-frame frame-initial-frame-alist)))
     199             :               ;; Delete any specifications for window geometry parameters
     200             :               ;; so that we won't reapply them in frame-notice-user-settings.
     201             :               ;; It would be wrong to reapply them then,
     202             :               ;; because that would override explicit user resizing.
     203           0 :               (setq initial-frame-alist
     204           0 :                     (frame-remove-geometry-params initial-frame-alist))))
     205             :         ;; Copy the environment of the Emacs process into the new frame.
     206           0 :         (set-frame-parameter frame-initial-frame 'environment
     207           0 :                              (frame-parameter terminal-frame 'environment))
     208             :         ;; At this point, we know that we have a frame open, so we
     209             :         ;; can delete the terminal frame.
     210           0 :         (delete-frame terminal-frame)
     211           0 :         (setq terminal-frame nil))))
     212             : 
     213             : (defvar frame-notice-user-settings t
     214             :   "Non-nil means function `frame-notice-user-settings' wasn't run yet.")
     215             : 
     216             : (declare-function tool-bar-mode "tool-bar" (&optional arg))
     217             : (declare-function tool-bar-height "xdisp.c" (&optional frame pixelwise))
     218             : 
     219             : (defalias 'tool-bar-lines-needed 'tool-bar-height)
     220             : 
     221             : ;; startup.el calls this function after loading the user's init
     222             : ;; file.  Now default-frame-alist and initial-frame-alist contain
     223             : ;; information to which we must react; do what needs to be done.
     224             : (defun frame-notice-user-settings ()
     225             :   "Act on user's init file settings of frame parameters.
     226             : React to settings of `initial-frame-alist',
     227             : `window-system-default-frame-alist' and `default-frame-alist'
     228             : there (in decreasing order of priority)."
     229             :   ;; Creating and deleting frames may shift the selected frame around,
     230             :   ;; and thus the current buffer.  Protect against that.  We don't
     231             :   ;; want to use save-excursion here, because that may also try to set
     232             :   ;; the buffer of the selected window, which fails when the selected
     233             :   ;; window is the minibuffer.
     234           0 :   (let ((old-buffer (current-buffer))
     235             :         (window-system-frame-alist
     236           0 :          (cdr (assq initial-window-system
     237           0 :                     window-system-default-frame-alist))))
     238             : 
     239           0 :     (when (and frame-notice-user-settings
     240           0 :                (null frame-initial-frame))
     241             :       ;; This case happens when we don't have a window system, and
     242             :       ;; also for MS-DOS frames.
     243           0 :       (let ((parms (frame-parameters)))
     244             :         ;; Don't change the frame names.
     245           0 :         (setq parms (delq (assq 'name parms) parms))
     246             :         ;; Can't modify the minibuffer parameter, so don't try.
     247           0 :         (setq parms (delq (assq 'minibuffer parms) parms))
     248           0 :         (modify-frame-parameters
     249             :          nil
     250           0 :          (if initial-window-system
     251           0 :              parms
     252             :            ;; initial-frame-alist and default-frame-alist were already
     253             :            ;; applied in pc-win.el.
     254           0 :            (append initial-frame-alist window-system-frame-alist
     255           0 :                    default-frame-alist parms nil)))
     256           0 :         (if (null initial-window-system) ;; MS-DOS does this differently in pc-win.el
     257           0 :             (let ((newparms (frame-parameters))
     258           0 :                   (frame (selected-frame)))
     259           0 :               (tty-handle-reverse-video frame newparms)
     260             :               ;; tty-handle-reverse-video might change the frame's
     261             :               ;; color parameters, and we need to use the updated
     262             :               ;; value below.
     263           0 :               (setq newparms (frame-parameters))
     264             :               ;; If we changed the background color, we need to update
     265             :               ;; the background-mode parameter, and maybe some faces,
     266             :               ;; too.
     267           0 :               (when (assq 'background-color newparms)
     268           0 :                 (unless (or (assq 'background-mode initial-frame-alist)
     269           0 :                             (assq 'background-mode default-frame-alist))
     270           0 :                   (frame-set-background-mode frame))
     271           0 :                 (face-set-after-frame-default frame newparms))))))
     272             : 
     273             :     ;; If the initial frame is still around, apply initial-frame-alist
     274             :     ;; and default-frame-alist to it.
     275           0 :     (when (frame-live-p frame-initial-frame)
     276             :       ;; When tool-bar has been switched off, correct the frame size
     277             :       ;; by the lines added in x-create-frame for the tool-bar and
     278             :       ;; switch `tool-bar-mode' off.
     279           0 :       (when (display-graphic-p)
     280           0 :         (let* ((init-lines
     281           0 :                 (assq 'tool-bar-lines initial-frame-alist))
     282             :                (other-lines
     283           0 :                 (or (assq 'tool-bar-lines window-system-frame-alist)
     284           0 :                     (assq 'tool-bar-lines default-frame-alist)))
     285           0 :                (lines (or init-lines other-lines))
     286           0 :                (height (tool-bar-height frame-initial-frame t)))
     287             :           ;; Adjust frame top if either zero (nil) tool bar lines have
     288             :           ;; been requested in the most relevant of the frame's alists
     289             :           ;; or tool bar mode has been explicitly turned off in the
     290             :           ;; user's init file.
     291           0 :           (when (and (> height 0)
     292           0 :                      (or (and lines
     293           0 :                               (or (null (cdr lines))
     294           0 :                                   (eq 0 (cdr lines))))
     295           0 :                          (not tool-bar-mode)))
     296           0 :             (let* ((initial-top
     297           0 :                     (cdr (assq 'top frame-initial-geometry-arguments)))
     298           0 :                    (top (frame-parameter frame-initial-frame 'top)))
     299           0 :               (when (and (consp initial-top) (eq '- (car initial-top)))
     300           0 :                 (let ((adjusted-top
     301           0 :                        (cond
     302           0 :                         ((and (consp top) (eq '+ (car top)))
     303           0 :                          (list '+ (+ (cadr top) height)))
     304           0 :                         ((and (consp top) (eq '- (car top)))
     305           0 :                          (list '- (- (cadr top) height)))
     306           0 :                         (t (+ top height)))))
     307           0 :                   (modify-frame-parameters
     308           0 :                    frame-initial-frame `((top . ,adjusted-top))))))
     309             :             ;; Reset `tool-bar-mode' when zero tool bar lines have been
     310             :             ;; requested for the window-system or default frame alists.
     311           0 :             (when (and tool-bar-mode
     312           0 :                        (and other-lines
     313           0 :                             (or (null (cdr other-lines))
     314           0 :                                 (eq 0 (cdr other-lines)))))
     315           0 :               (tool-bar-mode -1)))))
     316             : 
     317             :       ;; The initial frame we create above always has a minibuffer.
     318             :       ;; If the user wants to remove it, or make it a minibuffer-only
     319             :       ;; frame, then we'll have to delete the current frame and make a
     320             :       ;; new one; you can't remove or add a root window to/from an
     321             :       ;; existing frame.
     322             :       ;;
     323             :       ;; NOTE: default-frame-alist was nil when we created the
     324             :       ;; existing frame.  We need to explicitly include
     325             :       ;; default-frame-alist in the parameters of the screen we
     326             :       ;; create here, so that its new value, gleaned from the user's
     327             :       ;; init file, will be applied to the existing screen.
     328           0 :       (if (not (eq (cdr (or (assq 'minibuffer initial-frame-alist)
     329           0 :                             (assq 'minibuffer window-system-frame-alist)
     330           0 :                             (assq 'minibuffer default-frame-alist)
     331           0 :                             '(minibuffer . t)))
     332           0 :                    t))
     333             :           ;; Create the new frame.
     334           0 :           (let (parms new)
     335             :             ;; MS-Windows needs this to avoid inflooping below.
     336           0 :             (if (eq system-type 'windows-nt)
     337           0 :                 (sit-for 0 t))
     338             :             ;; If the frame isn't visible yet, wait till it is.
     339             :             ;; If the user has to position the window,
     340             :             ;; Emacs doesn't know its real position until
     341             :             ;; the frame is seen to be visible.
     342           0 :             (while (not (cdr (assq 'visibility
     343           0 :                                    (frame-parameters frame-initial-frame))))
     344           0 :               (sleep-for 1))
     345           0 :             (setq parms (frame-parameters frame-initial-frame))
     346             : 
     347             :             ;; Get rid of `name' unless it was specified explicitly before.
     348           0 :             (or (assq 'name frame-initial-frame-alist)
     349           0 :                 (setq parms (delq (assq 'name parms) parms)))
     350             :             ;; An explicit parent-id is a request to XEmbed the frame.
     351           0 :             (or (assq 'parent-id frame-initial-frame-alist)
     352           0 :                 (setq parms (delq (assq 'parent-id parms) parms)))
     353             : 
     354           0 :             (setq parms (append initial-frame-alist
     355           0 :                                 window-system-frame-alist
     356           0 :                                 default-frame-alist
     357           0 :                                 parms
     358           0 :                                 nil))
     359             : 
     360             :             ;; Get rid of `reverse', because that was handled
     361             :             ;; when we first made the frame.
     362           0 :             (setq parms (cons '(reverse) (delq (assq 'reverse parms) parms)))
     363             : 
     364           0 :             (if (assq 'height frame-initial-geometry-arguments)
     365           0 :                 (setq parms (assq-delete-all 'height parms)))
     366           0 :             (if (assq 'width frame-initial-geometry-arguments)
     367           0 :                 (setq parms (assq-delete-all 'width parms)))
     368           0 :             (if (assq 'left frame-initial-geometry-arguments)
     369           0 :                 (setq parms (assq-delete-all 'left parms)))
     370           0 :             (if (assq 'top frame-initial-geometry-arguments)
     371           0 :                 (setq parms (assq-delete-all 'top parms)))
     372           0 :             (setq new
     373           0 :                   (make-frame
     374             :                    ;; Use the geometry args that created the existing
     375             :                    ;; frame, rather than the parms we get for it.
     376           0 :                    (append frame-initial-geometry-arguments
     377             :                            '((user-size . t) (user-position . t))
     378           0 :                            parms)))
     379             :             ;; The initial frame, which we are about to delete, may be
     380             :             ;; the only frame with a minibuffer.  If it is, create a
     381             :             ;; new one.
     382           0 :             (or (delq frame-initial-frame (minibuffer-frame-list))
     383           0 :                 (make-initial-minibuffer-frame nil))
     384             : 
     385             :             ;; If the initial frame is serving as a surrogate
     386             :             ;; minibuffer frame for any frames, we need to wean them
     387             :             ;; onto a new frame.  The default-minibuffer-frame
     388             :             ;; variable must be handled similarly.
     389           0 :             (let ((users-of-initial
     390           0 :                    (filtered-frame-list
     391             :                     (lambda (frame)
     392           0 :                       (and (not (eq frame frame-initial-frame))
     393           0 :                            (eq (window-frame
     394           0 :                                 (minibuffer-window frame))
     395           0 :                                frame-initial-frame))))))
     396           0 :               (if (or users-of-initial
     397           0 :                       (eq default-minibuffer-frame frame-initial-frame))
     398             : 
     399             :                   ;; Choose an appropriate frame.  Prefer frames which
     400             :                   ;; are only minibuffers.
     401           0 :                   (let* ((new-surrogate
     402           0 :                           (car
     403           0 :                            (or (filtered-frame-list
     404             :                                 (lambda (frame)
     405           0 :                                   (eq (cdr (assq 'minibuffer
     406           0 :                                                  (frame-parameters frame)))
     407           0 :                                       'only)))
     408           0 :                                (minibuffer-frame-list))))
     409           0 :                          (new-minibuffer (minibuffer-window new-surrogate)))
     410             : 
     411           0 :                     (if (eq default-minibuffer-frame frame-initial-frame)
     412           0 :                         (setq default-minibuffer-frame new-surrogate))
     413             : 
     414             :                     ;; Wean the frames using frame-initial-frame as
     415             :                     ;; their minibuffer frame.
     416           0 :                     (dolist (frame users-of-initial)
     417           0 :                       (modify-frame-parameters
     418           0 :                        frame (list (cons 'minibuffer new-minibuffer)))))))
     419             : 
     420             :             ;; Redirect events enqueued at this frame to the new frame.
     421             :             ;; Is this a good idea?
     422           0 :             (redirect-frame-focus frame-initial-frame new)
     423             : 
     424             :             ;; Finally, get rid of the old frame.
     425           0 :             (delete-frame frame-initial-frame t))
     426             : 
     427             :         ;; Otherwise, we don't need all that rigmarole; just apply
     428             :         ;; the new parameters.
     429           0 :         (let (newparms allparms tail)
     430           0 :           (setq allparms (append initial-frame-alist
     431           0 :                                  window-system-frame-alist
     432           0 :                                  default-frame-alist nil))
     433           0 :           (if (assq 'height frame-initial-geometry-arguments)
     434           0 :               (setq allparms (assq-delete-all 'height allparms)))
     435           0 :           (if (assq 'width frame-initial-geometry-arguments)
     436           0 :               (setq allparms (assq-delete-all 'width allparms)))
     437           0 :           (if (assq 'left frame-initial-geometry-arguments)
     438           0 :               (setq allparms (assq-delete-all 'left allparms)))
     439           0 :           (if (assq 'top frame-initial-geometry-arguments)
     440           0 :               (setq allparms (assq-delete-all 'top allparms)))
     441           0 :           (setq tail allparms)
     442             :           ;; Find just the parms that have changed since we first
     443             :           ;; made this frame.  Those are the ones actually set by
     444             :           ;; the init file.  For those parms whose values we already knew
     445             :           ;; (such as those spec'd by command line options)
     446             :           ;; it is undesirable to specify the parm again
     447             :           ;; once the user has seen the frame and been able to alter it
     448             :           ;; manually.
     449           0 :           (let (newval oldval)
     450           0 :             (dolist (entry tail)
     451           0 :               (setq oldval (assq (car entry) frame-initial-frame-alist))
     452           0 :               (setq newval (cdr (assq (car entry) allparms)))
     453           0 :               (or (and oldval (eq (cdr oldval) newval))
     454           0 :                   (setq newparms
     455           0 :                         (cons (cons (car entry) newval) newparms)))))
     456           0 :           (setq newparms (nreverse newparms))
     457             : 
     458           0 :           (let ((new-bg (assq 'background-color newparms)))
     459             :             ;; If the `background-color' parameter is changed, apply
     460             :             ;; it first, then make sure that the `background-mode'
     461             :             ;; parameter and other faces are updated, before applying
     462             :             ;; the other parameters.
     463           0 :             (when new-bg
     464           0 :               (modify-frame-parameters frame-initial-frame
     465           0 :                                        (list new-bg))
     466           0 :               (unless (assq 'background-mode newparms)
     467           0 :                 (frame-set-background-mode frame-initial-frame))
     468           0 :               (face-set-after-frame-default frame-initial-frame)
     469           0 :               (setq newparms (delq new-bg newparms)))
     470             : 
     471           0 :             (when (numberp (car frame-size-history))
     472           0 :               (setq frame-size-history
     473           0 :                     (cons (1- (car frame-size-history))
     474           0 :                           (cons
     475           0 :                            (list frame-initial-frame
     476             :                                  "FRAME-NOTICE-USER"
     477           0 :                                  nil newparms)
     478           0 :                            (cdr frame-size-history)))))
     479             : 
     480           0 :             (modify-frame-parameters frame-initial-frame newparms)))))
     481             : 
     482             :     ;; Restore the original buffer.
     483           0 :     (set-buffer old-buffer)
     484             : 
     485             :     ;; Make sure the initial frame can be GC'd if it is ever deleted.
     486             :     ;; Make sure frame-notice-user-settings does nothing if called twice.
     487           0 :     (setq frame-notice-user-settings nil)
     488           0 :     (setq frame-initial-frame nil)))
     489             : 
     490             : (defun make-initial-minibuffer-frame (display)
     491           0 :   (let ((parms (append minibuffer-frame-alist '((minibuffer . only)))))
     492           0 :     (if display
     493           0 :         (make-frame-on-display display parms)
     494           0 :       (make-frame parms))))
     495             : 
     496             : ;;;; Creation of additional frames, and other frame miscellanea
     497             : 
     498             : (defun modify-all-frames-parameters (alist)
     499             :   "Modify all current and future frames' parameters according to ALIST.
     500             : This changes `default-frame-alist' and possibly `initial-frame-alist'.
     501             : Furthermore, this function removes all parameters in ALIST from
     502             : `window-system-default-frame-alist'.
     503             : See help of `modify-frame-parameters' for more information."
     504           1 :   (dolist (frame (frame-list))
     505           1 :     (modify-frame-parameters frame alist))
     506             : 
     507           1 :   (dolist (pair alist) ;; conses to add/replace
     508             :     ;; initial-frame-alist needs setting only when
     509             :     ;; frame-notice-user-settings is true.
     510           2 :     (and frame-notice-user-settings
     511           2 :          (setq initial-frame-alist
     512           2 :                (assq-delete-all (car pair) initial-frame-alist)))
     513           2 :     (setq default-frame-alist
     514           2 :           (assq-delete-all (car pair) default-frame-alist))
     515             :     ;; Remove any similar settings from the window-system specific
     516             :     ;; parameters---they would override default-frame-alist.
     517           2 :     (dolist (w window-system-default-frame-alist)
     518           2 :       (setcdr w (assq-delete-all (car pair) (cdr w)))))
     519             : 
     520           1 :   (and frame-notice-user-settings
     521           1 :        (setq initial-frame-alist (append initial-frame-alist alist)))
     522           1 :   (setq default-frame-alist (append default-frame-alist alist)))
     523             : 
     524             : (defun get-other-frame ()
     525             :   "Return some frame other than the current frame.
     526             : Create one if necessary.  Note that the minibuffer frame, if separate,
     527             : is not considered (see `next-frame')."
     528           0 :   (if (equal (next-frame) (selected-frame)) (make-frame) (next-frame)))
     529             : 
     530             : (defun next-multiframe-window ()
     531             :   "Select the next window, regardless of which frame it is on."
     532             :   (interactive)
     533           0 :   (select-window (next-window (selected-window)
     534           0 :                               (> (minibuffer-depth) 0)
     535           0 :                               0))
     536           0 :   (select-frame-set-input-focus (selected-frame)))
     537             : 
     538             : (defun previous-multiframe-window ()
     539             :   "Select the previous window, regardless of which frame it is on."
     540             :   (interactive)
     541           0 :   (select-window (previous-window (selected-window)
     542           0 :                                   (> (minibuffer-depth) 0)
     543           0 :                                   0))
     544           0 :   (select-frame-set-input-focus (selected-frame)))
     545             : 
     546             : (defun window-system-for-display (display)
     547             :   "Return the window system for DISPLAY.
     548             : Return nil if we don't know how to interpret DISPLAY."
     549             :   ;; MS-Windows doesn't know how to create a GUI frame in a -nw session.
     550           0 :   (if (and (eq system-type 'windows-nt)
     551           0 :            (null (window-system))
     552           0 :            (not (daemonp)))
     553             :       nil
     554           0 :     (cl-loop for descriptor in display-format-alist
     555           0 :              for pattern = (car descriptor)
     556           0 :              for system = (cdr descriptor)
     557           0 :              when (string-match-p pattern display) return system)))
     558             : 
     559             : (defun make-frame-on-display (display &optional parameters)
     560             :   "Make a frame on display DISPLAY.
     561             : The optional argument PARAMETERS specifies additional frame parameters."
     562             :   (interactive "sMake frame on display: ")
     563           0 :   (make-frame (cons (cons 'display display) parameters)))
     564             : 
     565             : (declare-function x-close-connection "xfns.c" (terminal))
     566             : 
     567             : (defun close-display-connection (display)
     568             :   "Close the connection to a display, deleting all its associated frames.
     569             : For DISPLAY, specify either a frame or a display name (a string).
     570             : If DISPLAY is nil, that stands for the selected frame's display."
     571             :   (interactive
     572           0 :    (list
     573           0 :     (let* ((default (frame-parameter nil 'display))
     574           0 :            (display (completing-read
     575           0 :                      (format "Close display (default %s): " default)
     576           0 :                      (delete-dups
     577           0 :                       (mapcar (lambda (frame)
     578           0 :                                 (frame-parameter frame 'display))
     579           0 :                               (frame-list)))
     580             :                      nil t nil nil
     581           0 :                      default)))
     582           0 :       (if (zerop (length display)) default display))))
     583           0 :   (let ((frames (delq nil
     584           0 :                       (mapcar (lambda (frame)
     585           0 :                                 (if (equal display
     586           0 :                                            (frame-parameter frame 'display))
     587           0 :                                     frame))
     588           0 :                               (frame-list)))))
     589           0 :     (if (and (consp frames)
     590           0 :              (not (y-or-n-p (if (cdr frames)
     591           0 :                                 (format "Delete %s frames? " (length frames))
     592           0 :                               (format "Delete %s ? " (car frames))))))
     593           0 :         (error "Abort!")
     594           0 :       (mapc 'delete-frame frames)
     595           0 :       (x-close-connection display))))
     596             : 
     597             : (defun make-frame-command ()
     598             :   "Make a new frame, on the same terminal as the selected frame.
     599             : If the terminal is a text-only terminal, this also selects the
     600             : new frame."
     601             :   (interactive)
     602           0 :   (if (display-graphic-p)
     603           0 :       (make-frame)
     604           0 :     (select-frame (make-frame))))
     605             : 
     606             : (defvar before-make-frame-hook nil
     607             :   "Functions to run before a frame is created.")
     608             : 
     609             : (defvar after-make-frame-functions nil
     610             :   "Functions to run after a frame is created.
     611             : The functions are run with one arg, the newly created frame.")
     612             : 
     613             : (defvar after-setting-font-hook nil
     614             :   "Functions to run after a frame's font has been changed.")
     615             : 
     616             : ;; Alias, kept temporarily.
     617             : (define-obsolete-function-alias 'new-frame 'make-frame "22.1")
     618             : 
     619             : (defvar frame-inherited-parameters '()
     620             :   "Parameters `make-frame' copies from the `selected-frame' to the new frame.")
     621             : 
     622             : (defvar x-display-name)
     623             : 
     624             : (defun make-frame (&optional parameters)
     625             :   "Return a newly created frame displaying the current buffer.
     626             : Optional argument PARAMETERS is an alist of frame parameters for
     627             : the new frame.  Each element of PARAMETERS should have the
     628             : form (NAME . VALUE), for example:
     629             : 
     630             :  (name . STRING)        The frame should be named STRING.
     631             : 
     632             :  (width . NUMBER)       The frame should be NUMBER characters in width.
     633             :  (height . NUMBER)      The frame should be NUMBER text lines high.
     634             : 
     635             : You cannot specify either `width' or `height', you must specify
     636             : neither or both.
     637             : 
     638             :  (minibuffer . t)       The frame should have a minibuffer.
     639             :  (minibuffer . nil)     The frame should have no minibuffer.
     640             :  (minibuffer . only)    The frame should contain only a minibuffer.
     641             :  (minibuffer . WINDOW)  The frame should use WINDOW as its minibuffer window.
     642             : 
     643             :  (window-system . nil)  The frame should be displayed on a terminal device.
     644             :  (window-system . x)    The frame should be displayed in an X window.
     645             : 
     646             :  (display . \":0\")     The frame should appear on display :0.
     647             : 
     648             :  (terminal . TERMINAL)  The frame should use the terminal object TERMINAL.
     649             : 
     650             : In addition, any parameter specified in `default-frame-alist',
     651             : but not present in PARAMETERS, is applied.
     652             : 
     653             : Before creating the frame (via `frame-creation-function-alist'),
     654             : this function runs the hook `before-make-frame-hook'.  After
     655             : creating the frame, it runs the hook `after-make-frame-functions'
     656             : with one arg, the newly created frame.
     657             : 
     658             : If a display parameter is supplied and a window-system is not,
     659             : guess the window-system from the display.
     660             : 
     661             : On graphical displays, this function does not itself make the new
     662             : frame the selected frame.  However, the window system may select
     663             : the new frame according to its own rules."
     664             :   (interactive)
     665           0 :   (let* ((display (cdr (assq 'display parameters)))
     666           0 :          (w (cond
     667           0 :              ((assq 'terminal parameters)
     668           0 :               (let ((type (terminal-live-p
     669           0 :                            (cdr (assq 'terminal parameters)))))
     670           0 :                 (cond
     671           0 :                  ((eq t type) nil)
     672           0 :                  ((null type) (error "Terminal %s does not exist"
     673           0 :                                      (cdr (assq 'terminal parameters))))
     674           0 :                  (t type))))
     675           0 :              ((assq 'window-system parameters)
     676           0 :               (cdr (assq 'window-system parameters)))
     677           0 :              (display
     678           0 :               (or (window-system-for-display display)
     679           0 :                   (error "Don't know how to interpret display %S"
     680           0 :                          display)))
     681           0 :              (t window-system)))
     682           0 :          (oldframe (selected-frame))
     683           0 :          (params parameters)
     684             :          frame)
     685             : 
     686           0 :     (unless (get w 'window-system-initialized)
     687           0 :       (let ((window-system w))          ;Hack attack!
     688           0 :         (window-system-initialization display))
     689           0 :       (setq x-display-name display)
     690           0 :       (put w 'window-system-initialized t))
     691             : 
     692             :     ;; Add parameters from `window-system-default-frame-alist'.
     693           0 :     (dolist (p (cdr (assq w window-system-default-frame-alist)))
     694           0 :       (unless (assq (car p) params)
     695           0 :         (push p params)))
     696             :     ;; Add parameters from `default-frame-alist'.
     697           0 :     (dolist (p default-frame-alist)
     698           0 :       (unless (assq (car p) params)
     699           0 :         (push p params)))
     700             :     ;; Now make the frame.
     701           0 :     (run-hooks 'before-make-frame-hook)
     702             : 
     703             : ;;     (setq frame-size-history '(1000))
     704             : 
     705           0 :     (setq frame (let ((window-system w)) ;Hack attack!
     706           0 :                   (frame-creation-function params)))
     707           0 :     (normal-erase-is-backspace-setup-frame frame)
     708             :     ;; Inherit the original frame's parameters.
     709           0 :     (dolist (param frame-inherited-parameters)
     710           0 :       (unless (assq param parameters)   ;Overridden by explicit parameters.
     711           0 :         (let ((val (frame-parameter oldframe param)))
     712           0 :           (when val (set-frame-parameter frame param val)))))
     713             : 
     714           0 :     (when (numberp (car frame-size-history))
     715           0 :       (setq frame-size-history
     716           0 :             (cons (1- (car frame-size-history))
     717           0 :                   (cons (list frame "MAKE-FRAME")
     718           0 :                         (cdr frame-size-history)))))
     719             : 
     720             :     ;; We can run `window-configuration-change-hook' for this frame now.
     721           0 :     (frame-after-make-frame frame t)
     722           0 :     (run-hook-with-args 'after-make-frame-functions frame)
     723           0 :     frame))
     724             : 
     725             : (defun filtered-frame-list (predicate)
     726             :   "Return a list of all live frames which satisfy PREDICATE."
     727          33 :   (let* ((frames (frame-list))
     728          33 :          (list frames))
     729          66 :     (while (consp frames)
     730          33 :       (unless (funcall predicate (car frames))
     731          33 :         (setcar frames nil))
     732          33 :       (setq frames (cdr frames)))
     733          33 :     (delq nil list)))
     734             : 
     735             : (defun minibuffer-frame-list ()
     736             :   "Return a list of all frames with their own minibuffers."
     737           0 :   (filtered-frame-list
     738             :    (lambda (frame)
     739           0 :      (eq frame (window-frame (minibuffer-window frame))))))
     740             : 
     741             : ;; Used to be called `terminal-id' in termdev.el.
     742             : (defun get-device-terminal (device)
     743             :   "Return the terminal corresponding to DEVICE.
     744             : DEVICE can be a terminal, a frame, nil (meaning the selected frame's terminal),
     745             : the name of an X display device (HOST.SERVER.SCREEN) or a tty device file."
     746          33 :   (cond
     747          33 :    ((or (null device) (framep device))
     748           0 :     (frame-terminal device))
     749          33 :    ((stringp device)
     750           0 :     (let ((f (car (filtered-frame-list
     751             :                    (lambda (frame)
     752           0 :                      (or (equal (frame-parameter frame 'display) device)
     753           0 :                          (equal (frame-parameter frame 'tty) device)))))))
     754           0 :       (or f (error "Display %s does not exist" device))
     755           0 :       (frame-terminal f)))
     756          33 :    ((terminal-live-p device) device)
     757             :    (t
     758          33 :     (error "Invalid argument %s in `get-device-terminal'" device))))
     759             : 
     760             : (defun frames-on-display-list (&optional device)
     761             :   "Return a list of all frames on DEVICE.
     762             : 
     763             : DEVICE should be a terminal, a frame,
     764             : or a name of an X display or tty (a string of the form
     765             : HOST:SERVER.SCREEN).
     766             : 
     767             : If DEVICE is omitted or nil, it defaults to the selected
     768             : frame's terminal device."
     769          33 :   (let* ((terminal (get-device-terminal device))
     770          33 :          (func #'(lambda (frame)
     771          66 :                    (eq (frame-terminal frame) terminal))))
     772          33 :     (filtered-frame-list func)))
     773             : 
     774             : (defun framep-on-display (&optional terminal)
     775             :   "Return the type of frames on TERMINAL.
     776             : TERMINAL may be a terminal id, a display name or a frame.  If it
     777             : is a frame, its type is returned.  If TERMINAL is omitted or nil,
     778             : it defaults to the selected frame's terminal device.  All frames
     779             : on a given display are of the same type."
     780           1 :   (or (terminal-live-p terminal)
     781           0 :       (framep terminal)
     782           1 :       (framep (car (frames-on-display-list terminal)))))
     783             : 
     784             : (defun frame-remove-geometry-params (param-list)
     785             :   "Return the parameter list PARAM-LIST, but with geometry specs removed.
     786             : This deletes all bindings in PARAM-LIST for `top', `left', `width',
     787             : `height', `user-size' and `user-position' parameters.
     788             : Emacs uses this to avoid overriding explicit moves and resizings from
     789             : the user during startup."
     790           0 :   (setq param-list (cons nil param-list))
     791           0 :   (let ((tail param-list))
     792           0 :     (while (consp (cdr tail))
     793           0 :       (if (and (consp (car (cdr tail)))
     794           0 :                (memq (car (car (cdr tail)))
     795           0 :                      '(height width top left user-position user-size)))
     796           0 :           (progn
     797           0 :             (setq frame-initial-geometry-arguments
     798           0 :                   (cons (car (cdr tail)) frame-initial-geometry-arguments))
     799           0 :             (setcdr tail (cdr (cdr tail))))
     800           0 :         (setq tail (cdr tail)))))
     801           0 :   (setq frame-initial-geometry-arguments
     802           0 :         (nreverse frame-initial-geometry-arguments))
     803           0 :   (cdr param-list))
     804             : 
     805             : (declare-function x-focus-frame "frame.c" (frame))
     806             : 
     807             : (defun select-frame-set-input-focus (frame &optional norecord)
     808             :   "Select FRAME, raise it, and set input focus, if possible.
     809             : If `mouse-autoselect-window' is non-nil, also move mouse pointer
     810             : to FRAME's selected window.  Otherwise, if `focus-follows-mouse'
     811             : is non-nil, move mouse cursor to FRAME.
     812             : 
     813             : Optional argument NORECORD means to neither change the order of
     814             : recently selected windows nor the buffer list."
     815           0 :   (select-frame frame norecord)
     816           0 :   (raise-frame frame)
     817             :   ;; Ensure, if possible, that FRAME gets input focus.
     818           0 :   (when (memq (window-system frame) '(x w32 ns))
     819           0 :     (x-focus-frame frame))
     820             :   ;; Move mouse cursor if necessary.
     821           0 :   (cond
     822           0 :    (mouse-autoselect-window
     823           0 :     (let ((edges (window-inside-edges (frame-selected-window frame))))
     824             :       ;; Move mouse cursor into FRAME's selected window to avoid that
     825             :       ;; Emacs mouse-autoselects another window.
     826           0 :       (set-mouse-position frame (nth 2 edges) (nth 1 edges))))
     827           0 :    (focus-follows-mouse
     828             :     ;; Move mouse cursor into FRAME to avoid that another frame gets
     829             :     ;; selected by the window manager.
     830           0 :     (set-mouse-position frame (1- (frame-width frame)) 0))))
     831             : 
     832             : (defun other-frame (arg)
     833             :   "Select the ARGth different visible frame on current display, and raise it.
     834             : All frames are arranged in a cyclic order.
     835             : This command selects the frame ARG steps away in that order.
     836             : A negative ARG moves in the opposite order.
     837             : 
     838             : To make this command work properly, you must tell Emacs how the
     839             : system (or the window manager) generally handles focus-switching
     840             : between windows.  If moving the mouse onto a window selects
     841             : it (gives it focus), set `focus-follows-mouse' to t.  Otherwise,
     842             : that variable should be nil."
     843             :   (interactive "p")
     844           0 :   (let ((sframe (selected-frame))
     845           0 :         (frame (selected-frame)))
     846           0 :     (while (> arg 0)
     847           0 :       (setq frame (next-frame frame))
     848           0 :       (while (and (not (eq frame sframe))
     849           0 :                   (not (eq (frame-visible-p frame) t)))
     850           0 :         (setq frame (next-frame frame)))
     851           0 :       (setq arg (1- arg)))
     852           0 :     (while (< arg 0)
     853           0 :       (setq frame (previous-frame frame))
     854           0 :       (while (and (not (eq frame sframe))
     855           0 :                   (not (eq (frame-visible-p frame) t)))
     856           0 :         (setq frame (previous-frame frame)))
     857           0 :       (setq arg (1+ arg)))
     858           0 :     (select-frame-set-input-focus frame)))
     859             : 
     860             : (defun iconify-or-deiconify-frame ()
     861             :   "Iconify the selected frame, or deiconify if it's currently an icon."
     862             :   (interactive)
     863           0 :   (if (eq (cdr (assq 'visibility (frame-parameters))) t)
     864           0 :       (iconify-frame)
     865           0 :     (make-frame-visible)))
     866             : 
     867             : (defun suspend-frame ()
     868             :   "Do whatever is right to suspend the current frame.
     869             : Calls `suspend-emacs' if invoked from the controlling tty device,
     870             : `suspend-tty' from a secondary tty device, and
     871             : `iconify-or-deiconify-frame' from an X frame."
     872             :   (interactive)
     873           0 :   (let ((type (framep (selected-frame))))
     874           0 :     (cond
     875           0 :      ((memq type '(x ns w32)) (iconify-or-deiconify-frame))
     876           0 :      ((eq type t)
     877           0 :       (if (controlling-tty-p)
     878           0 :           (suspend-emacs)
     879           0 :         (suspend-tty)))
     880           0 :      (t (suspend-emacs)))))
     881             : 
     882             : (defun make-frame-names-alist ()
     883             :   ;; Only consider the frames on the same display.
     884           0 :   (let* ((current-frame (selected-frame))
     885             :          (falist
     886           0 :           (cons
     887           0 :            (cons (frame-parameter current-frame 'name) current-frame) nil))
     888           0 :          (frame (next-frame nil 0)))
     889           0 :     (while (not (eq frame current-frame))
     890           0 :       (progn
     891           0 :         (push (cons (frame-parameter frame 'name) frame) falist)
     892           0 :         (setq frame (next-frame frame 0))))
     893           0 :     falist))
     894             : 
     895             : (defvar frame-name-history nil)
     896             : (defun select-frame-by-name (name)
     897             :   "Select the frame on the current terminal whose name is NAME and raise it.
     898             : If there is no frame by that name, signal an error."
     899             :   (interactive
     900           0 :    (let* ((frame-names-alist (make-frame-names-alist))
     901           0 :            (default (car (car frame-names-alist)))
     902           0 :            (input (completing-read
     903           0 :                    (format "Select Frame (default %s): " default)
     904           0 :                    frame-names-alist nil t nil 'frame-name-history)))
     905           0 :      (if (= (length input) 0)
     906           0 :          (list default)
     907           0 :        (list input))))
     908           0 :   (let* ((frame-names-alist (make-frame-names-alist))
     909           0 :          (frame (cdr (assoc name frame-names-alist))))
     910           0 :     (if frame
     911           0 :         (select-frame-set-input-focus frame)
     912           0 :       (error "There is no frame named `%s'" name))))
     913             : 
     914             : 
     915             : ;;;; Background mode.
     916             : 
     917             : (defcustom frame-background-mode nil
     918             :   "The brightness of the background.
     919             : Set this to the symbol `dark' if your background color is dark,
     920             : `light' if your background is light, or nil (automatic by default)
     921             : if you want Emacs to examine the brightness for you.
     922             : 
     923             : If you change this without using customize, you should use
     924             : `frame-set-background-mode' to update existing frames;
     925             : e.g. (mapc \\='frame-set-background-mode (frame-list))."
     926             :   :group 'faces
     927             :   :set #'(lambda (var value)
     928             :            (set-default var value)
     929             :            (mapc 'frame-set-background-mode (frame-list)))
     930             :   :initialize 'custom-initialize-changed
     931             :   :type '(choice (const dark)
     932             :                  (const light)
     933             :                  (const :tag "automatic" nil)))
     934             : 
     935             : (declare-function x-get-resource "frame.c"
     936             :                   (attribute class &optional component subclass))
     937             : 
     938             : ;; Only used if window-system is not null.
     939             : (declare-function x-display-grayscale-p "xfns.c" (&optional terminal))
     940             : 
     941             : (defvar inhibit-frame-set-background-mode nil)
     942             : 
     943             : (defun frame-set-background-mode (frame &optional keep-face-specs)
     944             :   "Set up display-dependent faces on FRAME.
     945             : Display-dependent faces are those which have different definitions
     946             : according to the `background-mode' and `display-type' frame parameters.
     947             : 
     948             : If optional arg KEEP-FACE-SPECS is non-nil, don't recalculate
     949             : face specs for the new background mode."
     950           0 :   (unless inhibit-frame-set-background-mode
     951           0 :     (let* ((frame-default-bg-mode (frame-terminal-default-bg-mode frame))
     952           0 :            (bg-color (frame-parameter frame 'background-color))
     953           0 :            (tty-type (tty-type frame))
     954             :            (default-bg-mode
     955           0 :              (if (or (window-system frame)
     956           0 :                      (and tty-type
     957           0 :                           (string-match "^\\(xterm\\|\\rxvt\\|dtterm\\|eterm\\)"
     958           0 :                                         tty-type)))
     959             :                  'light
     960           0 :                'dark))
     961           0 :            (non-default-bg-mode (if (eq default-bg-mode 'light) 'dark 'light))
     962             :            (bg-mode
     963           0 :             (cond (frame-default-bg-mode)
     964           0 :                   ((equal bg-color "unspecified-fg") ; inverted colors
     965           0 :                    non-default-bg-mode)
     966           0 :                   ((not (color-values bg-color frame))
     967           0 :                    default-bg-mode)
     968           0 :                   ((>= (apply '+ (color-values bg-color frame))
     969             :                        ;; Just looking at the screen, colors whose
     970             :                        ;; values add up to .6 of the white total
     971             :                        ;; still look dark to me.
     972           0 :                        (* (apply '+ (color-values "white" frame)) .6))
     973             :                    'light)
     974           0 :                   (t 'dark)))
     975             :            (display-type
     976           0 :             (cond ((null (window-system frame))
     977           0 :                    (if (tty-display-color-p frame) 'color 'mono))
     978           0 :                   ((display-color-p frame)
     979             :                    'color)
     980           0 :                   ((x-display-grayscale-p frame)
     981             :                    'grayscale)
     982           0 :                   (t 'mono)))
     983             :            (old-bg-mode
     984           0 :             (frame-parameter frame 'background-mode))
     985             :            (old-display-type
     986           0 :             (frame-parameter frame 'display-type)))
     987             : 
     988           0 :       (unless (and (eq bg-mode old-bg-mode) (eq display-type old-display-type))
     989           0 :         (let ((locally-modified-faces nil)
     990             :               ;; Prevent face-spec-recalc from calling this function
     991             :               ;; again, resulting in a loop (bug#911).
     992             :               (inhibit-frame-set-background-mode t)
     993           0 :               (params (list (cons 'background-mode bg-mode)
     994           0 :                             (cons 'display-type display-type))))
     995           0 :           (if keep-face-specs
     996           0 :               (modify-frame-parameters frame params)
     997             :             ;; If we are recomputing face specs, first collect a list
     998             :             ;; of faces that don't match their face-specs.  These are
     999             :             ;; the faces modified on FRAME, and we avoid changing them
    1000             :             ;; below.  Use a negative list to avoid consing (we assume
    1001             :             ;; most faces are unmodified).
    1002           0 :             (dolist (face (face-list))
    1003           0 :               (and (not (get face 'face-override-spec))
    1004           0 :                    (not (face-spec-match-p face
    1005           0 :                                            (face-user-default-spec face)
    1006           0 :                                            (selected-frame)))
    1007           0 :                    (push face locally-modified-faces)))
    1008             :             ;; Now change to the new frame parameters
    1009           0 :             (modify-frame-parameters frame params)
    1010             :             ;; For all unmodified named faces, choose face specs
    1011             :             ;; matching the new frame parameters.
    1012           0 :             (dolist (face (face-list))
    1013           0 :               (unless (memq face locally-modified-faces)
    1014           0 :                 (face-spec-recalc face frame)))))))))
    1015             : 
    1016             : (defun frame-terminal-default-bg-mode (frame)
    1017             :   "Return the default background mode of FRAME.
    1018             : This checks the `frame-background-mode' variable, the X resource
    1019             : named \"backgroundMode\" (if FRAME is an X frame), and finally
    1020             : the `background-mode' terminal parameter."
    1021           0 :   (or frame-background-mode
    1022           0 :       (let ((bg-resource
    1023           0 :              (and (window-system frame)
    1024           0 :                   (x-get-resource "backgroundMode" "BackgroundMode"))))
    1025           0 :         (if bg-resource
    1026           0 :             (intern (downcase bg-resource))))
    1027           0 :       (terminal-parameter frame 'background-mode)))
    1028             : 
    1029             : 
    1030             : ;;;; Frame configurations
    1031             : 
    1032             : (defun current-frame-configuration ()
    1033             :   "Return a list describing the positions and states of all frames.
    1034             : Its car is `frame-configuration'.
    1035             : Each element of the cdr is a list of the form (FRAME ALIST WINDOW-CONFIG),
    1036             : where
    1037             :   FRAME is a frame object,
    1038             :   ALIST is an association list specifying some of FRAME's parameters, and
    1039             :   WINDOW-CONFIG is a window configuration object for FRAME."
    1040           0 :   (cons 'frame-configuration
    1041           0 :         (mapcar (lambda (frame)
    1042           0 :                   (list frame
    1043           0 :                         (frame-parameters frame)
    1044           0 :                         (current-window-configuration frame)))
    1045           0 :                 (frame-list))))
    1046             : 
    1047             : (defun set-frame-configuration (configuration &optional nodelete)
    1048             :   "Restore the frames to the state described by CONFIGURATION.
    1049             : Each frame listed in CONFIGURATION has its position, size, window
    1050             : configuration, and other parameters set as specified in CONFIGURATION.
    1051             : However, this function does not restore deleted frames.
    1052             : 
    1053             : Ordinarily, this function deletes all existing frames not
    1054             : listed in CONFIGURATION.  But if optional second argument NODELETE
    1055             : is given and non-nil, the unwanted frames are iconified instead."
    1056           0 :   (or (frame-configuration-p configuration)
    1057           0 :       (signal 'wrong-type-argument
    1058           0 :               (list 'frame-configuration-p configuration)))
    1059           0 :   (let ((config-alist (cdr configuration))
    1060             :         frames-to-delete)
    1061           0 :     (dolist (frame (frame-list))
    1062           0 :       (let ((parameters (assq frame config-alist)))
    1063           0 :         (if parameters
    1064           0 :             (progn
    1065           0 :               (modify-frame-parameters
    1066           0 :                frame
    1067             :                ;; Since we can't set a frame's minibuffer status,
    1068             :                ;; we might as well omit the parameter altogether.
    1069           0 :                (let* ((parms (nth 1 parameters))
    1070           0 :                       (mini (assq 'minibuffer parms))
    1071           0 :                       (name (assq 'name parms))
    1072           0 :                       (explicit-name (cdr (assq 'explicit-name parms))))
    1073           0 :                  (when mini (setq parms (delq mini parms)))
    1074             :                  ;; Leave name in iff it was set explicitly.
    1075             :                  ;; This should fix the behavior reported in
    1076             :                  ;; http://lists.gnu.org/archive/html/emacs-devel/2007-08/msg01632.html
    1077           0 :                  (when (and name (not explicit-name))
    1078           0 :                    (setq parms (delq name parms)))
    1079           0 :                  parms))
    1080           0 :               (set-window-configuration (nth 2 parameters)))
    1081           0 :           (setq frames-to-delete (cons frame frames-to-delete)))))
    1082           0 :     (mapc (if nodelete
    1083             :               ;; Note: making frames invisible here was tried
    1084             :               ;; but led to some strange behavior--each time the frame
    1085             :               ;; was made visible again, the window manager asked afresh
    1086             :               ;; for where to put it.
    1087             :               'iconify-frame
    1088           0 :             'delete-frame)
    1089           0 :           frames-to-delete)))
    1090             : 
    1091             : ;;;; Convenience functions for accessing and interactively changing
    1092             : ;;;; frame parameters.
    1093             : 
    1094             : (defun frame-height (&optional frame)
    1095             :   "Return number of lines available for display on FRAME.
    1096             : If FRAME is omitted, describe the currently selected frame.
    1097             : Exactly what is included in the return value depends on the
    1098             : window-system and toolkit in use - see `frame-pixel-height' for
    1099             : more details.  The lines are in units of the default font height.
    1100             : 
    1101             : The result is roughly related to the frame pixel height via
    1102             : height in pixels = height in lines * `frame-char-height'.
    1103             : However, this is only approximate, and is complicated e.g. by the
    1104             : fact that individual window lines and menu bar lines can have
    1105             : differing font heights."
    1106           2 :   (cdr (assq 'height (frame-parameters frame))))
    1107             : 
    1108             : (defun frame-width (&optional frame)
    1109             :   "Return number of columns available for display on FRAME.
    1110             : If FRAME is omitted, describe the currently selected frame."
    1111           0 :   (cdr (assq 'width (frame-parameters frame))))
    1112             : 
    1113             : (defalias 'frame-border-width 'frame-internal-border-width)
    1114             : (defalias 'frame-pixel-width 'frame-native-width)
    1115             : (defalias 'frame-pixel-height 'frame-native-height)
    1116             : 
    1117             : (defun frame-inner-width (&optional frame)
    1118             :   "Return inner width of FRAME in pixels.
    1119             : FRAME defaults to the selected frame."
    1120           0 :   (setq frame (window-normalize-frame frame))
    1121           0 :   (- (frame-native-width frame)
    1122           0 :      (* 2 (frame-internal-border-width frame))))
    1123             : 
    1124             : (defun frame-inner-height (&optional frame)
    1125             :   "Return inner height of FRAME in pixels.
    1126             : FRAME defaults to the selected frame."
    1127           0 :   (setq frame (window-normalize-frame frame))
    1128           0 :   (- (frame-native-height frame)
    1129           0 :      (* 2 (frame-internal-border-width frame))))
    1130             : 
    1131             : (defun frame-outer-width (&optional frame)
    1132             :   "Return outer width of FRAME in pixels.
    1133             : FRAME defaults to the selected frame."
    1134           0 :   (setq frame (window-normalize-frame frame))
    1135           0 :   (let ((edges (frame-edges frame 'outer-edges)))
    1136           0 :     (- (nth 2 edges) (nth 0 edges))))
    1137             : 
    1138             : (defun frame-outer-height (&optional frame)
    1139             :   "Return outer height of FRAME in pixels.
    1140             : FRAME defaults to the selected frame."
    1141           0 :   (setq frame (window-normalize-frame frame))
    1142           0 :   (let ((edges (frame-edges frame 'outer-edges)))
    1143           0 :     (- (nth 3 edges) (nth 1 edges))))
    1144             : 
    1145             : (declare-function x-list-fonts "xfaces.c"
    1146             :                   (pattern &optional face frame maximum width))
    1147             : 
    1148             : (define-obsolete-function-alias 'set-default-font 'set-frame-font "23.1")
    1149             : 
    1150             : (defun set-frame-font (font &optional keep-size frames)
    1151             :   "Set the default font to FONT.
    1152             : When called interactively, prompt for the name of a font, and use
    1153             : that font on the selected frame.  When called from Lisp, FONT
    1154             : should be a font name (a string), a font object, font entity, or
    1155             : font spec.
    1156             : 
    1157             : If KEEP-SIZE is nil, keep the number of frame lines and columns
    1158             : fixed.  If KEEP-SIZE is non-nil (or with a prefix argument), try
    1159             : to keep the current frame size fixed (in pixels) by adjusting the
    1160             : number of lines and columns.
    1161             : 
    1162             : If FRAMES is nil, apply the font to the selected frame only.
    1163             : If FRAMES is non-nil, it should be a list of frames to act upon,
    1164             : or t meaning all existing graphical frames.
    1165             : Also, if FRAMES is non-nil, alter the user's Customization settings
    1166             : as though the font-related attributes of the `default' face had been
    1167             : \"set in this session\", so that the font is applied to future frames."
    1168             :   (interactive
    1169           0 :    (let* ((completion-ignore-case t)
    1170           0 :           (font (completing-read "Font name: "
    1171             :                                  ;; x-list-fonts will fail with an error
    1172             :                                  ;; if this frame doesn't support fonts.
    1173           0 :                                  (x-list-fonts "*" nil (selected-frame))
    1174             :                                  nil nil nil nil
    1175           0 :                                  (frame-parameter nil 'font))))
    1176           0 :      (list font current-prefix-arg nil)))
    1177           0 :   (when (or (stringp font) (fontp font))
    1178           0 :     (let* ((this-frame (selected-frame))
    1179             :            ;; FRAMES nil means affect the selected frame.
    1180           0 :            (frame-list (cond ((null frames)
    1181           0 :                               (list this-frame))
    1182           0 :                              ((eq frames t)
    1183           0 :                               (frame-list))
    1184           0 :                              (t frames)))
    1185             :            height width)
    1186           0 :       (dolist (f frame-list)
    1187           0 :         (when (display-multi-font-p f)
    1188           0 :           (if keep-size
    1189           0 :               (setq height (* (frame-parameter f 'height)
    1190           0 :                               (frame-char-height f))
    1191           0 :                     width  (* (frame-parameter f 'width)
    1192           0 :                               (frame-char-width f))))
    1193             :           ;; When set-face-attribute is called for :font, Emacs
    1194             :           ;; guesses the best font according to other face attributes
    1195             :           ;; (:width, :weight, etc.) so reset them too (Bug#2476).
    1196           0 :           (set-face-attribute 'default f
    1197             :                               :width 'normal :weight 'normal
    1198           0 :                               :slant 'normal :font font)
    1199           0 :           (if keep-size
    1200           0 :               (modify-frame-parameters
    1201           0 :                f
    1202           0 :                (list (cons 'height (round height (frame-char-height f)))
    1203           0 :                      (cons 'width  (round width  (frame-char-width f))))))))
    1204           0 :       (when frames
    1205             :         ;; Alter the user's Custom setting of the `default' face, but
    1206             :         ;; only for font-related attributes.
    1207           0 :         (let ((specs (cadr (assq 'user (get 'default 'theme-face))))
    1208             :               (attrs '(:family :foundry :slant :weight :height :width))
    1209             :               (new-specs nil))
    1210           0 :           (if (null specs) (setq specs '((t nil))))
    1211           0 :           (dolist (spec specs)
    1212             :             ;; Each SPEC has the form (DISPLAY ATTRIBUTE-PLIST)
    1213           0 :             (let ((display (nth 0 spec))
    1214           0 :                   (plist   (copy-tree (nth 1 spec))))
    1215             :               ;; Alter only DISPLAY conditions matching this frame.
    1216           0 :               (when (or (memq display '(t default))
    1217           0 :                         (face-spec-set-match-display display this-frame))
    1218           0 :                 (dolist (attr attrs)
    1219           0 :                   (setq plist (plist-put plist attr
    1220           0 :                                          (face-attribute 'default attr)))))
    1221           0 :               (push (list display plist) new-specs)))
    1222           0 :           (setq new-specs (nreverse new-specs))
    1223           0 :           (put 'default 'customized-face new-specs)
    1224           0 :           (custom-push-theme 'theme-face 'default 'user 'set new-specs)
    1225           0 :           (put 'default 'face-modified nil))))
    1226           0 :     (run-hooks 'after-setting-font-hook 'after-setting-font-hooks)))
    1227             : 
    1228             : (defun set-frame-parameter (frame parameter value)
    1229             :   "Set frame parameter PARAMETER to VALUE on FRAME.
    1230             : If FRAME is nil, it defaults to the selected frame.
    1231             : See `modify-frame-parameters'."
    1232           0 :   (modify-frame-parameters frame (list (cons parameter value))))
    1233             : 
    1234             : (defun set-background-color (color-name)
    1235             :   "Set the background color of the selected frame to COLOR-NAME.
    1236             : When called interactively, prompt for the name of the color to use.
    1237             : To get the frame's current background color, use `frame-parameters'."
    1238           0 :   (interactive (list (read-color "Background color: ")))
    1239           0 :   (modify-frame-parameters (selected-frame)
    1240           0 :                            (list (cons 'background-color color-name)))
    1241           0 :   (or window-system
    1242           0 :       (face-set-after-frame-default (selected-frame)
    1243           0 :                                     (list
    1244           0 :                                      (cons 'background-color color-name)
    1245             :                                      ;; Pass the foreground-color as
    1246             :                                      ;; well, if defined, to avoid
    1247             :                                      ;; losing it when faces are reset
    1248             :                                      ;; to their defaults.
    1249           0 :                                      (assq 'foreground-color
    1250           0 :                                            (frame-parameters))))))
    1251             : 
    1252             : (defun set-foreground-color (color-name)
    1253             :   "Set the foreground color of the selected frame to COLOR-NAME.
    1254             : When called interactively, prompt for the name of the color to use.
    1255             : To get the frame's current foreground color, use `frame-parameters'."
    1256           0 :   (interactive (list (read-color "Foreground color: ")))
    1257           0 :   (modify-frame-parameters (selected-frame)
    1258           0 :                            (list (cons 'foreground-color color-name)))
    1259           0 :   (or window-system
    1260           0 :       (face-set-after-frame-default (selected-frame)
    1261           0 :                                     (list
    1262           0 :                                      (cons 'foreground-color color-name)
    1263             :                                      ;; Pass the background-color as
    1264             :                                      ;; well, if defined, to avoid
    1265             :                                      ;; losing it when faces are reset
    1266             :                                      ;; to their defaults.
    1267           0 :                                      (assq 'background-color
    1268           0 :                                            (frame-parameters))))))
    1269             : 
    1270             : (defun set-cursor-color (color-name)
    1271             :   "Set the text cursor color of the selected frame to COLOR-NAME.
    1272             : When called interactively, prompt for the name of the color to use.
    1273             : This works by setting the `cursor-color' frame parameter on the
    1274             : selected frame.
    1275             : 
    1276             : You can also set the text cursor color, for all frames, by
    1277             : customizing the `cursor' face."
    1278           0 :   (interactive (list (read-color "Cursor color: ")))
    1279           0 :   (modify-frame-parameters (selected-frame)
    1280           0 :                            (list (cons 'cursor-color color-name))))
    1281             : 
    1282             : (defun set-mouse-color (color-name)
    1283             :   "Set the color of the mouse pointer of the selected frame to COLOR-NAME.
    1284             : When called interactively, prompt for the name of the color to use.
    1285             : To get the frame's current mouse color, use `frame-parameters'."
    1286           0 :   (interactive (list (read-color "Mouse color: ")))
    1287           0 :   (modify-frame-parameters (selected-frame)
    1288           0 :                            (list (cons 'mouse-color
    1289           0 :                                        (or color-name
    1290           0 :                                            (cdr (assq 'mouse-color
    1291           0 :                                                       (frame-parameters))))))))
    1292             : 
    1293             : (defun set-border-color (color-name)
    1294             :   "Set the color of the border of the selected frame to COLOR-NAME.
    1295             : When called interactively, prompt for the name of the color to use.
    1296             : To get the frame's current border color, use `frame-parameters'."
    1297           0 :   (interactive (list (read-color "Border color: ")))
    1298           0 :   (modify-frame-parameters (selected-frame)
    1299           0 :                            (list (cons 'border-color color-name))))
    1300             : 
    1301             : (define-minor-mode auto-raise-mode
    1302             :   "Toggle whether or not selected frames should auto-raise.
    1303             : With a prefix argument ARG, enable Auto Raise mode if ARG is
    1304             : positive, and disable it otherwise.  If called from Lisp, enable
    1305             : the mode if ARG is omitted or nil.
    1306             : 
    1307             : Auto Raise mode does nothing under most window managers, which
    1308             : switch focus on mouse clicks.  It only has an effect if your
    1309             : window manager switches focus on mouse movement (in which case
    1310             : you should also change `focus-follows-mouse' to t).  Then,
    1311             : enabling Auto Raise mode causes any graphical Emacs frame which
    1312             : acquires focus to be automatically raised.
    1313             : 
    1314             : Note that this minor mode controls Emacs's own auto-raise
    1315             : feature.  Window managers that switch focus on mouse movement
    1316             : often have their own auto-raise feature."
    1317             :   :variable (frame-parameter nil 'auto-raise)
    1318           0 :   (if (frame-parameter nil 'auto-raise)
    1319           0 :       (raise-frame)))
    1320             : 
    1321             : (define-minor-mode auto-lower-mode
    1322             :   "Toggle whether or not the selected frame should auto-lower.
    1323             : With a prefix argument ARG, enable Auto Lower mode if ARG is
    1324             : positive, and disable it otherwise.  If called from Lisp, enable
    1325             : the mode if ARG is omitted or nil.
    1326             : 
    1327             : Auto Lower mode does nothing under most window managers, which
    1328             : switch focus on mouse clicks.  It only has an effect if your
    1329             : window manager switches focus on mouse movement (in which case
    1330             : you should also change `focus-follows-mouse' to t).  Then,
    1331             : enabling Auto Lower Mode causes any graphical Emacs frame which
    1332             : loses focus to be automatically lowered.
    1333             : 
    1334             : Note that this minor mode controls Emacs's own auto-lower
    1335             : feature.  Window managers that switch focus on mouse movement
    1336             : often have their own features for raising or lowering frames."
    1337             :   :variable (frame-parameter nil 'auto-lower))
    1338             : 
    1339             : (defun set-frame-name (name)
    1340             :   "Set the name of the selected frame to NAME.
    1341             : When called interactively, prompt for the name of the frame.
    1342             : On text terminals, the frame name is displayed on the mode line.
    1343             : On graphical displays, it is displayed on the frame's title bar."
    1344             :   (interactive "sFrame name: ")
    1345           0 :   (modify-frame-parameters (selected-frame)
    1346           0 :                            (list (cons 'name name))))
    1347             : 
    1348             : (defun frame-current-scroll-bars (&optional frame)
    1349             :   "Return the current scroll-bar types for frame FRAME.
    1350             : Value is a cons (VERTICAL . HORIZ0NTAL) where VERTICAL specifies
    1351             : the current location of the vertical scroll-bars (`left', `right'
    1352             : or nil), and HORIZONTAL specifies the current location of the
    1353             : horizontal scroll bars (`bottom' or nil).  FRAME must specify a
    1354             : live frame and defaults to the selected one."
    1355           0 :   (let* ((frame (window-normalize-frame frame))
    1356           0 :          (vertical (frame-parameter frame 'vertical-scroll-bars))
    1357           0 :          (horizontal (frame-parameter frame 'horizontal-scroll-bars)))
    1358           0 :     (unless (memq vertical '(left right nil))
    1359           0 :       (setq vertical default-frame-scroll-bars))
    1360           0 :     (cons vertical (and horizontal 'bottom))))
    1361             : 
    1362             : (declare-function x-frame-geometry "xfns.c" (&optional frame))
    1363             : (declare-function w32-frame-geometry "w32fns.c" (&optional frame))
    1364             : (declare-function ns-frame-geometry "nsfns.m" (&optional frame))
    1365             : 
    1366             : (defun frame-geometry (&optional frame)
    1367             :   "Return geometric attributes of FRAME.
    1368             : FRAME must be a live frame and defaults to the selected one.  The return
    1369             : value is an association list of the attributes listed below.  All height
    1370             : and width values are in pixels.
    1371             : 
    1372             : `outer-position' is a cons of the outer left and top edges of FRAME
    1373             :   relative to the origin - the position (0, 0) - of FRAME's display.
    1374             : 
    1375             : `outer-size' is a cons of the outer width and height of FRAME.  The
    1376             :   outer size includes the title bar and the external borders as well as
    1377             :   any menu and/or tool bar of frame.
    1378             : 
    1379             : `external-border-size' is a cons of the horizontal and vertical width of
    1380             :   FRAME's external borders as supplied by the window manager.
    1381             : 
    1382             : `title-bar-size' is a cons of the width and height of the title bar of
    1383             :   FRAME as supplied by the window manager.  If both of them are zero,
    1384             :   FRAME has no title bar.  If only the width is zero, Emacs was not
    1385             :   able to retrieve the width information.
    1386             : 
    1387             : `menu-bar-external', if non-nil, means the menu bar is external (never
    1388             :   included in the inner edges of FRAME).
    1389             : 
    1390             : `menu-bar-size' is a cons of the width and height of the menu bar of
    1391             :   FRAME.
    1392             : 
    1393             : `tool-bar-external', if non-nil, means the tool bar is external (never
    1394             :   included in the inner edges of FRAME).
    1395             : 
    1396             : `tool-bar-position' tells on which side the tool bar on FRAME is and can
    1397             :   be one of `left', `top', `right' or `bottom'.  If this is nil, FRAME
    1398             :   has no tool bar.
    1399             : 
    1400             : `tool-bar-size' is a cons of the width and height of the tool bar of
    1401             :   FRAME.
    1402             : 
    1403             : `internal-border-width' is the width of the internal border of
    1404             :   FRAME."
    1405           0 :   (let* ((frame (window-normalize-frame frame))
    1406           0 :          (frame-type (framep-on-display frame)))
    1407           0 :     (cond
    1408           0 :      ((eq frame-type 'x)
    1409           0 :       (x-frame-geometry frame))
    1410           0 :      ((eq frame-type 'w32)
    1411           0 :       (w32-frame-geometry frame))
    1412           0 :      ((eq frame-type 'ns)
    1413           0 :       (ns-frame-geometry frame))
    1414             :      (t
    1415           0 :       (list
    1416             :        '(outer-position 0 . 0)
    1417           0 :        (cons 'outer-size (cons (frame-width frame) (frame-height frame)))
    1418             :        '(external-border-size 0 . 0)
    1419             :        '(outer-border-width . 0)
    1420             :        '(title-bar-size 0 . 0)
    1421             :        '(menu-bar-external . nil)
    1422           0 :        (let ((menu-bar-lines (frame-parameter frame 'menu-bar-lines)))
    1423           0 :          (cons 'menu-bar-size
    1424           0 :                (if menu-bar-lines
    1425           0 :                    (cons (frame-width frame) 1)
    1426           0 :                  1 0)))
    1427             :        '(tool-bar-external . nil)
    1428             :        '(tool-bar-position . nil)
    1429             :        '(tool-bar-size 0 . 0)
    1430           0 :        (cons 'internal-border-width
    1431           0 :              (frame-parameter frame 'internal-border-width)))))))
    1432             : 
    1433             : (defun frame--size-history (&optional frame)
    1434             :   "Print history of resize operations for FRAME.
    1435             : Print prettified version of `frame-size-history' into a buffer
    1436             : called *frame-size-history*.  Optional argument FRAME denotes the
    1437             : frame whose history will be printed.  FRAME defaults to the
    1438             : selected frame."
    1439           0 :   (let ((history (reverse frame-size-history))
    1440             :         entry)
    1441           0 :     (setq frame (window-normalize-frame frame))
    1442           0 :     (with-current-buffer (get-buffer-create "*frame-size-history*")
    1443           0 :       (erase-buffer)
    1444           0 :       (insert (format "Frame size history of %s\n" frame))
    1445           0 :       (while (listp (setq entry (pop history)))
    1446           0 :         (when (eq (car entry) frame)
    1447           0 :           (pop entry)
    1448           0 :           (insert (format "%s" (pop entry)))
    1449           0 :           (move-to-column 24 t)
    1450           0 :           (while entry
    1451           0 :             (insert (format " %s" (pop entry))))
    1452           0 :           (insert "\n"))))))
    1453             : 
    1454             : (declare-function x-frame-edges "xfns.c" (&optional frame type))
    1455             : (declare-function w32-frame-edges "w32fns.c" (&optional frame type))
    1456             : (declare-function ns-frame-edges "nsfns.m" (&optional frame type))
    1457             : 
    1458             : (defun frame-edges (&optional frame type)
    1459             :   "Return coordinates of FRAME's edges.
    1460             : FRAME must be a live frame and defaults to the selected one.  The
    1461             : list returned has the form (LEFT TOP RIGHT BOTTOM) where all
    1462             : values are in pixels relative to the origin - the position (0, 0)
    1463             : - of FRAME's display.  For terminal frames all values are
    1464             : relative to LEFT and TOP which are both zero.
    1465             : 
    1466             : Optional argument TYPE specifies the type of the edges.  TYPE
    1467             : `outer-edges' means to return the outer edges of FRAME.  TYPE
    1468             : `native-edges' (or nil) means to return the native edges of
    1469             : FRAME.  TYPE `inner-edges' means to return the inner edges of
    1470             : FRAME."
    1471           0 :   (let* ((frame (window-normalize-frame frame))
    1472           0 :          (frame-type (framep-on-display frame)))
    1473           0 :     (cond
    1474           0 :      ((eq frame-type 'x)
    1475           0 :       (x-frame-edges frame type))
    1476           0 :      ((eq frame-type 'w32)
    1477           0 :       (w32-frame-edges frame type))
    1478           0 :      ((eq frame-type 'ns)
    1479           0 :       (ns-frame-edges frame type))
    1480             :      (t
    1481           0 :       (list 0 0 (frame-width frame) (frame-height frame))))))
    1482             : 
    1483             : (declare-function w32-mouse-absolute-pixel-position "w32fns.c")
    1484             : (declare-function x-mouse-absolute-pixel-position "xfns.c")
    1485             : (declare-function ns-mouse-absolute-pixel-position "nsfns.c")
    1486             : 
    1487             : (defun mouse-absolute-pixel-position ()
    1488             :   "Return absolute position of mouse cursor in pixels.
    1489             : The position is returned as a cons cell (X . Y) of the
    1490             : coordinates of the mouse cursor position in pixels relative to a
    1491             : position (0, 0) of the selected frame's terminal."
    1492           0 :   (let ((frame-type (framep-on-display)))
    1493           0 :     (cond
    1494           0 :      ((eq frame-type 'x)
    1495           0 :       (x-mouse-absolute-pixel-position))
    1496           0 :      ((eq frame-type 'w32)
    1497           0 :       (w32-mouse-absolute-pixel-position))
    1498           0 :      ((eq frame-type 'ns)
    1499           0 :       (ns-mouse-absolute-pixel-position))
    1500             :      (t
    1501           0 :       (cons 0 0)))))
    1502             : 
    1503             : (declare-function ns-set-mouse-absolute-pixel-position "nsfns.m" (x y))
    1504             : (declare-function w32-set-mouse-absolute-pixel-position "w32fns.c" (x y))
    1505             : (declare-function x-set-mouse-absolute-pixel-position "xfns.c" (x y))
    1506             : 
    1507             : (defun set-mouse-absolute-pixel-position (x y)
    1508             :   "Move mouse pointer to absolute pixel position (X, Y).
    1509             : The coordinates X and Y are interpreted in pixels relative to a
    1510             : position (0, 0) of the selected frame's terminal."
    1511           0 :   (let ((frame-type (framep-on-display)))
    1512           0 :     (cond
    1513           0 :      ((eq frame-type 'ns)
    1514           0 :       (ns-set-mouse-absolute-pixel-position x y))
    1515           0 :      ((eq frame-type 'x)
    1516           0 :       (x-set-mouse-absolute-pixel-position x y))
    1517           0 :      ((eq frame-type 'w32)
    1518           0 :       (w32-set-mouse-absolute-pixel-position x y)))))
    1519             : 
    1520             : (defun frame-monitor-attributes (&optional frame)
    1521             :   "Return the attributes of the physical monitor dominating FRAME.
    1522             : If FRAME is omitted or nil, describe the currently selected frame.
    1523             : 
    1524             : A frame is dominated by a physical monitor when either the
    1525             : largest area of the frame resides in the monitor, or the monitor
    1526             : is the closest to the frame if the frame does not intersect any
    1527             : physical monitors.
    1528             : 
    1529             : See `display-monitor-attributes-list' for the list of attribute
    1530             : keys and their meanings."
    1531           0 :   (or frame (setq frame (selected-frame)))
    1532           0 :   (cl-loop for attributes in (display-monitor-attributes-list frame)
    1533           0 :            for frames = (cdr (assq 'frames attributes))
    1534           0 :            if (memq frame frames) return attributes))
    1535             : 
    1536             : (defun frame-monitor-attribute (attribute &optional frame x y)
    1537             :   "Return the value of ATTRIBUTE on FRAME's monitor.
    1538             : If FRAME is omitted or nil, use currently selected frame.
    1539             : 
    1540             : By default, the current monitor is the physical monitor
    1541             : dominating the selected frame.  A frame is dominated by a
    1542             : physical monitor when either the largest area of the frame
    1543             : resides in the monitor, or the monitor is the closest to the
    1544             : frame if the frame does not intersect any physical monitors.
    1545             : 
    1546             : If X and Y are both numbers, then ignore the value of FRAME; the
    1547             : monitor is determined to be the physical monitor that contains
    1548             : the pixel coordinate (X, Y).
    1549             : 
    1550             : See `display-monitor-attributes-list' for the list of attribute
    1551             : keys and their meanings."
    1552           0 :   (if (and (numberp x)
    1553           0 :            (numberp y))
    1554           0 :       (cl-loop for monitor in (display-monitor-attributes-list)
    1555           0 :                for geometry = (alist-get 'geometry monitor)
    1556           0 :                for min-x = (pop geometry)
    1557           0 :                for min-y = (pop geometry)
    1558           0 :                for max-x = (+ min-x (pop geometry))
    1559           0 :                for max-y = (+ min-y (car geometry))
    1560           0 :                when (and (<= min-x x)
    1561           0 :                          (< x max-x)
    1562           0 :                          (<= min-y y)
    1563           0 :                          (< y max-y))
    1564           0 :                return (alist-get attribute monitor))
    1565           0 :     (alist-get attribute (frame-monitor-attributes frame))))
    1566             : 
    1567             : (defun frame-monitor-geometry (&optional frame x y)
    1568             :     "Return the geometry of FRAME's monitor.
    1569             : FRAME can be a frame name, a terminal name, or a frame.
    1570             : If FRAME is omitted or nil, use the currently selected frame.
    1571             : 
    1572             : By default, the current monitor is said to be the physical
    1573             : monitor dominating the selected frame.  A frame is dominated by
    1574             : a physical monitor when either the largest area of the frame resides
    1575             : in the monitor, or the monitor is the closest to the frame if the
    1576             : frame does not intersect any physical monitors.
    1577             : 
    1578             : If X and Y are both numbers, then ignore the value of FRAME; the
    1579             : monitor is determined to be the physical monitor that contains
    1580             : the pixel coordinate (X, Y).
    1581             : 
    1582             : See `display-monitor-attributes-list' for information on the
    1583             : geometry attribute."
    1584           0 :   (frame-monitor-attribute 'geometry frame x y))
    1585             : 
    1586             : (defun frame-monitor-workarea (&optional frame x y)
    1587             :   "Return the workarea of FRAME's monitor.
    1588             : FRAME can be a frame name, a terminal name, or a frame.
    1589             : If FRAME is omitted or nil, use currently selected frame.
    1590             : 
    1591             : By default, the current monitor is said to be the physical
    1592             : monitor dominating the selected frame.  A frame is dominated by
    1593             : a physical monitor when either the largest area of the frame resides
    1594             : in the monitor, or the monitor is the closest to the frame if the
    1595             : frame does not intersect any physical monitors.
    1596             : 
    1597             : If X and Y are both numbers, then ignore the value of FRAME; the
    1598             : monitor is determined to be the physical monitor that contains
    1599             : the pixel coordinate (X, Y).
    1600             : 
    1601             : See `display-monitor-attributes-list' for information on the
    1602             : workarea attribute."
    1603           0 :   (frame-monitor-attribute 'workarea frame x y))
    1604             : 
    1605             : (declare-function x-frame-list-z-order "xfns.c" (&optional display))
    1606             : (declare-function w32-frame-list-z-order "w32fns.c" (&optional display))
    1607             : (declare-function ns-frame-list-z-order "nsfns.m" (&optional display))
    1608             : 
    1609             : (defun frame-list-z-order (&optional display)
    1610             :   "Return list of Emacs' frames, in Z (stacking) order.
    1611             : The optional argument DISPLAY specifies which display to poll.
    1612             : DISPLAY should be either a frame or a display name (a string).
    1613             : If omitted or nil, that stands for the selected frame's display.
    1614             : 
    1615             : Frames are listed from topmost (first) to bottommost (last).  As
    1616             : a special case, if DISPLAY is non-nil and specifies a live frame,
    1617             : return the child frames of that frame in Z (stacking) order.
    1618             : 
    1619             : Return nil if DISPLAY contains no Emacs frame."
    1620           0 :   (let ((frame-type (framep-on-display display)))
    1621           0 :     (cond
    1622           0 :      ((eq frame-type 'x)
    1623           0 :       (x-frame-list-z-order display))
    1624           0 :      ((eq frame-type 'w32)
    1625           0 :       (w32-frame-list-z-order display))
    1626           0 :      ((eq frame-type 'ns)
    1627           0 :       (ns-frame-list-z-order display)))))
    1628             : 
    1629             : (declare-function x-frame-restack "xfns.c" (frame1 frame2 &optional above))
    1630             : (declare-function w32-frame-restack "w32fns.c" (frame1 frame2 &optional above))
    1631             : (declare-function ns-frame-restack "nsfns.m" (frame1 frame2 &optional above))
    1632             : 
    1633             : (defun frame-restack (frame1 frame2 &optional above)
    1634             :   "Restack FRAME1 below FRAME2.
    1635             : This implies that if both frames are visible and the display
    1636             : areas of these frames overlap, FRAME2 will (partially) obscure
    1637             : FRAME1.  If the optional third argument ABOVE is non-nil, restack
    1638             : FRAME1 above FRAME2.  This means that if both frames are visible
    1639             : and the display areas of these frames overlap, FRAME1 will
    1640             : \(partially) obscure FRAME2.
    1641             : 
    1642             : This may be thought of as an atomic action performed in two
    1643             : steps: The first step removes FRAME1's window-system window from
    1644             : the display.  The second step reinserts FRAME1's window
    1645             : below (above if ABOVE is true) that of FRAME2.  Hence the
    1646             : position of FRAME2 in its display's Z (stacking) order relative
    1647             : to all other frames excluding FRAME1 remains unaltered.
    1648             : 
    1649             : Some window managers may refuse to restack windows. "
    1650           0 :   (if (and (frame-live-p frame1)
    1651           0 :            (frame-live-p frame2)
    1652           0 :            (equal (frame-parameter frame1 'display)
    1653           0 :                   (frame-parameter frame2 'display)))
    1654           0 :       (let ((frame-type (framep-on-display frame1)))
    1655           0 :         (cond
    1656           0 :          ((eq frame-type 'x)
    1657           0 :           (x-frame-restack frame1 frame2 above))
    1658           0 :          ((eq frame-type 'w32)
    1659           0 :           (w32-frame-restack frame1 frame2 above))
    1660           0 :          ((eq frame-type 'ns)
    1661           0 :           (ns-frame-restack frame1 frame2 above))))
    1662           0 :     (error "Cannot restack frames")))
    1663             : 
    1664             : (defun frame-size-changed-p (&optional frame)
    1665             :   "Return non-nil when the size of FRAME has changed.
    1666             : More precisely, return non-nil when the inner width or height of
    1667             : FRAME has changed since `window-size-change-functions' was run
    1668             : for FRAME."
    1669           0 :   (let* ((frame (window-normalize-frame frame))
    1670           0 :          (root (frame-root-window frame))
    1671           0 :          (mini (minibuffer-window frame))
    1672             :          (mini-height-before-size-change 0)
    1673             :          (mini-height 0))
    1674             :     ;; FRAME's minibuffer window counts iff it's on FRAME and FRAME is
    1675             :     ;; not a minibuffer-only frame.
    1676           0 :     (when (and (eq (window-frame mini) frame) (not (eq mini root)))
    1677           0 :       (setq mini-height-before-size-change
    1678           0 :             (window-pixel-height-before-size-change mini))
    1679           0 :       (setq mini-height (window-pixel-height mini)))
    1680             :     ;; Return non-nil when either the width of the root or the sum of
    1681             :     ;; the heights of root and minibuffer window changed.
    1682           0 :     (or (/= (window-pixel-width-before-size-change root)
    1683           0 :             (window-pixel-width root))
    1684           0 :         (/= (+ (window-pixel-height-before-size-change root)
    1685           0 :                mini-height-before-size-change)
    1686           0 :             (+ (window-pixel-height root) mini-height)))))
    1687             : 
    1688             : ;;;; Frame/display capabilities.
    1689             : 
    1690             : (declare-function msdos-mouse-p "dosfns.c")
    1691             : 
    1692             : (defun display-mouse-p (&optional display)
    1693             :   "Return non-nil if DISPLAY has a mouse available.
    1694             : DISPLAY can be a display name, a frame, or nil (meaning the selected
    1695             : frame's display)."
    1696           0 :   (let ((frame-type (framep-on-display display)))
    1697           0 :     (cond
    1698           0 :      ((eq frame-type 'pc)
    1699           0 :       (msdos-mouse-p))
    1700           0 :      ((eq frame-type 'w32)
    1701           0 :       (with-no-warnings
    1702           0 :        (> w32-num-mouse-buttons 0)))
    1703           0 :      ((memq frame-type '(x ns))
    1704             :       t)    ;; We assume X and NeXTstep *always* have a pointing device
    1705             :      (t
    1706           0 :       (or (and (featurep 'xt-mouse)
    1707           0 :                xterm-mouse-mode)
    1708             :           ;; t-mouse is distributed with the GPM package.  It doesn't have
    1709             :           ;; a toggle.
    1710           0 :           (featurep 't-mouse)
    1711             :           ;; No way to check whether a w32 console has a mouse, assume
    1712             :           ;; it always does.
    1713           0 :           (boundp 'w32-use-full-screen-buffer))))))
    1714             : 
    1715             : (defun display-popup-menus-p (&optional display)
    1716             :   "Return non-nil if popup menus are supported on DISPLAY.
    1717             : DISPLAY can be a display name, a frame, or nil (meaning the selected
    1718             : frame's display).
    1719             : Support for popup menus requires that the mouse be available."
    1720           0 :   (display-mouse-p display))
    1721             : 
    1722             : (defun display-graphic-p (&optional display)
    1723             :   "Return non-nil if DISPLAY is a graphic display.
    1724             : Graphical displays are those which are capable of displaying several
    1725             : frames and several different fonts at once.  This is true for displays
    1726             : that use a window system such as X, and false for text-only terminals.
    1727             : DISPLAY can be a display name, a frame, or nil (meaning the selected
    1728             : frame's display)."
    1729           0 :   (not (null (memq (framep-on-display display) '(x w32 ns)))))
    1730             : 
    1731             : (defun display-images-p (&optional display)
    1732             :   "Return non-nil if DISPLAY can display images.
    1733             : 
    1734             : DISPLAY can be a display name, a frame, or nil (meaning the selected
    1735             : frame's display)."
    1736           0 :   (and (display-graphic-p display)
    1737           0 :        (fboundp 'image-mask-p)
    1738           0 :        (fboundp 'image-size)))
    1739             : 
    1740             : (defalias 'display-multi-frame-p 'display-graphic-p)
    1741             : (defalias 'display-multi-font-p 'display-graphic-p)
    1742             : 
    1743             : (defun display-selections-p (&optional display)
    1744             :   "Return non-nil if DISPLAY supports selections.
    1745             : A selection is a way to transfer text or other data between programs
    1746             : via special system buffers called `selection' or `clipboard'.
    1747             : DISPLAY can be a display name, a frame, or nil (meaning the selected
    1748             : frame's display)."
    1749           0 :   (let ((frame-type (framep-on-display display)))
    1750           0 :     (cond
    1751           0 :      ((eq frame-type 'pc)
    1752             :       ;; MS-DOS frames support selections when Emacs runs inside
    1753             :       ;; a Windows DOS Box.
    1754           0 :       (with-no-warnings
    1755           0 :        (not (null dos-windows-version))))
    1756           0 :      ((memq frame-type '(x w32 ns))
    1757             :       t)
    1758             :      (t
    1759           0 :       nil))))
    1760             : 
    1761             : (declare-function x-display-screens "xfns.c" (&optional terminal))
    1762             : 
    1763             : (defun display-screens (&optional display)
    1764             :   "Return the number of screens associated with DISPLAY.
    1765             : DISPLAY should be either a frame or a display name (a string).
    1766             : If DISPLAY is omitted or nil, it defaults to the selected frame's display."
    1767           0 :   (let ((frame-type (framep-on-display display)))
    1768           0 :     (cond
    1769           0 :      ((memq frame-type '(x w32 ns))
    1770           0 :       (x-display-screens display))
    1771             :      (t
    1772           0 :       1))))
    1773             : 
    1774             : (declare-function x-display-pixel-height "xfns.c" (&optional terminal))
    1775             : 
    1776             : (defun display-pixel-height (&optional display)
    1777             :   "Return the height of DISPLAY's screen in pixels.
    1778             : DISPLAY can be a display name or a frame.
    1779             : If DISPLAY is omitted or nil, it defaults to the selected frame's display.
    1780             : 
    1781             : For character terminals, each character counts as a single pixel.
    1782             : 
    1783             : For graphical terminals, note that on \"multi-monitor\" setups this
    1784             : refers to the pixel height for all physical monitors associated
    1785             : with DISPLAY.  To get information for each physical monitor, use
    1786             : `display-monitor-attributes-list'."
    1787           0 :   (let ((frame-type (framep-on-display display)))
    1788           0 :     (cond
    1789           0 :      ((memq frame-type '(x w32 ns))
    1790           0 :       (x-display-pixel-height display))
    1791             :      (t
    1792           0 :       (frame-height (if (framep display) display (selected-frame)))))))
    1793             : 
    1794             : (declare-function x-display-pixel-width "xfns.c" (&optional terminal))
    1795             : 
    1796             : (defun display-pixel-width (&optional display)
    1797             :   "Return the width of DISPLAY's screen in pixels.
    1798             : DISPLAY can be a display name or a frame.
    1799             : If DISPLAY is omitted or nil, it defaults to the selected frame's display.
    1800             : 
    1801             : For character terminals, each character counts as a single pixel.
    1802             : 
    1803             : For graphical terminals, note that on \"multi-monitor\" setups this
    1804             : refers to the pixel width for all physical monitors associated
    1805             : with DISPLAY.  To get information for each physical monitor, use
    1806             : `display-monitor-attributes-list'."
    1807           0 :   (let ((frame-type (framep-on-display display)))
    1808           0 :     (cond
    1809           0 :      ((memq frame-type '(x w32 ns))
    1810           0 :       (x-display-pixel-width display))
    1811             :      (t
    1812           0 :       (frame-width (if (framep display) display (selected-frame)))))))
    1813             : 
    1814             : (defcustom display-mm-dimensions-alist nil
    1815             :   "Alist for specifying screen dimensions in millimeters.
    1816             : The functions `display-mm-height' and `display-mm-width' consult
    1817             : this list before asking the system.
    1818             : 
    1819             : Each element has the form (DISPLAY . (WIDTH . HEIGHT)), e.g.
    1820             : \(\":0.0\" . (287 . 215)).
    1821             : 
    1822             : If `display' is t, it specifies dimensions for all graphical displays
    1823             : not explicitly specified."
    1824             :   :version "22.1"
    1825             :   :type '(alist :key-type (choice (string :tag "Display name")
    1826             :                                   (const :tag "Default" t))
    1827             :                 :value-type (cons :tag "Dimensions"
    1828             :                                   (integer :tag "Width")
    1829             :                                   (integer :tag "Height")))
    1830             :   :group 'frames)
    1831             : 
    1832             : (declare-function x-display-mm-height "xfns.c" (&optional terminal))
    1833             : 
    1834             : (defun display-mm-height (&optional display)
    1835             :   "Return the height of DISPLAY's screen in millimeters.
    1836             : If the information is unavailable, this function returns nil.
    1837             : DISPLAY can be a display name or a frame.
    1838             : If DISPLAY is omitted or nil, it defaults to the selected frame's display.
    1839             : 
    1840             : You can override what the system thinks the result should be by
    1841             : adding an entry to `display-mm-dimensions-alist'.
    1842             : 
    1843             : For graphical terminals, note that on \"multi-monitor\" setups this
    1844             : refers to the height in millimeters for all physical monitors
    1845             : associated with DISPLAY.  To get information for each physical
    1846             : monitor, use `display-monitor-attributes-list'."
    1847           0 :   (and (memq (framep-on-display display) '(x w32 ns))
    1848           0 :        (or (cddr (assoc (or display (frame-parameter nil 'display))
    1849           0 :                         display-mm-dimensions-alist))
    1850           0 :            (cddr (assoc t display-mm-dimensions-alist))
    1851           0 :            (x-display-mm-height display))))
    1852             : 
    1853             : (declare-function x-display-mm-width "xfns.c" (&optional terminal))
    1854             : 
    1855             : (defun display-mm-width (&optional display)
    1856             :   "Return the width of DISPLAY's screen in millimeters.
    1857             : If the information is unavailable, this function returns nil.
    1858             : DISPLAY can be a display name or a frame.
    1859             : If DISPLAY is omitted or nil, it defaults to the selected frame's display.
    1860             : 
    1861             : You can override what the system thinks the result should be by
    1862             : adding an entry to `display-mm-dimensions-alist'.
    1863             : 
    1864             : For graphical terminals, note that on \"multi-monitor\" setups this
    1865             : refers to the width in millimeters for all physical monitors
    1866             : associated with DISPLAY.  To get information for each physical
    1867             : monitor, use `display-monitor-attributes-list'."
    1868           0 :   (and (memq (framep-on-display display) '(x w32 ns))
    1869           0 :        (or (cadr (assoc (or display (frame-parameter nil 'display))
    1870           0 :                         display-mm-dimensions-alist))
    1871           0 :            (cadr (assoc t display-mm-dimensions-alist))
    1872           0 :            (x-display-mm-width display))))
    1873             : 
    1874             : (declare-function x-display-backing-store "xfns.c" (&optional terminal))
    1875             : 
    1876             : ;; In NS port, the return value may be `buffered', `retained', or
    1877             : ;; `non-retained'.  See src/nsfns.m.
    1878             : (defun display-backing-store (&optional display)
    1879             :   "Return the backing store capability of DISPLAY's screen.
    1880             : The value may be `always', `when-mapped', `not-useful', or nil if
    1881             : the question is inapplicable to a certain kind of display.
    1882             : DISPLAY can be a display name or a frame.
    1883             : If DISPLAY is omitted or nil, it defaults to the selected frame's display."
    1884           0 :   (let ((frame-type (framep-on-display display)))
    1885           0 :     (cond
    1886           0 :      ((memq frame-type '(x w32 ns))
    1887           0 :       (x-display-backing-store display))
    1888             :      (t
    1889           0 :       'not-useful))))
    1890             : 
    1891             : (declare-function x-display-save-under "xfns.c" (&optional terminal))
    1892             : 
    1893             : (defun display-save-under (&optional display)
    1894             :   "Return non-nil if DISPLAY's screen supports the SaveUnder feature.
    1895             : DISPLAY can be a display name or a frame.
    1896             : If DISPLAY is omitted or nil, it defaults to the selected frame's display."
    1897           0 :   (let ((frame-type (framep-on-display display)))
    1898           0 :     (cond
    1899           0 :      ((memq frame-type '(x w32 ns))
    1900           0 :       (x-display-save-under display))
    1901             :      (t
    1902           0 :       'not-useful))))
    1903             : 
    1904             : (declare-function x-display-planes "xfns.c" (&optional terminal))
    1905             : 
    1906             : (defun display-planes (&optional display)
    1907             :   "Return the number of planes supported by DISPLAY.
    1908             : DISPLAY can be a display name or a frame.
    1909             : If DISPLAY is omitted or nil, it defaults to the selected frame's display."
    1910           0 :   (let ((frame-type (framep-on-display display)))
    1911           0 :     (cond
    1912           0 :      ((memq frame-type '(x w32 ns))
    1913           0 :       (x-display-planes display))
    1914           0 :      ((eq frame-type 'pc)
    1915             :       4)
    1916             :      (t
    1917           0 :       (truncate (log (length (tty-color-alist)) 2))))))
    1918             : 
    1919             : (declare-function x-display-color-cells "xfns.c" (&optional terminal))
    1920             : 
    1921             : (defun display-color-cells (&optional display)
    1922             :   "Return the number of color cells supported by DISPLAY.
    1923             : DISPLAY can be a display name or a frame.
    1924             : If DISPLAY is omitted or nil, it defaults to the selected frame's display."
    1925           0 :   (let ((frame-type (framep-on-display display)))
    1926           0 :     (cond
    1927           0 :      ((memq frame-type '(x w32 ns))
    1928           0 :       (x-display-color-cells display))
    1929           0 :      ((eq frame-type 'pc)
    1930             :       16)
    1931             :      (t
    1932           0 :       (tty-display-color-cells display)))))
    1933             : 
    1934             : (declare-function x-display-visual-class "xfns.c" (&optional terminal))
    1935             : 
    1936             : (defun display-visual-class (&optional display)
    1937             :   "Return the visual class of DISPLAY.
    1938             : The value is one of the symbols `static-gray', `gray-scale',
    1939             : `static-color', `pseudo-color', `true-color', or `direct-color'.
    1940             : DISPLAY can be a display name or a frame.
    1941             : If DISPLAY is omitted or nil, it defaults to the selected frame's display."
    1942           0 :   (let ((frame-type (framep-on-display display)))
    1943           0 :     (cond
    1944           0 :      ((memq frame-type '(x w32 ns))
    1945           0 :       (x-display-visual-class display))
    1946           0 :      ((and (memq frame-type '(pc t))
    1947           0 :            (tty-display-color-p display))
    1948             :       'static-color)
    1949             :      (t
    1950           0 :       'static-gray))))
    1951             : 
    1952             : (declare-function x-display-monitor-attributes-list "xfns.c"
    1953             :                   (&optional terminal))
    1954             : (declare-function w32-display-monitor-attributes-list "w32fns.c"
    1955             :                   (&optional display))
    1956             : (declare-function ns-display-monitor-attributes-list "nsfns.m"
    1957             :                   (&optional terminal))
    1958             : 
    1959             : (defun display-monitor-attributes-list (&optional display)
    1960             :   "Return a list of physical monitor attributes on DISPLAY.
    1961             : DISPLAY can be a display name, a terminal name, or a frame.
    1962             : If DISPLAY is omitted or nil, it defaults to the selected frame's display.
    1963             : Each element of the list represents the attributes of a physical
    1964             : monitor.  The first element corresponds to the primary monitor.
    1965             : 
    1966             : The attributes for a physical monitor are represented as an alist
    1967             : of attribute keys and values as follows:
    1968             : 
    1969             :  geometry -- Position and size in pixels in the form of (X Y WIDTH HEIGHT)
    1970             :  workarea -- Position and size of the work area in pixels in the
    1971             :              form of (X Y WIDTH HEIGHT)
    1972             :  mm-size  -- Width and height in millimeters in the form of
    1973             :              (WIDTH HEIGHT)
    1974             :  frames   -- List of frames dominated by the physical monitor
    1975             :  name (*) -- Name of the physical monitor as a string
    1976             :  source (*) -- Source of multi-monitor information as a string
    1977             : 
    1978             : where X, Y, WIDTH, and HEIGHT are integers.  X and Y are coordinates
    1979             : of the top-left corner, and might be negative for monitors other than
    1980             : the primary one.  Keys labeled with (*) are optional.
    1981             : 
    1982             : The \"work area\" is a measure of the \"usable\" display space.
    1983             : It may be less than the total screen size, owing to space taken up
    1984             : by window manager features (docks, taskbars, etc.).  The precise
    1985             : details depend on the platform and environment.
    1986             : 
    1987             : The `source' attribute describes the source from which the information
    1988             : was obtained.  On X, this may be one of: \"Gdk\", \"XRandr\", \"Xinerama\",
    1989             : or \"fallback\".
    1990             : 
    1991             : A frame is dominated by a physical monitor when either the
    1992             : largest area of the frame resides in the monitor, or the monitor
    1993             : is the closest to the frame if the frame does not intersect any
    1994             : physical monitors.  Every (non-tooltip) frame (including invisible ones)
    1995             : in a graphical display is dominated by exactly one physical
    1996             : monitor at a time, though it can span multiple (or no) physical
    1997             : monitors."
    1998           0 :   (let ((frame-type (framep-on-display display)))
    1999           0 :     (cond
    2000           0 :      ((eq frame-type 'x)
    2001           0 :       (x-display-monitor-attributes-list display))
    2002           0 :      ((eq frame-type 'w32)
    2003           0 :       (w32-display-monitor-attributes-list display))
    2004           0 :      ((eq frame-type 'ns)
    2005           0 :       (ns-display-monitor-attributes-list display))
    2006             :      (t
    2007           0 :       (let ((geometry (list 0 0 (display-pixel-width display)
    2008           0 :                             (display-pixel-height display))))
    2009           0 :         `(((geometry . ,geometry)
    2010           0 :            (workarea . ,geometry)
    2011           0 :            (mm-size . (,(display-mm-width display)
    2012           0 :                        ,(display-mm-height display)))
    2013           0 :            (frames . ,(frames-on-display-list display)))))))))
    2014             : 
    2015             : 
    2016             : ;;;; Frame geometry values
    2017             : 
    2018             : (defun frame-geom-value-cons (type value &optional frame)
    2019             :   "Return equivalent geometry value for FRAME as a cons with car `+'.
    2020             : A geometry value equivalent to VALUE for FRAME is returned,
    2021             : where the value is a cons with car `+', not numeric.
    2022             : TYPE is the car of the original geometry spec (TYPE . VALUE).
    2023             :    It is `top' or `left', depending on which edge VALUE is related to.
    2024             : VALUE is the cdr of a frame geometry spec: (left/top . VALUE).
    2025             : If VALUE is a number, then it is converted to a cons value, perhaps
    2026             :    relative to the opposite frame edge from that in the original spec.
    2027             : FRAME defaults to the selected frame.
    2028             : 
    2029             : Examples (measures in pixels) -
    2030             :  Assuming display height/width=1024, frame height/width=600:
    2031             :  300 inside display edge:                   300  => (+  300)
    2032             :                                         (+  300) => (+  300)
    2033             :  300 inside opposite display edge:      (-  300) => (+  124)
    2034             :                                            -300  => (+  124)
    2035             :  300 beyond display edge
    2036             :   (= 724 inside opposite display edge): (+ -300) => (+ -300)
    2037             :  300 beyond display edge
    2038             :   (= 724 inside opposite display edge): (- -300) => (+  724)
    2039             : 
    2040             : In the 3rd, 4th, and 6th examples, the returned value is relative to
    2041             : the opposite frame edge from the edge indicated in the input spec."
    2042           0 :   (cond ((and (consp value) (eq '+ (car value))) ; e.g. (+ 300), (+ -300)
    2043           0 :          value)
    2044           0 :         ((natnump value) (list '+ value)) ; e.g. 300 => (+ 300)
    2045             :         (t                              ; e.g. -300, (- 300), (- -300)
    2046           0 :          (list '+ (- (if (eq 'left type) ; => (+ 124), (+ 124), (+ 724)
    2047           0 :                          (x-display-pixel-width)
    2048           0 :                        (x-display-pixel-height))
    2049           0 :                      (if (integerp value) (- value) (cadr value))
    2050           0 :                      (if (eq 'left type)
    2051           0 :                          (frame-pixel-width frame)
    2052           0 :                        (frame-pixel-height frame)))))))
    2053             : 
    2054             : (defun frame-geom-spec-cons (spec &optional frame)
    2055             :   "Return equivalent geometry spec for FRAME as a cons with car `+'.
    2056             : A geometry specification equivalent to SPEC for FRAME is returned,
    2057             : where the value is a cons with car `+', not numeric.
    2058             : SPEC is a frame geometry spec: (left . VALUE) or (top . VALUE).
    2059             : If VALUE is a number, then it is converted to a cons value, perhaps
    2060             : relative to the opposite frame edge from that in the original spec.
    2061             : FRAME defaults to the selected frame.
    2062             : 
    2063             : Examples (measures in pixels) -
    2064             :  Assuming display height=1024, frame height=600:
    2065             :  top 300 below display top:               (top .  300) => (top +  300)
    2066             :                                           (top +  300) => (top +  300)
    2067             :  bottom 300 above display bottom:         (top -  300) => (top +  124)
    2068             :                                           (top . -300) => (top +  124)
    2069             :  top 300 above display top
    2070             :   (= bottom 724 above display bottom):    (top + -300) => (top + -300)
    2071             :  bottom 300 below display bottom
    2072             :   (= top 724 below display top):          (top - -300) => (top +  724)
    2073             : 
    2074             : In the 3rd, 4th, and 6th examples, the returned value is relative to
    2075             : the opposite frame edge from the edge indicated in the input spec."
    2076           0 :   (cons (car spec) (frame-geom-value-cons (car spec) (cdr spec) frame)))
    2077             : 
    2078             : (defun delete-other-frames (&optional frame)
    2079             :   "Delete all frames on FRAME's terminal, except FRAME.
    2080             : If FRAME uses another frame's minibuffer, the minibuffer frame is
    2081             : left untouched.  Do not delete any of FRAME's child frames.  If
    2082             : FRAME is a child frame, delete its siblings only.  FRAME must be
    2083             : a live frame and defaults to the selected one."
    2084             :   (interactive)
    2085           0 :   (setq frame (window-normalize-frame frame))
    2086           0 :   (let ((minibuffer-frame (window-frame (minibuffer-window frame)))
    2087           0 :         (this (next-frame frame t))
    2088           0 :         (parent (frame-parent frame))
    2089             :         next)
    2090             :     ;; In a first round consider minibuffer-less frames only.
    2091           0 :     (while (not (eq this frame))
    2092           0 :       (setq next (next-frame this t))
    2093           0 :       (unless (or (eq (window-frame (minibuffer-window this)) this)
    2094             :                   ;; When FRAME is a child frame, delete its siblings
    2095             :                   ;; only.
    2096           0 :                   (and parent (not (eq (frame-parent this) parent)))
    2097             :                   ;; Do not delete a child frame of FRAME.
    2098           0 :                   (eq (frame-parent this) frame))
    2099           0 :         (delete-frame this))
    2100           0 :       (setq this next))
    2101             :     ;; In a second round consider all remaining frames.
    2102           0 :     (setq this (next-frame frame t))
    2103           0 :     (while (not (eq this frame))
    2104           0 :       (setq next (next-frame this t))
    2105           0 :       (unless (or (eq this minibuffer-frame)
    2106             :                   ;; When FRAME is a child frame, delete its siblings
    2107             :                   ;; only.
    2108           0 :                   (and parent (not (eq (frame-parent this) parent)))
    2109             :                   ;; Do not delete a child frame of FRAME.
    2110           0 :                   (eq (frame-parent this) frame))
    2111           0 :         (delete-frame this))
    2112           0 :       (setq this next))))
    2113             : 
    2114             : ;; miscellaneous obsolescence declarations
    2115             : (define-obsolete-variable-alias 'delete-frame-hook
    2116             :     'delete-frame-functions "22.1")
    2117             : 
    2118             : 
    2119             : ;;; Window dividers.
    2120             : (defgroup window-divider nil
    2121             :   "Window dividers."
    2122             :   :version "25.1"
    2123             :   :group 'frames
    2124             :   :group 'windows)
    2125             : 
    2126             : (defcustom window-divider-default-places 'right-only
    2127             :   "Default positions of window dividers.
    2128             : Possible values are `bottom-only' (dividers on the bottom of each
    2129             : window only), `right-only' (dividers on the right of each window
    2130             : only), and t (dividers on the bottom and on the right of each
    2131             : window).  The default is `right-only'.
    2132             : 
    2133             : The value takes effect if and only if dividers are enabled by
    2134             : `window-divider-mode'.
    2135             : 
    2136             : To position dividers on frames individually, use the frame
    2137             : parameters `bottom-divider-width' and `right-divider-width'."
    2138             :   :type '(choice (const :tag "Bottom only" bottom-only)
    2139             :                  (const :tag "Right only" right-only)
    2140             :                  (const :tag "Bottom and right" t))
    2141             :   :initialize 'custom-initialize-default
    2142             :   :set (lambda (symbol value)
    2143             :          (set-default symbol value)
    2144             :          (when window-divider-mode
    2145             :            (window-divider-mode-apply t)))
    2146             :   :version "25.1")
    2147             : 
    2148             : (defun window-divider-width-valid-p (value)
    2149             :   "Return non-nil if VALUE is a positive number."
    2150           0 :   (and (numberp value) (> value 0)))
    2151             : 
    2152             : (defcustom window-divider-default-bottom-width 6
    2153             :   "Default width of dividers on bottom of windows.
    2154             : The value must be a positive integer and takes effect when bottom
    2155             : dividers are displayed by `window-divider-mode'.
    2156             : 
    2157             : To adjust bottom dividers for frames individually, use the frame
    2158             : parameter `bottom-divider-width'."
    2159             :   :type '(restricted-sexp
    2160             :           :tag "Default width of bottom dividers"
    2161             :           :match-alternatives (window-divider-width-valid-p))
    2162             :   :initialize 'custom-initialize-default
    2163             :   :set (lambda (symbol value)
    2164             :          (set-default symbol value)
    2165             :          (when window-divider-mode
    2166             :            (window-divider-mode-apply t)))
    2167             :   :version "25.1")
    2168             : 
    2169             : (defcustom window-divider-default-right-width 6
    2170             :   "Default width of dividers on the right of windows.
    2171             : The value must be a positive integer and takes effect when right
    2172             : dividers are displayed by `window-divider-mode'.
    2173             : 
    2174             : To adjust right dividers for frames individually, use the frame
    2175             : parameter `right-divider-width'."
    2176             :   :type '(restricted-sexp
    2177             :           :tag "Default width of right dividers"
    2178             :           :match-alternatives (window-divider-width-valid-p))
    2179             :   :initialize 'custom-initialize-default
    2180             :   :set (lambda (symbol value)
    2181             :          (set-default symbol value)
    2182             :          (when window-divider-mode
    2183             :            (window-divider-mode-apply t)))
    2184             :   :version "25.1")
    2185             : 
    2186             : (defun window-divider-mode-apply (enable)
    2187             :   "Apply window divider places and widths to all frames.
    2188             : If ENABLE is nil, apply default places and widths.  Else reset
    2189             : all divider widths to zero."
    2190           0 :   (let ((bottom (if (and enable
    2191           0 :                          (memq window-divider-default-places
    2192           0 :                                '(bottom-only t)))
    2193           0 :                     window-divider-default-bottom-width
    2194           0 :                   0))
    2195           0 :         (right (if (and enable
    2196           0 :                         (memq window-divider-default-places
    2197           0 :                               '(right-only t)))
    2198           0 :                    window-divider-default-right-width
    2199           0 :                  0)))
    2200           0 :     (modify-all-frames-parameters
    2201           0 :      (list (cons 'bottom-divider-width bottom)
    2202           0 :            (cons 'right-divider-width right)))
    2203           0 :     (setq default-frame-alist
    2204           0 :           (assq-delete-all
    2205           0 :            'bottom-divider-width default-frame-alist))
    2206           0 :     (setq default-frame-alist
    2207           0 :           (assq-delete-all
    2208           0 :            'right-divider-width default-frame-alist))
    2209           0 :     (when (> bottom 0)
    2210           0 :       (setq default-frame-alist
    2211           0 :             (cons
    2212           0 :              (cons 'bottom-divider-width bottom)
    2213           0 :              default-frame-alist)))
    2214           0 :     (when (> right 0)
    2215           0 :       (setq default-frame-alist
    2216           0 :             (cons
    2217           0 :              (cons 'right-divider-width right)
    2218           0 :              default-frame-alist)))))
    2219             : 
    2220             : (define-minor-mode window-divider-mode
    2221             :   "Display dividers between windows (Window Divider mode).
    2222             : With a prefix argument ARG, enable Window Divider mode if ARG is
    2223             : positive, and disable it otherwise.  If called from Lisp, enable
    2224             : the mode if ARG is omitted or nil.
    2225             : 
    2226             : The option `window-divider-default-places' specifies on which
    2227             : side of a window dividers are displayed.  The options
    2228             : `window-divider-default-bottom-width' and
    2229             : `window-divider-default-right-width' specify their respective
    2230             : widths."
    2231             :   :group 'window-divider
    2232             :   :global t
    2233           0 :   (window-divider-mode-apply window-divider-mode))
    2234             : 
    2235             : ;; Blinking cursor
    2236             : 
    2237             : (defvar blink-cursor-idle-timer nil
    2238             :   "Timer started after `blink-cursor-delay' seconds of Emacs idle time.
    2239             : The function `blink-cursor-start' is called when the timer fires.")
    2240             : 
    2241             : (defvar blink-cursor-timer nil
    2242             :   "Timer started from `blink-cursor-start'.
    2243             : This timer calls `blink-cursor-timer-function' every
    2244             : `blink-cursor-interval' seconds.")
    2245             : 
    2246             : (defgroup cursor nil
    2247             :   "Displaying text cursors."
    2248             :   :version "21.1"
    2249             :   :group 'frames)
    2250             : 
    2251             : (defcustom blink-cursor-delay 0.5
    2252             :   "Seconds of idle time before the first blink of the cursor.
    2253             : Values smaller than 0.2 sec are treated as 0.2 sec."
    2254             :   :type 'number
    2255             :   :group 'cursor
    2256             :   :set (lambda (symbol value)
    2257             :          (set-default symbol value)
    2258             :          (when blink-cursor-idle-timer (blink-cursor--start-idle-timer))))
    2259             : 
    2260             : (defcustom blink-cursor-interval 0.5
    2261             :   "Length of cursor blink interval in seconds."
    2262             :   :type 'number
    2263             :   :group 'cursor
    2264             :   :set (lambda (symbol value)
    2265             :          (set-default symbol value)
    2266             :          (when blink-cursor-timer (blink-cursor--start-timer))))
    2267             : 
    2268             : (defcustom blink-cursor-blinks 10
    2269             :   "How many times to blink before using a solid cursor on NS, X, and MS-Windows.
    2270             : Use 0 or negative value to blink forever."
    2271             :   :version "24.4"
    2272             :   :type 'integer
    2273             :   :group 'cursor)
    2274             : 
    2275             : (defvar blink-cursor-blinks-done 1
    2276             :   "Number of blinks done since we started blinking on NS, X, and MS-Windows.")
    2277             : 
    2278             : (defun blink-cursor--start-idle-timer ()
    2279             :   "Start the `blink-cursor-idle-timer'."
    2280           0 :   (when blink-cursor-idle-timer (cancel-timer blink-cursor-idle-timer))
    2281           0 :   (setq blink-cursor-idle-timer
    2282             :         ;; The 0.2 sec limitation from below is to avoid erratic
    2283             :         ;; behavior (or downright failure to display the cursor
    2284             :         ;; during command execution) if they set blink-cursor-delay
    2285             :         ;; to a very small or even zero value.
    2286           0 :         (run-with-idle-timer (max 0.2 blink-cursor-delay)
    2287           0 :                              :repeat #'blink-cursor-start)))
    2288             : 
    2289             : (defun blink-cursor--start-timer ()
    2290             :   "Start the `blink-cursor-timer'."
    2291           0 :   (when blink-cursor-timer (cancel-timer blink-cursor-timer))
    2292           0 :   (setq blink-cursor-timer
    2293           0 :         (run-with-timer blink-cursor-interval blink-cursor-interval
    2294           0 :                         #'blink-cursor-timer-function)))
    2295             : 
    2296             : (defun blink-cursor-start ()
    2297             :   "Timer function called from the timer `blink-cursor-idle-timer'.
    2298             : This starts the timer `blink-cursor-timer', which makes the cursor blink
    2299             : if appropriate.  It also arranges to cancel that timer when the next
    2300             : command starts, by installing a pre-command hook."
    2301           0 :   (when (null blink-cursor-timer)
    2302             :     ;; Set up the timer first, so that if this signals an error,
    2303             :     ;; blink-cursor-end is not added to pre-command-hook.
    2304           0 :     (setq blink-cursor-blinks-done 1)
    2305           0 :     (blink-cursor--start-timer)
    2306           0 :     (add-hook 'pre-command-hook 'blink-cursor-end)
    2307           0 :     (internal-show-cursor nil nil)))
    2308             : 
    2309             : (defun blink-cursor-timer-function ()
    2310             :   "Timer function of timer `blink-cursor-timer'."
    2311           0 :   (internal-show-cursor nil (not (internal-show-cursor-p)))
    2312             :   ;; Suspend counting blinks when the w32 menu-bar menu is displayed,
    2313             :   ;; since otherwise menu tooltips will behave erratically.
    2314           0 :   (or (and (fboundp 'w32--menu-bar-in-use)
    2315           0 :            (w32--menu-bar-in-use))
    2316           0 :       (setq blink-cursor-blinks-done (1+ blink-cursor-blinks-done)))
    2317             :   ;; Each blink is two calls to this function.
    2318           0 :   (when (and (> blink-cursor-blinks 0)
    2319           0 :              (<= (* 2 blink-cursor-blinks) blink-cursor-blinks-done))
    2320           0 :     (blink-cursor-suspend)
    2321           0 :     (add-hook 'post-command-hook 'blink-cursor-check)))
    2322             : 
    2323             : 
    2324             : (defun blink-cursor-end ()
    2325             :   "Stop cursor blinking.
    2326             : This is installed as a pre-command hook by `blink-cursor-start'.
    2327             : When run, it cancels the timer `blink-cursor-timer' and removes
    2328             : itself as a pre-command hook."
    2329           0 :   (remove-hook 'pre-command-hook 'blink-cursor-end)
    2330           0 :   (internal-show-cursor nil t)
    2331           0 :   (when blink-cursor-timer
    2332           0 :     (cancel-timer blink-cursor-timer)
    2333           0 :     (setq blink-cursor-timer nil)))
    2334             : 
    2335             : (defun blink-cursor-suspend ()
    2336             :   "Suspend cursor blinking.
    2337             : This is called when no frame has focus and timers can be suspended.
    2338             : Timers are restarted by `blink-cursor-check', which is called when a
    2339             : frame receives focus."
    2340           0 :   (blink-cursor-end)
    2341           0 :   (when blink-cursor-idle-timer
    2342           0 :     (cancel-timer blink-cursor-idle-timer)
    2343           0 :     (setq blink-cursor-idle-timer nil)))
    2344             : 
    2345             : (defun blink-cursor-check ()
    2346             :   "Check if cursor blinking shall be restarted.
    2347             : This is done when a frame gets focus.  Blink timers may be stopped by
    2348             : `blink-cursor-suspend'."
    2349           0 :   (when (and blink-cursor-mode
    2350           0 :              (not blink-cursor-idle-timer))
    2351           0 :     (remove-hook 'post-command-hook 'blink-cursor-check)
    2352           0 :     (blink-cursor--start-idle-timer)))
    2353             : 
    2354             : (define-obsolete-variable-alias 'blink-cursor 'blink-cursor-mode "22.1")
    2355             : 
    2356             : (define-minor-mode blink-cursor-mode
    2357             :   "Toggle cursor blinking (Blink Cursor mode).
    2358             : With a prefix argument ARG, enable Blink Cursor mode if ARG is
    2359             : positive, and disable it otherwise.  If called from Lisp, enable
    2360             : the mode if ARG is omitted or nil.
    2361             : 
    2362             : If the value of `blink-cursor-blinks' is positive (10 by default),
    2363             : the cursor stops blinking after that number of blinks, if Emacs
    2364             : gets no input during that time.
    2365             : 
    2366             : See also `blink-cursor-interval' and `blink-cursor-delay'.
    2367             : 
    2368             : This command is effective only on graphical frames.  On text-only
    2369             : terminals, cursor blinking is controlled by the terminal."
    2370             :   :init-value (not (or noninteractive
    2371             :                        no-blinking-cursor
    2372             :                        (eq system-type 'ms-dos)
    2373             :                        (not (memq window-system '(x w32 ns)))))
    2374             :   :initialize 'custom-initialize-delay
    2375             :   :group 'cursor
    2376             :   :global t
    2377           0 :   (blink-cursor-suspend)
    2378           0 :   (remove-hook 'focus-in-hook #'blink-cursor-check)
    2379           0 :   (remove-hook 'focus-out-hook #'blink-cursor-suspend)
    2380           0 :   (when blink-cursor-mode
    2381           0 :     (add-hook 'focus-in-hook #'blink-cursor-check)
    2382           0 :     (add-hook 'focus-out-hook #'blink-cursor-suspend)
    2383           0 :     (blink-cursor--start-idle-timer)))
    2384             : 
    2385             : 
    2386             : 
    2387             : ;; Frame maximization/fullscreen
    2388             : 
    2389             : (defun toggle-frame-maximized ()
    2390             :   "Toggle maximization state of selected frame.
    2391             : Maximize selected frame or un-maximize if it is already maximized.
    2392             : 
    2393             : If the frame is in fullscreen state, don't change its state, but
    2394             : set the frame's `fullscreen-restore' parameter to `maximized', so
    2395             : the frame will be maximized after disabling fullscreen state.
    2396             : 
    2397             : Note that with some window managers you may have to set
    2398             : `frame-resize-pixelwise' to non-nil in order to make a frame
    2399             : appear truly maximized.  In addition, you may have to set
    2400             : `x-frame-normalize-before-maximize' in order to enable
    2401             : transitions from one fullscreen state to another.
    2402             : 
    2403             : See also `toggle-frame-fullscreen'."
    2404             :   (interactive)
    2405           0 :   (let ((fullscreen (frame-parameter nil 'fullscreen)))
    2406           0 :     (cond
    2407           0 :      ((memq fullscreen '(fullscreen fullboth))
    2408           0 :       (set-frame-parameter nil 'fullscreen-restore 'maximized))
    2409           0 :      ((eq fullscreen 'maximized)
    2410           0 :       (set-frame-parameter nil 'fullscreen nil))
    2411             :      (t
    2412           0 :       (set-frame-parameter nil 'fullscreen 'maximized)))))
    2413             : 
    2414             : (defun toggle-frame-fullscreen ()
    2415             :   "Toggle fullscreen state of selected frame.
    2416             : Make selected frame fullscreen or restore its previous size if it
    2417             : is already fullscreen.
    2418             : 
    2419             : Before making the frame fullscreen remember the current value of
    2420             : the frame's `fullscreen' parameter in the `fullscreen-restore'
    2421             : parameter of the frame.  That value is used to restore the
    2422             : frame's fullscreen state when toggling fullscreen the next time.
    2423             : 
    2424             : Note that with some window managers you may have to set
    2425             : `frame-resize-pixelwise' to non-nil in order to make a frame
    2426             : appear truly fullscreen.  In addition, you may have to set
    2427             : `x-frame-normalize-before-maximize' in order to enable
    2428             : transitions from one fullscreen state to another.
    2429             : 
    2430             : See also `toggle-frame-maximized'."
    2431             :   (interactive)
    2432           0 :   (let ((fullscreen (frame-parameter nil 'fullscreen)))
    2433           0 :     (if (memq fullscreen '(fullscreen fullboth))
    2434           0 :         (let ((fullscreen-restore (frame-parameter nil 'fullscreen-restore)))
    2435           0 :           (if (memq fullscreen-restore '(maximized fullheight fullwidth))
    2436           0 :               (set-frame-parameter nil 'fullscreen fullscreen-restore)
    2437           0 :             (set-frame-parameter nil 'fullscreen nil)))
    2438           0 :       (modify-frame-parameters
    2439           0 :        nil `((fullscreen . fullboth) (fullscreen-restore . ,fullscreen))))))
    2440             : 
    2441             : ;;;; Key bindings
    2442             : 
    2443             : (define-key ctl-x-5-map "2" 'make-frame-command)
    2444             : (define-key ctl-x-5-map "1" 'delete-other-frames)
    2445             : (define-key ctl-x-5-map "0" 'delete-frame)
    2446             : (define-key ctl-x-5-map "o" 'other-frame)
    2447             : (define-key global-map [f11] 'toggle-frame-fullscreen)
    2448             : (define-key global-map [(meta f10)] 'toggle-frame-maximized)
    2449             : (define-key esc-map    [f10]        'toggle-frame-maximized)
    2450             : 
    2451             : 
    2452             : ;; Misc.
    2453             : 
    2454             : ;; Only marked as obsolete in 24.3.
    2455             : (define-obsolete-variable-alias 'automatic-hscrolling
    2456             :   'auto-hscroll-mode "22.1")
    2457             : 
    2458             : (make-variable-buffer-local 'show-trailing-whitespace)
    2459             : 
    2460             : ;; Defined in dispnew.c.
    2461             : (make-obsolete-variable
    2462             :  'window-system-version "it does not give useful information." "24.3")
    2463             : 
    2464             : ;; Variables whose change of value should trigger redisplay of the
    2465             : ;; current buffer.
    2466             : ;; To test whether a given variable needs to be added to this list,
    2467             : ;; write a simple interactive function that changes the variable's
    2468             : ;; value and bind that function to a simple key, like F5.  If typing
    2469             : ;; F5 then produces the correct effect, the variable doesn't need
    2470             : ;; to be in this list; otherwise, it does.
    2471             : (mapc (lambda (var)
    2472             :         (add-variable-watcher var (symbol-function 'set-buffer-redisplay)))
    2473             :       '(line-spacing
    2474             :         overline-margin
    2475             :         line-prefix
    2476             :         wrap-prefix
    2477             :         truncate-lines
    2478             :         display-line-numbers
    2479             :         display-line-numbers-width
    2480             :         display-line-numbers-current-absolute
    2481             :         display-line-numbers-widen
    2482             :         bidi-paragraph-direction
    2483             :         bidi-display-reordering))
    2484             : 
    2485             : (provide 'frame)
    2486             : 
    2487             : ;;; frame.el ends here

Generated by: LCOV version 1.12