;; Copyright (C) 1992-4, 1997 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996 Ben Wing.
-;; Author: Jamie Zawinski <jwz@netscape.com>
+;; Author: Jamie Zawinski <jwz@jwz.org>
;; Maintainer: XEmacs Development Team
;; Keywords: extensions, internal, dumped
(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)))
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)
"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.
(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.
(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.
(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.
;; 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.
projects / chise / xemacs-chise.git.1 / blobdiff