;;; frame.el --- multi-frame management independent of window systems
-;; Copyright (C) 1993, 1994, 1996, 1997, 2000, 2001
+;; Copyright (C) 1993, 1994, 1996, 1997, 2000, 2001, 2003, 2004
;; Free Software Foundation, Inc.
;; Maintainer: FSF
:group 'frames)
(setq pop-up-frame-function
- (function (lambda ()
- (make-frame pop-up-frame-alist))))
+ ;; Using `function' here caused some sort of problem.
+ '(lambda ()
+ (make-frame pop-up-frame-alist)))
(defcustom special-display-frame-alist
'((height . 14) (width . 80) (unsplittable . t))
Pass it BUFFER as first arg, and (cdr ARGS) gives the rest of the args."
(if (and args (symbolp (car args)))
(apply (car args) buffer (cdr args))
- (let ((window (get-buffer-window buffer t)))
+ (let ((window (get-buffer-window buffer 0)))
(or
;; If we have a window already, make it visible.
(when window
(let* ((pop-up-frames nil) (pop-up-windows t)
special-display-regexps special-display-buffer-names
(window (display-buffer buffer)))
+ ;; Only do it if this is a new window:
;; (set-window-dedicated-p window t)
window))
;; If no window yet, make one in a new frame.
(setq default-frame-alist
(cons (cons 'menu-bar-lines (if menu-bar-mode 1 0))
default-frame-alist)))))
-
+
;; Make tool-bar-mode and default-frame-alist consistent. Don't do
;; it in batch mode since that would leave a tool-bar-lines
;; parameter in default-frame-alist in a dumped Emacs, which is not
(relief (if (and (integerp tool-bar-button-relief)
(> tool-bar-button-relief 0))
tool-bar-button-relief 3))
- (lines (/ (+ image-height
+ (lines (/ (+ image-height
(* 2 margin)
(* 2 relief)
(1- char-height))
char-height))
(height (frame-parameter frame-initial-frame 'height))
(newparms (list (cons 'height (- height lines))))
- (initial-top (cdr (assq 'top
+ (initial-top (cdr (assq 'top
frame-initial-geometry-arguments)))
(top (frame-parameter frame-initial-frame 'top)))
(when (and (consp initial-top) (eq '- (car initial-top)))
- (setq newparms
- (append newparms
- `((top . ,(+ top (* lines char-height))))
- nil)))
+ (let ((adjusted-top
+ (cond ((and (consp top)
+ (eq '+ (car top)))
+ (list '+
+ (+ (cadr top)
+ (* lines char-height))))
+ ((and (consp top)
+ (eq '- (car top)))
+ (list '-
+ (- (cadr top)
+ (* lines char-height))))
+ (t (+ top (* lines char-height))))))
+ (setq newparms
+ (append newparms
+ `((top . ,adjusted-top))
+ nil))))
(modify-frame-parameters frame-initial-frame newparms)
(tool-bar-mode -1)))))
(sleep-for 1))
(setq parms (frame-parameters frame-initial-frame))
- ;; Get rid of `name' unless it was specified explicitly before.
+ ;; Get rid of `name' unless it was specified explicitly before.
(or (assq 'name frame-initial-frame-alist)
(setq parms (delq (assq 'name parms) parms)))
(setq tail allparms)
;; Find just the parms that have changed since we first
;; made this frame. Those are the ones actually set by
- ;; the init file. For those parms whose values we already knew
+ ;; the init file. For those parms whose values we already knew
;; (such as those spec'd by command line options)
;; it is undesirable to specify the parm again
- ;; once the user has seen the frame and been able to alter it
+ ;; once the user has seen the frame and been able to alter it
;; manually.
(while tail
(let (newval oldval)
;;;; Creation of additional frames, and other frame miscellanea
+(defun modify-all-frames-parameters (alist)
+ "modify all current and future frames parameters according to ALIST.
+This changes `default-frame-alist' and possibly `initial-frame-alist'.
+See help of `modify-frame-parameters' for more information."
+ (let (element) ;; temp
+ (dolist (frame (frame-list))
+ (modify-frame-parameters frame alist))
+
+ (dolist (pair alist) ;; conses to add/replace
+ ;; initial-frame-alist needs setting only when
+ ;; frame-notice-user-settings is true
+ (and frame-notice-user-settings
+ (setq element (assoc (car pair) initial-frame-alist))
+ (setq initial-frame-alist (delq element initial-frame-alist)))
+ (and (setq element (assoc (car pair) default-frame-alist))
+ (setq default-frame-alist (delq element default-frame-alist)))))
+ (and frame-notice-user-settings
+ (setq initial-frame-alist (append initial-frame-alist alist)))
+ (setq default-frame-alist (append default-frame-alist alist)))
+
(defun get-other-frame ()
"Return some frame other than the current frame.
Create one if necessary. Note that the minibuffer frame, if separate,
(interactive)
(select-window (next-window (selected-window)
(> (minibuffer-depth) 0)
- t))
+ 0))
(select-frame-set-input-focus (selected-frame)))
(defun previous-multiframe-window ()
(interactive)
(select-window (previous-window (selected-window)
(> (minibuffer-depth) 0)
- t))
+ 0))
(select-frame-set-input-focus (selected-frame)))
(defun make-frame-on-display (display &optional parameters)
;; Alias, kept temporarily.
(defalias 'new-frame 'make-frame)
+(make-obsolete 'new-frame 'make-frame "21.4")
(defun make-frame (&optional parameters)
"Return a newly created frame displaying the current buffer.
If DISPLAY is omitted or nil, it defaults to the selected frame's display."
(let* ((display (or display (frame-parameter nil 'display)))
(func #'(lambda (frame)
- (eq (frame-parameter frame 'display) display))))
+ (equal (frame-parameter frame 'display) display))))
(filtered-frame-list func)))
(defun framep-on-display (&optional display)
(nreverse frame-initial-geometry-arguments))
(cdr param-list))
-
(defcustom focus-follows-mouse t
- "*Non-nil if window system changes focus when you move the mouse."
+ "*Non-nil if window system changes focus when you move the mouse.
+You should set this variable to tell Emacs how your window manager
+handles focus, since there is no way in general for Emacs to find out
+automatically."
:type 'boolean
:group 'frames
:version "20.3")
(select-frame frame)
(raise-frame frame)
;; Ensure, if possible, that frame gets input focus.
- (when (eq window-system 'w32)
- (w32-focus-frame frame))
+ (cond ((eq window-system 'x)
+ (x-focus-frame frame))
+ ((eq window-system 'w32)
+ (w32-focus-frame frame)))
(cond (focus-follows-mouse
- (unless (eq window-system 'w32)
- (set-mouse-position (selected-frame) (1- (frame-width)) 0)))
- (t
- (when (eq window-system 'x)
- (x-focus-frame frame)))))
+ (set-mouse-position (selected-frame) (1- (frame-width)) 0))))
(defun other-frame (arg)
"Select the ARG'th different visible frame on current display, and raise it.
All frames are arranged in a cyclic order.
This command selects the frame ARG steps away in that order.
-A negative ARG moves in the opposite order."
+A negative ARG moves in the opposite order.
+
+To make this command work properly, you must tell Emacs
+how the system (or the window manager) generally handles
+focus-switching between windows. If moving the mouse onto a window
+selects it (gives it focus), set `focus-follows-mouse' to t.
+Otherwise, that variable should be nil."
(interactive "p")
(let ((frame (selected-frame)))
(while (> arg 0)
(setq arg (1+ arg)))
(select-frame-set-input-focus frame)))
+(defun iconify-or-deiconify-frame ()
+ "Iconify the selected frame, or deiconify if it's currently an icon."
+ (interactive)
+ (if (eq (cdr (assq 'visibility (frame-parameters))) t)
+ (iconify-frame)
+ (make-frame-visible)))
+
(defun make-frame-names-alist ()
(let* ((current-frame (selected-frame))
(falist
(raise-frame frame)
(select-frame frame)
;; Ensure, if possible, that frame gets input focus.
- (if (eq window-system 'w32)
- (w32-focus-frame frame)
- (when focus-follows-mouse
- (set-mouse-position (selected-frame) (1- (frame-width)) 0)))))
+ (cond ((eq window-system 'x)
+ (x-focus-frame frame))
+ ((eq window-system 'w32)
+ (w32-focus-frame frame)))
+ (when focus-follows-mouse
+ (set-mouse-position frame (1- (frame-width frame)) 0))))
\f
;;;; Frame configurations
(cdr (assq 'width (frame-parameters frame))))
(defalias 'set-default-font 'set-frame-font)
-(defun set-frame-font (font-name)
+(defun set-frame-font (font-name &optional keep-size)
"Set the font of the selected frame to FONT-NAME.
When called interactively, prompt for the name of the font to use.
-To get the frame's current default font, use `frame-parameters'."
- (interactive
- (list
- (let ((completion-ignore-case t))
- (completing-read "Font name: "
- (mapcar #'list
- ;; x-list-fonts will fail with an error
- ;; if this frame doesn't support fonts.
- (x-list-fonts "*" nil (selected-frame)))))))
- (modify-frame-parameters (selected-frame)
- (list (cons 'font font-name)))
+To get the frame's current default font, use `frame-parameters'.
+
+The default behavior is to keep the numbers of lines and columns in
+the frame, thus may change its pixel size. If optional KEEP-SIZE is
+non-nil (interactively, prefix argument) the current frame size (in
+pixels) is kept by adjusting the numbers of the lines and columns."
+ (interactive
+ (let* ((completion-ignore-case t)
+ (font (completing-read "Font name: "
+ (mapcar #'list
+ ;; x-list-fonts will fail with an error
+ ;; if this frame doesn't support fonts.
+ (x-list-fonts "*" nil (selected-frame)))
+ nil nil nil nil
+ (frame-parameter nil 'font))))
+ (list font current-prefix-arg)))
+ (let (fht fwd)
+ (if keep-size
+ (setq fht (* (frame-parameter nil 'height) (frame-char-height))
+ fwd (* (frame-parameter nil 'width) (frame-char-width))))
+ (modify-frame-parameters (selected-frame)
+ (list (cons 'font font-name)))
+ (if keep-size
+ (modify-frame-parameters
+ (selected-frame)
+ (list (cons 'height (round fht (frame-char-height)))
+ (cons 'width (round fwd (frame-char-width)))))))
(run-hooks 'after-setting-font-hook 'after-setting-font-hooks))
(defun set-frame-parameter (frame parameter value)
To get the frame's current background color, use `frame-parameters'."
(interactive (list (facemenu-read-color)))
(modify-frame-parameters (selected-frame)
- (list (cons 'background-color color-name))))
+ (list (cons 'background-color color-name)))
+ (or window-system
+ (face-set-after-frame-default (selected-frame))))
(defun set-foreground-color (color-name)
"Set the foreground color of the selected frame to COLOR-NAME.
To get the frame's current foreground color, use `frame-parameters'."
(interactive (list (facemenu-read-color)))
(modify-frame-parameters (selected-frame)
- (list (cons 'foreground-color color-name))))
+ (list (cons 'foreground-color color-name)))
+ (or window-system
+ (face-set-after-frame-default (selected-frame))))
(defun set-cursor-color (color-name)
"Set the text cursor color of the selected frame to COLOR-NAME.
(interactive "sFrame name: ")
(modify-frame-parameters (selected-frame)
(list (cons 'name name))))
+
+(defun frame-current-scroll-bars (&optional frame)
+ "Return the current scroll-bar settings in frame FRAME.
+Value is a cons (VERTICAL . HORISONTAL) where VERTICAL specifies the
+current location of the vertical scroll-bars (left, right, or nil),
+and HORISONTAL specifies the current location of the horisontal scroll
+bars (top, bottom, or nil)."
+ (let ((vert (frame-parameter frame 'vertical-scroll-bars))
+ (hor nil))
+ (unless (memq vert '(left right nil))
+ (setq vert default-frame-scroll-bars))
+ (cons vert hor)))
\f
;;;; Frame/display capabilities.
(defun display-mouse-p (&optional display)
frame's display)."
(and (display-graphic-p display)
(fboundp 'image-mask-p)
- (fboundp 'image-size)
- ;; FIXME: this will need to be revisited when the Windows port
- ;; supports images.
- (not (eq (framep-on-display display) 'w32))))
+ (fboundp 'image-size)))
(defalias 'display-multi-frame-p 'display-graphic-p)
(defalias 'display-multi-font-p 'display-graphic-p)
((eq frame-type 'pc)
16)
(t
- (length (tty-color-alist))))))
+ (tty-display-color-cells)))))
(defun display-visual-class (&optional display)
"Returns the visual class of DISPLAY.
(when (eq (frame-parameter frame 'minibuffer) 'only)
(delete-frame frame)))))
-
(make-obsolete 'screen-height 'frame-height) ;before 19.15
(make-obsolete 'screen-width 'frame-width) ;before 19.15
(make-obsolete 'set-screen-width 'set-frame-width) ;before 19.15
(make-obsolete 'set-screen-height 'set-frame-height) ;before 19.15
+;; miscellaneous obsolescence declarations
+(defvaralias 'delete-frame-hook 'delete-frame-functions)
+(make-obsolete-variable 'delete-frame-hook 'delete-frame-functions "21.4")
+
\f
;; Highlighting trailing whitespace.
Setting this variable makes it local to the current buffer."
:tag "Highlight trailing whitespace."
- :set #'(lambda (symbol value) (set-default symbol value))
:type 'boolean
:group 'font-lock)
:version "21.1"
:group 'frames)
-(defcustom automatic-hscrolling t
+(defcustom auto-hscroll-mode t
"*Allow or disallow automatic scrolling windows horizontally.
If non-nil, windows are automatically scrolled horizontally to make
point visible."
:version "21.1"
:type 'boolean
:group 'scrolling)
+(defvaralias 'automatic-hscrolling 'auto-hscroll-mode)
\f
;; Blinking cursor
(defun blink-cursor-end ()
"Stop cursor blinking.
This is installed as a pre-command hook by `blink-cursor-start'.
-When run, it cancels the timer `blink-cursor-timer' and removes
+When run, it cancels the timer `blink-cursor-timer' and removes
itself as a pre-command hook."
(remove-hook 'pre-command-hook 'blink-cursor-end)
(internal-show-cursor nil t)
(defcustom cursor-in-non-selected-windows t
"*Non-nil means show a hollow box cursor in non-selected-windows.
If nil, don't show a cursor except in the selected window.
-Use Custom to set this variable to get the display updated."
+Use Custom to set this variable to get the display updated."
:tag "Cursor in non-selected windows"
:type 'boolean
:group 'cursor
:set #'(lambda (symbol value)
(set-default symbol value)
(force-mode-line-update t)))
-
+
\f
;;;; Key bindings
(provide 'frame)
+;;; arch-tag: 82979c70-b8f2-4306-b2ad-ddbd6b328b56
;;; frame.el ends here
HCoop / bpt / emacs.git / blobdiff