Mercurial > hg > xemacs-beta

comparison lisp/prim/faces.el @ 2:ac2d302a0011 r19-15b2

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b2
author cvs
date Mon, 13 Aug 2007 08:46:35 +0200
parents 376386a54a3c
children bcdc7deadc19
comparison
equal deleted inserted replaced
1:c0c6a60d29db 2:ac2d302a0011
39 39
40 (defun read-face-name (prompt) 40 (defun read-face-name (prompt)
41 (let (face) 41 (let (face)
42 (while (= (length face) 0) ; nil or "" 42 (while (= (length face) 0) ; nil or ""
43 (setq face (completing-read prompt 43 (setq face (completing-read prompt
44 (mapcar '(lambda (x) (list (symbol-name x))) 44 (mapcar (lambda (x) (list (symbol-name x)))
45 (face-list)) 45 (face-list))
46 nil t))) 46 nil t)))
47 (intern face))) 47 (intern face)))
48 48
49 (defun face-interactive (what &optional bool) 49 (defun face-interactive (what &optional bool)
695 (face-property-equal face1 face2 (car props) domain)) 695 (face-property-equal face1 face2 (car props) domain))
696 (setq props (cdr props))) 696 (setq props (cdr props)))
697 (null props)) 697 (null props))
698 698
699 (defun face-equal (face1 face2 &optional domain) 699 (defun face-equal (face1 face2 &optional domain)
700 "True if the given faces will display in the the same way. 700 "True if the given faces will display in the same way.
701 See `face-property-instance' for the semantics of the DOMAIN argument." 701 See `face-property-instance' for the semantics of the DOMAIN argument."
702 (if (null domain) (setq domain (selected-window))) 702 (if (null domain) (setq domain (selected-window)))
703 (if (not (valid-specifier-domain-p domain)) 703 (if (not (valid-specifier-domain-p domain))
704 (error "Invalid specifier domain")) 704 (error "Invalid specifier domain"))
705 (let ((device (dfw-device domain)) 705 (let ((device (dfw-device domain))
1165 ; "Whether to suppress complaints about incomplete sets of fonts.") 1165 ; "Whether to suppress complaints about incomplete sets of fonts.")
1166 1166
1167 (defun face-complain-about-font (face device) 1167 (defun face-complain-about-font (face device)
1168 (if (symbolp face) (setq face (symbol-name face))) 1168 (if (symbolp face) (setq face (symbol-name face)))
1169 ;; (if (not inhibit-font-complaints) 1169 ;; (if (not inhibit-font-complaints)
1170 (display-warning 1170 (display-warning
1171 'font 1171 'font
1172 (format "%s: couldn't deduce %s %s version of %S\n" 1172 (let ((default-name (face-font-name 'default device)))
1173 invocation-name 1173 (format "%s: couldn't deduce %s %s version of the font
1174 (if (string-match "\\`[aeiouAEIOU]" face) "an" "a") 1174 %S.
1175 face 1175
1176 (face-font-name 'default device))) 1176 Please specify X resources to make the %s face
1177 ;; ) 1177 visually distinguishable from the default face.
1178 ) 1178 For example, you could add one of the following to $HOME/Emacs:
1179
1180 Emacs.%s.attributeFont: -dt-*-medium-i-*
1181 or
1182 Emacs.%s.attributeForeground: hotpink\n"
1183 invocation-name
1184 (if (string-match "\\`[aeiouAEIOU]" face) "an" "a")
1185 face
1186 default-name
1187 face
1188 face
1189 face
1190 ))))
1179 1191
1180 (defun init-other-random-faces (device) 1192 (defun init-other-random-faces (device)
1181 "Initializes the colors and fonts of the bold, italic, bold-italic, 1193 "Initializes the colors and fonts of the bold, italic, bold-italic,
1182 zmacs-region, list-mode-item-selected, highlight, primary-selection, 1194 zmacs-region, list-mode-item-selected, highlight, primary-selection,
1183 secondary-selection, and isearch faces when each device is created. If 1195 secondary-selection, and isearch faces when each device is created. If
1196 ;; similar for italic. 1208 ;; similar for italic.
1197 (or (face-differs-from-default-p 'italic device) 1209 (or (face-differs-from-default-p 'italic device)
1198 (make-face-italic 'italic device)) 1210 (make-face-italic 'italic device))
1199 (or (face-differs-from-default-p 'italic device) 1211 (or (face-differs-from-default-p 'italic device)
1200 (progn 1212 (progn
1201 (make-face-bold 'bold device) ; bold if possible, then complain 1213 (make-face-bold 'italic device) ; bold if possible, then complain
1202 (face-complain-about-font 'italic device))) 1214 (face-complain-about-font 'italic device)))
1203 1215
1204 ;; similar for bold-italic. 1216 ;; similar for bold-italic.
1205 (or (face-differs-from-default-p 'bold-italic device) 1217 (or (face-differs-from-default-p 'bold-italic device)
1206 (make-face-bold-italic 'bold-italic device)) 1218 (make-face-bold-italic 'bold-italic device))