lisp/dynamic-setting.el

   1 ;;; dynamic-setting.el --- Support dynamic changes
   2
   3 ;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
   4
   5 ;; Author: Jan Djärv <jan.h.d@swipnet.se>
   6 ;; Maintainer: FSF
   7 ;; Keywords: font, system-font, tool-bar-style
   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 ;; This file provides the lisp part of the GConf and XSetting code in
  28 ;; xsetting.c.  But it is nothing that prevents it from being used by
  29 ;; other configuration schemes.
  30
  31 ;;; Code:
  32
  33 ;;; Customizable variables
  34
  35 (declare-function font-get-system-font "xsettings.c" ())
  36
  37 (defvar font-use-system-font)
  38
  39 (defun font-setting-change-default-font (display-or-frame set-font)
  40   "Change font and/or font settings for frames on display DISPLAY-OR-FRAME.
  41 If DISPLAY-OR-FRAME is a frame, the display is the one for that frame.
  42
  43 If SET-FONT is non-nil, change the font for frames.  Otherwise re-apply the
  44 current form for the frame (i.e. hinting or somesuch changed)."
  45
  46   (let ((new-font (and (fboundp 'font-get-system-font)
  47                        (font-get-system-font))))
  48     (when new-font
  49       ;; Be careful here: when set-face-attribute is called for the
  50       ;; :font attribute, Emacs tries to guess the best matching font
  51       ;; by examining the other face attributes (Bug#2476).
  52
  53       (clear-font-cache)
  54       ;; Set for current frames. Only change font for those that have
  55       ;; the old font now. If they don't have the old font, the user
  56       ;; probably changed it.
  57       (dolist (f (frames-on-display-list display-or-frame))
  58         (if (display-graphic-p f)
  59             (let* ((frame-font
  60                     (or (font-get (face-attribute 'default :font f
  61                                                   'default) :user-spec)
  62                         (frame-parameter f 'font-parameter)))
  63                    (font-to-set
  64                     (if set-font new-font
  65                       ;; else set font again, hinting etc. may have changed.
  66                       frame-font)))
  67               (if font-to-set
  68                   (progn
  69                     (set-frame-parameter f 'font-parameter font-to-set)
  70                     (set-face-attribute 'default f
  71                                         :width 'normal
  72                                         :weight 'normal
  73                                         :slant 'normal
  74                                         :font font-to-set))))))
  75
  76       ;; Set for future frames.
  77       (set-face-attribute 'default t :font new-font)
  78       (let ((spec (list (list t (face-attr-construct 'default)))))
  79         (progn
  80           (put 'default 'customized-face spec)
  81           (custom-push-theme 'theme-face 'default 'user 'set spec)
  82           (put 'default 'face-modified nil))))))
  83
  84 (defun dynamic-setting-handle-config-changed-event (event)
  85   "Handle config-changed-event on the display in EVENT.
  86 Changes can be
  87   The monospace font. If `font-use-system-font' is nil, the font
  88     is not changed.
  89   Xft parameters, like DPI and hinting.
  90   The tool bar style."
  91   (interactive "e")
  92   (let ((type (nth 1 event))
  93         (display-name (nth 2 event)))
  94     (cond ((and (eq type 'monospace-font-name) font-use-system-font)
  95            (font-setting-change-default-font display-name t))
  96
  97           ((eq type 'font-render)
  98            (font-setting-change-default-font display-name nil))
  99
 100           ;; This is a bit heavy, ideally we would just clear faces
 101           ;; on the affected display, and perhaps only the relevant
 102           ;; faces.  Oh well.
 103           ((eq type 'theme-name) (clear-face-cache))
 104
 105           ((eq type 'tool-bar-style) (force-mode-line-update t)))))
 106
 107 (define-key special-event-map [config-changed-event]
 108   'dynamic-setting-handle-config-changed-event)
 109