X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/615a3b8d0d2c88cd664f1e0beb5a32b5b8e08f90..2ab329f3b5d52a39f0a45c3d9c129f1c19560142:/lisp/frame.el diff --git a/lisp/frame.el b/lisp/frame.el index f63179de1f..b7b61bcc57 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -1,6 +1,6 @@ ;;; frame.el --- multi-frame management independent of window systems -;; Copyright (C) 1993-1994, 1996-1997, 2000-2011 +;; Copyright (C) 1993-1994, 1996-1997, 2000-2012 ;; Free Software Foundation, Inc. ;; Maintainer: FSF @@ -25,7 +25,7 @@ ;;; Commentary: ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (defvar frame-creation-function-alist (list (cons nil @@ -39,10 +39,20 @@ function to this list, which should take an alist of parameters as its argument.") (defvar window-system-default-frame-alist nil - "Alist of window-system dependent default frame parameters. -Parameters specified here supersede the values given in + "Window-system dependent default frame parameters. +The value should be an alist of elements (WINDOW-SYSTEM . ALIST), +where WINDOW-SYSTEM is a window system symbol (see `window-system') +and ALIST is a frame parameter alist like `default-frame-alist'. +Then, for frames on WINDOW-SYSTEM, any parameters specified in +ALIST supersede the corresponding parameters specified in `default-frame-alist'.") +(defvar display-format-alist nil + "Alist of patterns to decode display names. +The car of each entry is a regular expression matching a display +name string. The cdr is a symbol giving the window-system that +handles the corresponding kind of display.") + ;; The initial value given here used to ask for a minibuffer. ;; But that's not necessary, because the default is to have one. ;; By not specifying it here, we let an X resource specify it. @@ -299,7 +309,7 @@ there (in decreasing order of priority)." ;; existing frame. We need to explicitly include ;; default-frame-alist in the parameters of the screen we ;; create here, so that its new value, gleaned from the user's - ;; .emacs file, will be applied to the existing screen. + ;; init file, will be applied to the existing screen. (if (not (eq (cdr (or (assq 'minibuffer initial-frame-alist) (assq 'minibuffer window-system-frame-alist) (assq 'minibuffer default-frame-alist) @@ -396,7 +406,7 @@ there (in decreasing order of priority)." ;; Finally, get rid of the old frame. (delete-frame frame-initial-frame t)) - ;; Otherwise, we don't need all that rigamarole; just apply + ;; Otherwise, we don't need all that rigmarole; just apply ;; the new parameters. (let (newparms allparms tail) (setq allparms (append initial-frame-alist @@ -508,31 +518,19 @@ is not considered (see `next-frame')." 0)) (select-frame-set-input-focus (selected-frame))) -(declare-function x-initialize-window-system "term/x-win" ()) -(declare-function ns-initialize-window-system "term/ns-win" ()) -(defvar x-display-name) ; term/x-win +(defun window-system-for-display (display) + "Return the window system for DISPLAY. +Return nil if we don't know how to interpret DISPLAY." + (cl-loop for descriptor in display-format-alist + for pattern = (car descriptor) + for system = (cdr descriptor) + when (string-match-p pattern display) return system)) (defun make-frame-on-display (display &optional parameters) "Make a frame on display DISPLAY. The optional argument PARAMETERS specifies additional frame parameters." (interactive "sMake frame on display: ") - (cond ((featurep 'ns) - (when (and (boundp 'ns-initialized) (not ns-initialized)) - (setq x-display-name display) - (ns-initialize-window-system)) - (make-frame `((window-system . ns) - (display . ,display) . ,parameters))) - ((eq system-type 'windows-nt) - ;; On Windows, ignore DISPLAY. - (make-frame parameters)) - (t - (unless (string-match-p "\\`[^:]*:[0-9]+\\(\\.[0-9]+\\)?\\'" display) - (error "Invalid display, not HOST:SERVER or HOST:SERVER.SCREEN")) - (when (and (boundp 'x-initialized) (not x-initialized)) - (setq x-display-name display) - (x-initialize-window-system)) - (make-frame `((window-system . x) - (display . ,display) . ,parameters))))) + (make-frame (cons (cons 'display display) parameters))) (declare-function x-close-connection "xfns.c" (terminal)) @@ -614,6 +612,8 @@ neither or both. (window-system . nil) The frame should be displayed on a terminal device. (window-system . x) The frame should be displayed in an X window. + (display . \":0\") The frame should appear on display :0. + (terminal . TERMINAL) The frame should use the terminal object TERMINAL. In addition, any parameter specified in `default-frame-alist', @@ -624,11 +624,15 @@ this function runs the hook `before-make-frame-hook'. After creating the frame, it runs the hook `after-make-frame-functions' with one arg, the newly created frame. +If a display parameter is supplied and a window-system is not, +guess the window-system from the display. + On graphical displays, this function does not itself make the new frame the selected frame. However, the window system may select the new frame according to its own rules." (interactive) - (let* ((w (cond + (let* ((display (cdr (assq 'display parameters))) + (w (cond ((assq 'terminal parameters) (let ((type (terminal-live-p (cdr (assq 'terminal parameters))))) (cond @@ -638,6 +642,10 @@ the new frame according to its own rules." (t type)))) ((assq 'window-system parameters) (cdr (assq 'window-system parameters))) + (display + (or (window-system-for-display display) + (error "Don't know how to interpret display \"%S\"" + display))) (t window-system))) (frame-creation-function (cdr (assq w frame-creation-function-alist))) (oldframe (selected-frame)) @@ -645,6 +653,11 @@ the new frame according to its own rules." frame) (unless frame-creation-function (error "Don't know how to create a frame on window system %s" w)) + + (unless (get w 'window-system-initialized) + (funcall (cdr (assq w window-system-initialization-alist))) + (put w 'window-system-initialized t)) + ;; Add parameters from `window-system-default-frame-alist'. (dolist (p (cdr (assq w window-system-default-frame-alist))) (unless (assq (car p) params) @@ -1048,15 +1061,25 @@ If FRAME is omitted, describe the currently selected frame." (pattern &optional face frame maximum width)) (define-obsolete-function-alias 'set-default-font 'set-frame-font "23.1") -(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'. - -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." + +(defun set-frame-font (font &optional keep-size frames) + "Set the default font to FONT. +When called interactively, prompt for the name of a font, and use +that font on the selected frame. When called from Lisp, FONT +should be a font name (a string), a font object, font entity, or +font spec. + +If KEEP-SIZE is nil, keep the number of frame lines and columns +fixed. If KEEP-SIZE is non-nil (or with a prefix argument), try +to keep the current frame size fixed (in pixels) by adjusting the +number of lines and columns. + +If FRAMES is nil, apply the font to the selected frame only. +If FRAMES is non-nil, it should be a list of frames to act upon, +or t meaning all graphical frames. Also, if FRAME is non-nil, +alter the user's Customization settings as though the +font-related attributes of the `default' face had been \"set in +this session\", so that the font is applied to future frames." (interactive (let* ((completion-ignore-case t) (font (completing-read "Font name: " @@ -1065,19 +1088,57 @@ pixels) is kept by adjusting the numbers of the lines and columns." (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)) + (list font current-prefix-arg nil))) + (when (or (stringp font) (fontp font)) + (let* ((this-frame (selected-frame)) + ;; FRAMES nil means affect the selected frame. + (frame-list (cond ((null frames) + (list this-frame)) + ((eq frames t) + (frame-list)) + (t frames))) + height width) + (dolist (f frame-list) + (when (display-multi-font-p f) + (if keep-size + (setq height (* (frame-parameter f 'height) + (frame-char-height f)) + width (* (frame-parameter f 'width) + (frame-char-width f)))) + ;; When set-face-attribute is called for :font, Emacs + ;; guesses the best font according to other face attributes + ;; (:width, :weight, etc.) so reset them too (Bug#2476). + (set-face-attribute 'default f + :width 'normal :weight 'normal + :slant 'normal :font font) + (if keep-size + (modify-frame-parameters + f + (list (cons 'height (round height (frame-char-height f))) + (cons 'width (round width (frame-char-width f)))))))) + (when frames + ;; Alter the user's Custom setting of the `default' face, but + ;; only for font-related attributes. + (let ((specs (cadr (assq 'user (get 'default 'theme-face)))) + (attrs '(:family :foundry :slant :weight :height :width)) + (new-specs nil)) + (if (null specs) (setq specs '((t nil)))) + (dolist (spec specs) + ;; Each SPEC has the form (DISPLAY ATTRIBUTE-PLIST) + (let ((display (nth 0 spec)) + (plist (copy-tree (nth 1 spec)))) + ;; Alter only DISPLAY conditions matching this frame. + (when (or (memq display '(t default)) + (face-spec-set-match-display display this-frame)) + (dolist (attr attrs) + (setq plist (plist-put plist attr + (face-attribute 'default attr))))) + (push (list display plist) new-specs))) + (setq new-specs (nreverse new-specs)) + (put 'default 'customized-face new-specs) + (custom-push-theme 'theme-face 'default 'user 'set new-specs) + (put 'default 'face-modified nil)))) + (run-hooks 'after-setting-font-hook 'after-setting-font-hooks))) (defun set-frame-parameter (frame parameter value) "Set frame parameter PARAMETER to VALUE on FRAME. @@ -1108,7 +1169,11 @@ To get the frame's current foreground color, use `frame-parameters'." (defun set-cursor-color (color-name) "Set the text cursor color of the selected frame to COLOR-NAME. When called interactively, prompt for the name of the color to use. -To get the frame's current cursor color, use `frame-parameters'." +This works by setting the `cursor-color' frame parameter on the +selected frame. + +You can also set the text cursor color, for all frames, by +customizing the `cursor' face." (interactive (list (read-color "Cursor color: "))) (modify-frame-parameters (selected-frame) (list (cons 'cursor-color color-name)))) @@ -1133,15 +1198,21 @@ To get the frame's current border color, use `frame-parameters'." (list (cons 'border-color color-name)))) (define-minor-mode auto-raise-mode - "Toggle whether or not the selected frame should auto-raise. + "Toggle whether or not selected frames should auto-raise. With a prefix argument ARG, enable Auto Raise mode if ARG is positive, and disable it otherwise. If called from Lisp, enable the mode if ARG is omitted or nil. -Note that this controls Emacs's own auto-raise feature. -Some window managers allow you to enable auto-raise for certain windows. -You can use that for Emacs windows if you wish, but if you do, -that is beyond the control of Emacs and this command has no effect on it." +Auto Raise mode does nothing under most window managers, which +switch focus on mouse clicks. It only has an effect if your +window manager switches focus on mouse movement (in which case +you should also change `focus-follows-mouse' to t). Then, +enabling Auto Raise mode causes any graphical Emacs frame which +acquires focus to be automatically raised. + +Note that this minor mode controls Emacs's own auto-raise +feature. Window managers that switch focus on mouse movement +often have their own auto-raise feature." :variable (frame-parameter nil 'auto-raise) (if (frame-parameter nil 'auto-raise) (raise-frame))) @@ -1152,17 +1223,23 @@ With a prefix argument ARG, enable Auto Lower mode if ARG is positive, and disable it otherwise. If called from Lisp, enable the mode if ARG is omitted or nil. -Note that this controls Emacs's own auto-lower feature. -Some window managers allow you to enable auto-lower for certain windows. -You can use that for Emacs windows if you wish, but if you do, -that is beyond the control of Emacs and this command has no effect on it." +Auto Lower mode does nothing under most window managers, which +switch focus on mouse clicks. It only has an effect if your +window manager switches focus on mouse movement (in which case +you should also change `focus-follows-mouse' to t). Then, +enabling Auto Lower Mode causes any graphical Emacs frame which +loses focus to be automatically lowered. + +Note that this minor mode controls Emacs's own auto-lower +feature. Window managers that switch focus on mouse movement +often have their own features for raising or lowering frames." :variable (frame-parameter nil 'auto-lower)) (defun set-frame-name (name) "Set the name of the selected frame to NAME. When called interactively, prompt for the name of the frame. -The frame name is displayed on the modeline if the terminal displays only -one frame, otherwise the name is displayed on the frame's caption bar." +On text terminals, the frame name is displayed on the mode line. +On graphical displays, it is displayed on the frame's title bar." (interactive "sFrame name: ") (modify-frame-parameters (selected-frame) (list (cons 'name name)))) @@ -1194,7 +1271,7 @@ frame's display)." (cond ((eq frame-type 'pc) (msdos-mouse-p)) - ((eq system-type 'windows-nt) + ((eq frame-type 'w32) (with-no-warnings (> w32-num-mouse-buttons 0))) ((memq frame-type '(x ns)) @@ -1491,21 +1568,6 @@ left untouched. FRAME nil or omitted means use the selected frame." 'delete-frame-functions "22.1") -;; Highlighting trailing whitespace. - -(make-variable-buffer-local 'show-trailing-whitespace) - - -;; Scrolling - -(defgroup scrolling nil - "Scrolling windows." - :version "21.1" - :group 'frames) - -(defvaralias 'automatic-hscrolling 'auto-hscroll-mode) - - ;; Blinking cursor (defgroup cursor nil @@ -1561,6 +1623,8 @@ itself as a pre-command hook." (cancel-timer blink-cursor-timer) (setq blink-cursor-timer nil))) +(define-obsolete-variable-alias 'blink-cursor 'blink-cursor-mode "22.1") + (define-minor-mode blink-cursor-mode "Toggle cursor blinking (Blink Cursor mode). With a prefix argument ARG, enable Blink Cursor mode if ARG is @@ -1587,8 +1651,6 @@ terminals, cursor blinking is controlled by the terminal." blink-cursor-delay 'blink-cursor-start)))) -(define-obsolete-variable-alias 'blink-cursor 'blink-cursor-mode "22.1") - ;;;; Key bindings @@ -1597,6 +1659,19 @@ terminals, cursor blinking is controlled by the terminal." (define-key ctl-x-5-map "0" 'delete-frame) (define-key ctl-x-5-map "o" 'other-frame) + +;; Misc. + +;; Only marked as obsolete in 24.3. +(define-obsolete-variable-alias 'automatic-hscrolling + 'auto-hscroll-mode "22.1") + +(make-variable-buffer-local 'show-trailing-whitespace) + +;; Defined in dispnew.c. +(make-obsolete-variable + 'window-system-version "it does not give useful information." "24.3") + (provide 'frame) ;;; frame.el ends here