Mercurial > emacs
comparison lisp/faces.el @ 98469:b47418363c13
(inhibit-frame-set-background-mode): New var.
(frame-set-background-mode): Use it to avoid a loop in face-spec-recalc.
| author | Chong Yidong <cyd@stupidchicken.com> |
|---|---|
| date | Thu, 02 Oct 2008 20:19:24 +0000 |
| parents | 738bf2e7b7f5 |
| children | 44958ed3a501 |
comparison
equal
deleted
inserted
replaced
| 98468:bc63ca36bd15 | 98469:b47418363c13 |
|---|---|
| 1837 | 1837 |
| 1838 | 1838 |
| 1839 (declare-function x-get-resource "frame.c" | 1839 (declare-function x-get-resource "frame.c" |
| 1840 (attribute class &optional component subclass)) | 1840 (attribute class &optional component subclass)) |
| 1841 | 1841 |
| 1842 (defvar inhibit-frame-set-background-mode nil) | |
| 1843 | |
| 1842 (defun frame-set-background-mode (frame) | 1844 (defun frame-set-background-mode (frame) |
| 1843 "Set up display-dependent faces on FRAME. | 1845 "Set up display-dependent faces on FRAME. |
| 1844 Display-dependent faces are those which have different definitions | 1846 Display-dependent faces are those which have different definitions |
| 1845 according to the `background-mode' and `display-type' frame parameters." | 1847 according to the `background-mode' and `display-type' frame parameters." |
| 1846 (let* ((bg-resource | 1848 (unless inhibit-frame-set-background-mode |
| 1847 (and (window-system frame) | 1849 (let* ((bg-resource |
| 1848 (x-get-resource "backgroundMode" "BackgroundMode"))) | 1850 (and (window-system frame) |
| 1849 (bg-color (frame-parameter frame 'background-color)) | 1851 (x-get-resource "backgroundMode" "BackgroundMode"))) |
| 1850 (terminal-bg-mode (terminal-parameter frame 'background-mode)) | 1852 (bg-color (frame-parameter frame 'background-color)) |
| 1851 (tty-type (tty-type frame)) | 1853 (terminal-bg-mode (terminal-parameter frame 'background-mode)) |
| 1852 (bg-mode | 1854 (tty-type (tty-type frame)) |
| 1853 (cond (frame-background-mode) | 1855 (bg-mode |
| 1854 (bg-resource | 1856 (cond (frame-background-mode) |
| 1855 (intern (downcase bg-resource))) | 1857 (bg-resource (intern (downcase bg-resource))) |
| 1856 (terminal-bg-mode) | 1858 (terminal-bg-mode) |
| 1857 ((and (null (window-system frame)) | 1859 ((and (null (window-system frame)) |
| 1858 ;; Unspecified frame background color can only | 1860 ;; Unspecified frame background color can only |
| 1859 ;; happen on tty's. | 1861 ;; happen on tty's. |
| 1860 (member bg-color '(nil unspecified "unspecified-bg"))) | 1862 (member bg-color '(nil unspecified "unspecified-bg"))) |
| 1861 ;; There is no way to determine the background mode | 1863 ;; There is no way to determine the background mode |
| 1862 ;; automatically, so we make a guess based on the | 1864 ;; automatically, so we make a guess based on the |
| 1863 ;; terminal type. | 1865 ;; terminal type. |
| 1864 (if (and tty-type | 1866 (if (and tty-type |
| 1865 (string-match "^\\(xterm\\|rxvt\\|dtterm\\|eterm\\)" | 1867 (string-match "^\\(xterm\\|rxvt\\|dtterm\\|eterm\\)" |
| 1866 tty-type)) | 1868 tty-type)) |
| 1867 'light | 1869 'light |
| 1868 'dark)) | 1870 'dark)) |
| 1869 ((equal bg-color "unspecified-fg") ; inverted colors | 1871 ((equal bg-color "unspecified-fg") ; inverted colors |
| 1870 (if (and tty-type | 1872 (if (and tty-type |
| 1871 (string-match "^\\(xterm\\|rxvt\\|dtterm\\|eterm\\)" | 1873 (string-match "^\\(xterm\\|rxvt\\|dtterm\\|eterm\\)" |
| 1872 tty-type)) | 1874 tty-type)) |
| 1873 'dark | 1875 'dark |
| 1874 'light)) | 1876 'light)) |
| 1875 ((>= (apply '+ (color-values bg-color frame)) | 1877 ((>= (apply '+ (color-values bg-color frame)) |
| 1876 ;; Just looking at the screen, colors whose | 1878 ;; Just looking at the screen, colors whose |
| 1877 ;; values add up to .6 of the white total | 1879 ;; values add up to .6 of the white total |
| 1878 ;; still look dark to me. | 1880 ;; still look dark to me. |
| 1879 (* (apply '+ (color-values "white" frame)) .6)) | 1881 (* (apply '+ (color-values "white" frame)) .6)) |
| 1880 'light) | 1882 'light) |
| 1881 (t 'dark))) | 1883 (t 'dark))) |
| 1882 (display-type | 1884 (display-type |
| 1883 (cond ((null (window-system frame)) | 1885 (cond ((null (window-system frame)) |
| 1884 (if (tty-display-color-p frame) 'color 'mono)) | 1886 (if (tty-display-color-p frame) 'color 'mono)) |
| 1885 ((display-color-p frame) | 1887 ((display-color-p frame) |
| 1886 'color) | 1888 'color) |
| 1887 ((x-display-grayscale-p frame) | 1889 ((x-display-grayscale-p frame) |
| 1888 'grayscale) | 1890 'grayscale) |
| 1889 (t 'mono))) | 1891 (t 'mono))) |
| 1890 (old-bg-mode | 1892 (old-bg-mode |
| 1891 (frame-parameter frame 'background-mode)) | 1893 (frame-parameter frame 'background-mode)) |
| 1892 (old-display-type | 1894 (old-display-type |
| 1893 (frame-parameter frame 'display-type))) | 1895 (frame-parameter frame 'display-type))) |
| 1894 | 1896 |
| 1895 (unless (and (eq bg-mode old-bg-mode) (eq display-type old-display-type)) | 1897 (unless (and (eq bg-mode old-bg-mode) (eq display-type old-display-type)) |
| 1896 (let ((locally-modified-faces nil)) | 1898 (let ((locally-modified-faces nil) |
| 1897 ;; Before modifying the frame parameters, we collect a list of | 1899 ;; Prevent face-spec-recalc from calling this function |
| 1898 ;; faces that don't match what their face-spec says they should | 1900 ;; again, resulting in a loop (bug#911). |
| 1899 ;; look like; we then avoid changing these faces below. | 1901 (inhibit-frame-set-background-mode t)) |
| 1900 ;; These are the faces whose attributes were modified on FRAME. | 1902 ;; Before modifying the frame parameters, collect a list of |
| 1901 ;; We use a negative list on the assumption that most faces will | 1903 ;; faces that don't match what their face-spec says they |
| 1902 ;; be unmodified, so we can avoid consing in the common case. | 1904 ;; should look like. We then avoid changing these faces |
| 1903 (dolist (face (face-list)) | 1905 ;; below. These are the faces whose attributes were |
| 1904 (and (not (get face 'face-override-spec)) | 1906 ;; modified on FRAME. We use a negative list on the |
| 1905 (not (face-spec-match-p face | 1907 ;; assumption that most faces will be unmodified, so we can |
| 1906 (face-user-default-spec face) | 1908 ;; avoid consing in the common case. |
| 1907 (selected-frame))) | 1909 (dolist (face (face-list)) |
| 1908 (push face locally-modified-faces))) | 1910 (and (not (get face 'face-override-spec)) |
| 1909 ;; Now change to the new frame parameters | 1911 (not (face-spec-match-p face |
| 1910 (modify-frame-parameters frame | 1912 (face-user-default-spec face) |
| 1911 (list (cons 'background-mode bg-mode) | 1913 (selected-frame))) |
| 1912 (cons 'display-type display-type))) | 1914 (push face locally-modified-faces))) |
| 1913 ;; For all named faces, choose face specs matching the new frame | 1915 ;; Now change to the new frame parameters |
| 1914 ;; parameters, unless they have been locally modified. | 1916 (modify-frame-parameters frame |
| 1915 (dolist (face (face-list)) | 1917 (list (cons 'background-mode bg-mode) |
| 1916 (unless (memq face locally-modified-faces) | 1918 (cons 'display-type display-type))) |
| 1917 (face-spec-recalc face frame))))))) | 1919 ;; For all named faces, choose face specs matching the new frame |
| 1920 ;; parameters, unless they have been locally modified. | |
| 1921 (dolist (face (face-list)) | |
| 1922 (unless (memq face locally-modified-faces) | |
| 1923 (face-spec-recalc face frame)))))))) | |
| 1918 | 1924 |
| 1919 | 1925 |
| 1920 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 1926 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 1921 ;;; Frame creation. | 1927 ;;; Frame creation. |
| 1922 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 1928 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |