X-Git-Url: http://git.chise.org/gitweb/?p=chise%2Fxemacs-chise.git.1;a=blobdiff_plain;f=lisp%2Fx-faces.el;h=aabfe87a238cc28c3d7316325ee409febc76a4b1;hp=21895c349524af5f5a21ae4506354a084b2d9f48;hb=98a6e4055a1fa624c592ac06f79287d55196ca37;hpb=6883ee56ec887c2c48abe5b06b5e66aa74031910 diff --git a/lisp/x-faces.el b/lisp/x-faces.el index 21895c3..aabfe87 100644 --- a/lisp/x-faces.el +++ b/lisp/x-faces.el @@ -3,7 +3,7 @@ ;; Copyright (C) 1992-4, 1997 Free Software Foundation, Inc. ;; Copyright (C) 1995, 1996 Ben Wing. -;; Author: Jamie Zawinski +;; Author: Jamie Zawinski ;; Maintainer: XEmacs Development Team ;; Keywords: extensions, internal, dumped @@ -101,41 +101,38 @@ (encoding "[^-]+") ; false! ) (setq x-font-regexp - (purecopy - (concat "\\`\\*?[-?*]" - foundry - family - weight\? - slant\? - swidth - adstyle - - pixelsize - pointsize - resx - resy - spacing - avgwidth - - registry - encoding "\\'" - ))) + (concat "\\`\\*?[-?*]" + foundry - family - weight\? - slant\? - swidth - adstyle - + pixelsize - pointsize - resx - resy - spacing - avgwidth - + registry - encoding "\\'" + )) (setq x-font-regexp-head - (purecopy - (concat "\\`[-?*]" foundry - family - weight\? - slant\? - "\\([-*?]\\|\\'\\)"))) + (concat "\\`[-?*]" foundry - family - weight\? - slant\? + "\\([-*?]\\|\\'\\)")) (setq x-font-regexp-head-2 - (purecopy - (concat "\\`[-?*]" foundry - family - weight\? - slant\? - - swidth - adstyle - pixelsize - pointsize - "\\([-*?]\\|\\'\\)"))) - (setq x-font-regexp-slant (purecopy (concat - slant -))) - (setq x-font-regexp-weight (purecopy (concat - weight -))) + (concat "\\`[-?*]" foundry - family - weight\? - slant\? + - swidth - adstyle - pixelsize - pointsize + "\\([-*?]\\|\\'\\)")) + (setq x-font-regexp-slant (concat - slant -)) + (setq x-font-regexp-weight (concat - weight -)) ;; if we can't match any of the more specific regexps (unfortunate) then ;; look for digits; assume 2+ digits is 10ths of points, and 1-2 digits ;; is pixels. Bogus as hell. - (setq x-font-regexp-pixel (purecopy "[-?*]\\([0-9][0-9]?\\)[-?*]")) - (setq x-font-regexp-point (purecopy "[-?*]\\([0-9][0-9]+\\)[-?*]")) + (setq x-font-regexp-pixel "[-?*]\\([0-9][0-9]?\\)[-?*]") + (setq x-font-regexp-point "[-?*]\\([0-9][0-9]+\\)[-?*]") ;; the following two are used by x-font-menu.el. (setq x-font-regexp-foundry-and-family - (purecopy (concat "\\`[-?*]" foundry - "\\(" family "\\)" -))) + (concat "\\`[-?*]" foundry - "\\(" family "\\)" -)) (setq x-font-regexp-registry-and-encoding - (purecopy (concat - "\\(" registry "\\)" - "\\(" encoding "\\)\\'"))) + (concat - "\\(" registry "\\)" - "\\(" encoding "\\)\\'")) (setq x-font-regexp-spacing - (purecopy (concat - "\\(" spacing "\\)" - avgwidth - - registry - encoding "\\'"))) + (concat - "\\(" spacing "\\)" - avgwidth + - registry - encoding "\\'")) ) ;; A "loser font" is something like "8x13" -> "8x13bold". ;; These are supported only through extreme generosity. -(defconst x-loser-font-regexp (purecopy "\\`[0-9]+x[0-9]+\\'")) +(defconst x-loser-font-regexp "\\`[0-9]+x[0-9]+\\'") (defun x-frob-font-weight (font which) (if (font-instance-p font) (setq font (font-instance-name font))) @@ -176,18 +173,19 @@ If it fails, it returns nil." If it fails, it returns nil." (try-font-name (x-frob-font-weight font "medium") device)) -(defcustom *try-oblique-before-italic-fonts* nil +(defcustom try-oblique-before-italic-fonts nil "*If nil, italic fonts are searched before oblique fonts. If non-nil, oblique fonts are tried before italic fonts. This is mostly applicable to adobe-courier fonts" :type 'boolean - :tag "Try Oblique Before Italic Fonts" :group 'x) +(define-obsolete-variable-alias '*try-oblique-before-italic-fonts* + 'try-oblique-before-italic-fonts) (defun x-make-font-italic (font &optional device) "Given an X font specification, this attempts to make an `italic' font. If it fails, it returns nil." - (if *try-oblique-before-italic-fonts* + (if try-oblique-before-italic-fonts (or (try-font-name (x-frob-font-slant font "o") device) (try-font-name (x-frob-font-slant font "i") device)) (or (try-font-name (x-frob-font-slant font "i") device) @@ -202,18 +200,31 @@ If it fails, it returns nil." "Given an X font specification, this attempts to make a `bold-italic' font. If it fails, it returns nil." ;; This is haired up to avoid loading the "intermediate" fonts. - (or (try-font-name - (x-frob-font-slant (x-frob-font-weight font "bold") "i") device) - (try-font-name - (x-frob-font-slant (x-frob-font-weight font "bold") "o") device) - (try-font-name - (x-frob-font-slant (x-frob-font-weight font "black") "i") device) - (try-font-name - (x-frob-font-slant (x-frob-font-weight font "black") "o") device) - (try-font-name - (x-frob-font-slant (x-frob-font-weight font "demibold") "i") device) - (try-font-name - (x-frob-font-slant (x-frob-font-weight font "demibold") "o") device))) + (if try-oblique-before-italic-fonts + (or (try-font-name + (x-frob-font-slant (x-frob-font-weight font "bold") "o") device) + (try-font-name + (x-frob-font-slant (x-frob-font-weight font "bold") "i") device) + (try-font-name + (x-frob-font-slant (x-frob-font-weight font "black") "o") device) + (try-font-name + (x-frob-font-slant (x-frob-font-weight font "black") "i") device) + (try-font-name + (x-frob-font-slant (x-frob-font-weight font "demibold") "o") device) + (try-font-name + (x-frob-font-slant (x-frob-font-weight font "demibold") "i") device)) + (or (try-font-name + (x-frob-font-slant (x-frob-font-weight font "bold") "i") device) + (try-font-name + (x-frob-font-slant (x-frob-font-weight font "bold") "o") device) + (try-font-name + (x-frob-font-slant (x-frob-font-weight font "black") "i") device) + (try-font-name + (x-frob-font-slant (x-frob-font-weight font "black") "o") device) + (try-font-name + (x-frob-font-slant (x-frob-font-weight font "demibold") "i") device) + (try-font-name + (x-frob-font-slant (x-frob-font-weight font "demibold") "o") device)))) (defun x-font-size (font) "Return the nominal size of the given font. @@ -478,11 +489,13 @@ Otherwise, it returns the next larger version of this font that is defined." (or (null locale) (eq locale 'global))) (progn (or fn (setq fn (x-get-resource - "font" "Font" 'string locale))) + "font" "Font" 'string locale nil 'warn))) (or fg (setq fg (x-get-resource - "foreground" "Foreground" 'string locale))) + "foreground" "Foreground" 'string locale nil + 'warn))) (or bg (setq bg (x-get-resource - "background" "Background" 'string locale))))) + "background" "Background" 'string locale nil + 'warn))))) ;; ;; "*cursorColor: foo" is equivalent to setting the background of the ;; text-cursor face. @@ -490,7 +503,8 @@ Otherwise, it returns the next larger version of this font that is defined." (if (and (eq (face-name face) 'text-cursor) (or (null locale) (eq locale 'global))) (setq bg (or (x-get-resource - "cursorColor" "CursorColor" 'string locale) bg))) + "cursorColor" "CursorColor" 'string locale nil 'warn) + bg))) ;; #### should issue warnings? I think this should be ;; done when the instancing actually happens, but I'm not ;; sure how it should actually be dealt with. @@ -506,7 +520,7 @@ Otherwise, it returns the next larger version of this font that is defined." ;; globally. This means we should override global ;; defaults for all X device classes. (remove-specifier (face-font face) locale x-tag-set nil)) - (set-face-font face fn locale nil append)) + (set-face-font face fn locale 'x append)) ;; Kludge-o-rooni. Set the foreground and background resources for ;; X devices only -- otherwise things tend to get all messed up ;; if you start up an X frame and then later create a TTY frame. @@ -602,12 +616,12 @@ Otherwise, it returns the next larger version of this font that is defined." (defun x-init-global-faces () (or (face-font 'default 'global) (set-face-font 'default - "-*-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-*") - 'global) + "-*-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-*" + 'global '(x default))) (or (face-foreground 'default 'global) - (set-face-foreground 'default "black" 'global 'x)) + (set-face-foreground 'default "black" 'global '(x default))) (or (face-background 'default 'global) - (set-face-background 'default "gray80" 'global 'x))) + (set-face-background 'default "gray80" 'global '(x default)))) ;;; x-init-device-faces is responsible for initializing default ;;; values for faces on a newly created device. @@ -721,7 +735,8 @@ Otherwise, it returns the next larger version of this font that is defined." ;; If reverseVideo was specified, swap the foreground and background ;; of the default and modeline faces. ;; - (cond ((car (x-get-resource "reverseVideo" "ReverseVideo" 'boolean frame)) + (cond ((car (x-get-resource "reverseVideo" "ReverseVideo" 'boolean frame + nil 'warn)) ;; First make sure the modeline has fg and bg, inherited from the ;; current default face - for the case where only one is specified, ;; so that invert-face doesn't do something weird.