;; This file is dumped with XEmacs.
;; face implementation #1 (used Lisp vectors and parallel C vectors;
-;; FSFmacs still uses this) authored by Jamie Zawinski <jwz@netscape.com>
+;; FSFmacs still uses this) authored by Jamie Zawinski <jwz@jwz.org>
;; pre Lucid-Emacs 19.0.
;; face implementation #2 (used one face object per frame per face)
;; happen if that locale has no instantiators. So signal
;; an error to indicate this.
- (setq temp-sp
- (if (and (or (eq locale 'global) (eq locale 'all) (not locale))
- (not (face-property face property 'global)))
- (copy-specifier (face-property 'default property)
- nil 'global)
- sp))
+
+ (setq temp-sp (copy-specifier sp))
+ (if (and (or (eq locale 'global) (eq locale 'all) (not locale))
+ (not (face-property face property 'global)))
+ (copy-specifier (face-property 'default property)
+ temp-sp 'global))
(if (and (valid-specifier-locale-p locale)
(not (specifier-specs temp-sp locale)))
(error "Property must have a specification in locale %S" locale))
(get-custom-frame-properties frame))
(initialize-custom-faces frame)))
+(defun startup-initialize-custom-faces ()
+ "Reset faces created by defface. Only called at startup.
+Don't use this function in your program."
+ (when default-custom-frame-properties
+ ;; Reset default value to the actual frame, not stream.
+ (setq default-custom-frame-properties
+ (extract-custom-frame-properties (selected-frame)))
+ ;; like initialize-custom-faces but removes property first.
+ (mapc (lambda (symbol)
+ (let ((spec (or (get symbol 'saved-face)
+ (get symbol 'face-defface-spec))))
+ (when spec
+ ;; Reset faces created during auto-autoloads loading.
+ (reset-face symbol)
+ ;; And set it according to the spec.
+ (face-display-set symbol spec nil))))
+ (face-list))))
+
\f
(defun make-empty-face (name &optional doc-string temporary)
"Like `make-face', but doesn't query the resource database."
(mswindows-init-device-faces device))
;; Nothing to do for TTYs?
)
- (init-other-random-faces device)))
+ (or (eq 'stream (device-type device))
+ (init-other-random-faces device))))
(defun init-frame-faces (frame)
(when init-face-from-resources
;; It's unreasonable to expect to be able to make a font italic all
;; the time. For many languages, italic is an alien concept.
;; Basically, because italic is not a globally meaningful concept,
- ;; the use of the italic face should really be oboleted.
+ ;; the use of the italic face should really be obsoleted.
;; I disagree with above. In many languages, the concept of capital
;; letters is just as alien, and yet we use them. Italic is here to
nil 'append))
)
-;; New function with 20.1, suggested by Per Abrahamsen, coded by Kyle Jones.
+;; New function with 20.1, suggested by Per Abrahamsen, coded by Kyle
+;; Jones and Hrvoje Niksic.
(defun set-face-stipple (face pixmap &optional frame)
"Change the stipple pixmap of FACE to PIXMAP.
This is an Emacs compatibility function; consider using
set-face-background-pixmap instead.
PIXMAP should be a string, the name of a file of pixmap data.
-The directories listed in the `x-bitmap-file-path' variable are searched.
+The directories listed in the variables `x-bitmap-file-path' and
+`mswindows-bitmap-file-path' under X and MS Windows respectively
+are searched.
Alternatively, PIXMAP may be a list of the form (WIDTH HEIGHT
DATA) where WIDTH and HEIGHT are the size in pixels, and DATA is
in that frame; otherwise change each frame."
(while (not (find-face face))
(setq face (signal 'wrong-type-argument (list 'facep face))))
- (locate-file pixmap x-bitmap-file-path '(".xbm" ""))
- (while (cond ((stringp pixmap)
- (unless (file-readable-p pixmap)
- (setq pixmap `[xbm :file ,pixmap]))
- nil)
- ((and (consp pixmap) (= (length pixmap) 3))
- (setq pixmap `[xbm :data ,pixmap])
- nil)
- (t t))
- (setq pixmap (signal 'wrong-type-argument
- (list 'stipple-pixmap-p pixmap))))
- (while (and frame (not (framep frame)))
- (setq frame (signal 'wrong-type-argument (list 'framep frame))))
- (set-face-background-pixmap face pixmap frame))
+ (let ((bitmap-path (ecase (console-type)
+ (x x-bitmap-file-path)
+ (mswindows mswindows-bitmap-file-path)))
+ instantiator)
+ (while
+ (null
+ (setq instantiator
+ (cond ((stringp pixmap)
+ (let ((file (if (file-name-absolute-p pixmap)
+ pixmap
+ (locate-file pixmap bitmap-path
+ '(".xbm" "")))))
+ (and file
+ `[xbm :file ,file])))
+ ((and (listp pixmap) (= (length pixmap) 3))
+ `[xbm :data ,pixmap])
+ (t nil))))
+ ;; We're signaling a continuable error; let's make sure the
+ ;; function `stipple-pixmap-p' at least exists.
+ (flet ((stipple-pixmap-p (pixmap)
+ (or (stringp pixmap)
+ (and (listp pixmap) (= (length pixmap) 3)))))
+ (setq pixmap (signal 'wrong-type-argument
+ (list 'stipple-pixmap-p pixmap)))))
+ (while (and frame (not (framep frame)))
+ (setq frame (signal 'wrong-type-argument (list 'framep frame))))
+ (set-face-background-pixmap face instantiator frame)))
\f
;; Create the remaining standard faces now. This way, packages that we dump
(set-face-underline-p 'underline t 'global '(default)))
(make-face 'zmacs-region "Used on highlightes region between point and mark.")
(make-face 'isearch "Used on region matched by isearch.")
+(make-face 'isearch-secondary "Face to use for highlighting all matches.")
(make-face 'list-mode-item-selected
"Face for the selected list item in list-mode.")
(make-face 'highlight "Highlight face.")
((mswindows default color) . "green"))
'global)
+;; #### This should really, I mean *really*, be converted to some form
+;; of `defface' one day.
+(set-face-foreground 'isearch-secondary
+ '(((x default color) . "red3")
+ ((mswindows default color) . "red3"))
+ 'global)
+
;; Define some logical color names to be used when reading the pixmap files.
(if (featurep 'xpm)
(setq xpm-color-symbols
projects / chise / xemacs-chise.git / blobdiff