X-Git-Url: http://git.chise.org/gitweb/?p=chise%2Fxemacs-chise.git.1;a=blobdiff_plain;f=lisp%2Ffaces.el;h=a4f56eadda4bff5ac38cdaf92dcc3939e6398754;hp=d149cb03d2fffe95e366a8a7488b6fb2ae78f2f1;hb=9f7593526f487e8b5272d5aa2a72facbf121b23e;hpb=76759ab036458c54499a454399e19602b8ae6ce3 diff --git a/lisp/faces.el b/lisp/faces.el index d149cb0..a4f56ea 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -117,19 +117,20 @@ The return value will be a list of instantiators (e.g. strings The specifications in a specifier determine what the value of PROPERTY will be in a particular \"domain\" or set of circumstances, which is typically a particular Emacs window along with the buffer - it contains and the frame and device it lies within. The value - is derived from the instantiator associated with the most specific + it contains and the frame and device it lies within. The value is + derived from the instantiator associated with the most specific locale (in the order buffer, window, frame, device, and 'global) that matches the domain in question. In other words, given a domain - (i.e. an Emacs window, usually), the specifier for PROPERTY will first - be searched for a specification whose locale is the buffer contained - within that window; then for a specification whose locale is the window - itself; then for a specification whose locale is the frame that the - window is contained within; etc. The first instantiator that is - valid for the domain (usually this means that the instantiator is - recognized by the device [i.e. the X server or TTY device] that the - domain is on. The function `face-property-instance' actually does - all this, and is used to determine how to display the face. + (i.e. an Emacs window, usually), the specifier for PROPERTY will + first be searched for a specification whose locale is the buffer + contained within that window; then for a specification whose locale + is the window itself; then for a specification whose locale is the + frame that the window is contained within; etc. The first + instantiator that is valid for the domain (usually this means that + the instantiator is recognized by the device [i.e. MS Windows, the X + server or TTY device] that the domain is on. The function + `face-property-instance' actually does all this, and is used to + determine how to display the face. See `set-face-property' for the built-in property-names." @@ -304,7 +305,7 @@ The following symbols have predefined meanings: This should be a vector of 256 elements. background-pixmap The pixmap displayed in the background of the face. - Only used by faces on X devices. + Only used by faces on X and MS Windows devices. For valid instantiators, see `make-image-specifier'. underline Underline all text covered by this face. @@ -760,7 +761,10 @@ See `face-property-instance' for the semantics of the DOMAIN argument." (and (face-equal-loop common-props face1 face2 domain) (cond ((eq 'tty (device-type device)) (face-equal-loop tty-props face1 face2 domain)) + ;; #### Why isn't this (console-on-window-system-p (device-console device))? + ;; #### FIXME! ((or (eq 'x (device-type device)) + (eq 'gtk (device-type device)) (eq 'mswindows (device-type device))) (face-equal-loop win-props face1 face2 domain)) (t t))))) @@ -794,7 +798,8 @@ See `face-property-instance' for the semantics of the DOMAIN argument." ;; WE DEMAND LEXICAL SCOPING!!! ;; WE DEMAND LEXICAL SCOPING!!! ;; WE DEMAND LEXICAL SCOPING!!! -(defun frob-face-property (face property func &optional locale tags) +(defun frob-face-property (face property func device-tags &optional +locale tags) "Change the specifier for FACE's PROPERTY according to FUNC, in LOCALE. This function is ugly and messy and is primarily used as an internal helper function for `make-face-bold' et al., so you probably don't @@ -813,13 +818,19 @@ until a non-nil result is found (if there is no such result, the first valid instantiator is used), and that result substituted for the specification; otherwise, the process just outlined is iterated over each existing device and the concatenated results -substituted for the specification." +substituted for the specification. + +DEVICE-TAGS is a list of tags that each device must match in order for +the function to be called on it." (let ((sp (face-property face property)) temp-sp) (if (valid-specifier-domain-p locale) ;; this is easy. (let* ((inst (face-property-instance face property locale)) - (name (and inst (funcall func inst (dfw-device locale))))) + (name (and inst + (device-matches-specifier-tag-set-p + (dfw-device locale) device-tags) + (funcall func inst (dfw-device locale))))) (when name (add-spec-to-specifier sp name locale tags))) ;; otherwise, map over all specifications ... @@ -834,12 +845,23 @@ substituted for the specification." ;; happen if that locale has no instantiators. So signal ;; an error to indicate this. - + (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 (or (eq locale 'global) (eq locale 'all) (not locale)) + (when (not (specifier-specs temp-sp 'global)) + ;; Try fallback via the official ways and then do it "by hand" + (let* ((fallback (specifier-fallback sp)) + (fallback-sp + (cond ((specifierp fallback) fallback) + ;; just an inst list + (fallback + (make-specifier-and-init (specifier-type sp) + fallback)) + ((eq (get-face face) (get-face 'default)) + (error "Unable to find global specification")) + ;; If no fallback we snoop from default + (t (face-property 'default property))))) + (copy-specifier fallback-sp 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)) @@ -852,10 +874,15 @@ substituted for the specification." ;; Otherwise map frob-face-property-1 over each device. (result (if device - (list (frob-face-property-1 sp-arg device inst-list func)) + (list (and (device-matches-specifier-tag-set-p + device device-tags) + (frob-face-property-1 sp-arg device inst-list + func))) (mapcar (lambda (device) - (frob-face-property-1 sp-arg device - inst-list func)) + (and (device-matches-specifier-tag-set-p + device device-tags) + (frob-face-property-1 sp-arg device + inst-list func))) (device-list)))) new-result) ;; remove duplicates and nils from the obtained list of @@ -866,7 +893,7 @@ substituted for the specification." (setq arg (cons tags arg)) (setcar arg (append tags (delete 'default (car arg)))))) - (when (and arg (not (member arg new-result))) + (when (and arg (not (member arg new-result))) (setq new-result (cons arg new-result)))) result) ;; add back in. @@ -894,15 +921,21 @@ substituted for the specification." (setq inst-list (cdr inst-list))) (or result first-valid))) +(defcustom face-frob-from-locale-first nil + "*If non nil, use kludgy way of frobbing fonts suitable for non-mule +multi-charset environments." + :group 'faces + :type 'boolean) + (defun frob-face-font-2 (face locale tags unfrobbed-face frobbed-face - tty-thunk x-thunk standard-face-mapping) + tty-thunk ws-thunk standard-face-mapping) ;; another kludge to make things more intuitive. If we're ;; inheriting from a standard face in this locale, frob the - ;; inheritance as appropriate. Else, if, after the first X frobbing - ;; pass, the face hasn't changed and still looks like the standard - ;; unfrobbed face (e.g. 'default), make it inherit from the standard - ;; frobbed face (e.g. 'bold). Regardless of things, do the TTY - ;; frobbing. + ;; inheritance as appropriate. Else, if, after the first + ;; window-system frobbing pass, the face hasn't changed and still + ;; looks like the standard unfrobbed face (e.g. 'default), make it + ;; inherit from the standard frobbed face (e.g. 'bold). Regardless + ;; of things, do the TTY frobbing. ;; yuck -- The LOCALE argument to make-face-bold is not actually a locale, ;; but is a "locale, locale-type, or nil for all". So ... do our extra @@ -911,14 +944,20 @@ substituted for the specification." (let* ((the-locale (cond ((null locale) 'global) ((valid-specifier-locale-p locale) locale) (t nil))) - (specs (and the-locale (face-font face the-locale nil t))) - (change-it (and specs (cdr (assoc specs standard-face-mapping))))) + (spec-list + (and + the-locale + (specifier-spec-list (get (get-face face) 'font) the-locale tags t))) + (change-it + (and + spec-list + (cdr (assoc (cdadar spec-list) standard-face-mapping))))) (if (and change-it (not (memq (face-name (find-face face)) '(default bold italic bold-italic)))) (progn (or (equal change-it t) - (set-face-property face 'font change-it the-locale)) + (set-face-property face 'font change-it the-locale tags)) (funcall tty-thunk)) (let* ((domain (cond ((null the-locale) nil) ((valid-specifier-domain-p the-locale) the-locale) @@ -929,24 +968,59 @@ substituted for the specification." (selected-device)) (t nil))) (inst (and domain (face-property-instance face 'font domain)))) - (funcall tty-thunk) - (funcall x-thunk) ;; If it's reasonable to do the inherit-from-standard-face trick, ;; and it's called for, then do it now. - (or (null domain) - (not (equal inst (face-property-instance face 'font domain))) - ;; don't do it for standard faces, or you'll get inheritance loops. - ;; #### This makes XEmacs seg fault! fix this bug. - (memq (face-name (find-face face)) - '(default bold italic bold-italic)) - (not (equal (face-property-instance face 'font domain) - (face-property-instance unfrobbed-face 'font domain))) + (if (and + face-frob-from-locale-first + (eq the-locale 'global) + domain + (equal inst (face-property-instance face 'font domain)) + ;; don't do it for standard faces, or you'll get inheritance loops. + ;; #### This makes XEmacs seg fault! fix this bug. + (not (memq (face-name (find-face face)) + '(default bold italic bold-italic))) + (equal (face-property-instance face 'font domain) + (face-property-instance unfrobbed-face 'font domain))) (set-face-property face 'font (vector frobbed-face) - the-locale tags)))))) - + the-locale tags) + ;; and only otherwise try to build new property value artificially + (funcall tty-thunk) + (funcall ws-thunk) + (and + domain + (equal inst (face-property-instance face 'font domain)) + ;; don't do it for standard faces, or you'll get inheritance loops. + ;; #### This makes XEmacs seg fault! fix this bug. + (not (memq (face-name (find-face face)) + '(default bold italic bold-italic))) + (equal (face-property-instance face 'font domain) + (face-property-instance unfrobbed-face 'font domain)) + (set-face-property face 'font (vector frobbed-face) the-locale tags))))))) + +;; WE DEMAND FOUNDRY FROBBING! + +;; Family frobbing +;; Thx Jan Vroonhof, Ref xemacs-beta <87oflypbum.fsf@petteflet.ntlworld.com> +;; Brainlessly derived from make-face-size by Stephen; don't blame Jan. +;; I'm long since flown to Rio, it does you little good to blame me, either. +(defun make-face-family (face family &optional locale tags) + "Set FACE's family to FAMILY in LOCALE, if possible. + +Add/replace settings specified by TAGS only." + (frob-face-property face 'font + ;; uses dynamic scope of family + #'(lambda (f d) + ;; keep the dependency on font.el for now + (let ((fo (font-create-object (font-instance-name f) + d))) + (set-font-family fo family) + (font-create-name fo d))) + nil locale tags)) + +;; Style (ie, typographical face) frobbing (defun make-face-bold (face &optional locale tags) "Make FACE bold in LOCALE, if possible. -This will attempt to make the font bold for X locales and will set the +This will attempt to make the font bold for X/MSW locales and will set the highlight flag for TTY locales. If LOCALE is nil, omitted, or `all', this will attempt to frob all @@ -979,11 +1053,16 @@ circumstances." (when (featurep 'tty) (set-face-highlight-p face t locale (cons 'tty tags)))) (lambda () - ;; handle X specific entries + ;; handle window-system specific entries + (when (featurep 'gtk) + (frob-face-property face 'font 'gtk-make-font-bold + '(gtk) locale tags)) (when (featurep 'x) - (frob-face-property face 'font 'x-make-font-bold locale tags)) + (frob-face-property face 'font 'x-make-font-bold + '(x) locale tags)) (when (featurep 'mswindows) - (frob-face-property face 'font 'mswindows-make-font-bold locale tags)) + (frob-face-property face 'font 'mswindows-make-font-bold + '(mswindows) locale tags)) ) '(([default] . [bold]) ([bold] . t) @@ -992,10 +1071,10 @@ circumstances." (defun make-face-italic (face &optional locale tags) "Make FACE italic in LOCALE, if possible. -This will attempt to make the font italic for X locales and will set -the underline flag for TTY locales. -See `make-face-bold' for the semantics of the LOCALE argument and -for more specifics on exactly how this function works." +This will attempt to make the font italic for X/MS Windows locales and +will set the underline flag for TTY locales. See `make-face-bold' for +the semantics of the LOCALE argument and for more specifics on exactly +how this function works." (interactive (list (read-face-name "Make which face italic: "))) (frob-face-font-2 face locale tags 'default 'italic @@ -1004,11 +1083,16 @@ for more specifics on exactly how this function works." (when (featurep 'tty) (set-face-underline-p face t locale (cons 'tty tags)))) (lambda () - ;; handle X specific entries + ;; handle window-system specific entries + (when (featurep 'gtk) + (frob-face-property face 'font 'gtk-make-font-italic + '(gtk) locale tags)) (when (featurep 'x) - (frob-face-property face 'font 'x-make-font-italic locale tags)) + (frob-face-property face 'font 'x-make-font-italic + '(x) locale tags)) (when (featurep 'mswindows) - (frob-face-property face 'font 'mswindows-make-font-italic locale tags)) + (frob-face-property face 'font 'mswindows-make-font-italic + '(mswindows) locale tags)) ) '(([default] . [italic]) ([bold] . [bold-italic]) @@ -1017,10 +1101,10 @@ for more specifics on exactly how this function works." (defun make-face-bold-italic (face &optional locale tags) "Make FACE bold and italic in LOCALE, if possible. -This will attempt to make the font bold-italic for X locales and will -set the highlight and underline flags for TTY locales. -See `make-face-bold' for the semantics of the LOCALE argument and -for more specifics on exactly how this function works." +This will attempt to make the font bold-italic for X/MS Windows +locales and will set the highlight and underline flags for TTY +locales. See `make-face-bold' for the semantics of the LOCALE +argument and for more specifics on exactly how this function works." (interactive (list (read-face-name "Make which face bold-italic: "))) (frob-face-font-2 face locale tags 'default 'bold-italic @@ -1030,11 +1114,16 @@ for more specifics on exactly how this function works." (set-face-highlight-p face t locale (cons 'tty tags)) (set-face-underline-p face t locale (cons 'tty tags)))) (lambda () - ;; handle X specific entries + ;; handle window-system specific entries + (when (featurep 'gtk) + (frob-face-property face 'font 'gtk-make-font-bold-italic + '(gtk) locale tags)) (when (featurep 'x) - (frob-face-property face 'font 'x-make-font-bold-italic locale tags)) + (frob-face-property face 'font 'x-make-font-bold-italic + '(x) locale tags)) (when (featurep 'mswindows) - (frob-face-property face 'font 'mswindows-make-font-bold-italic locale tags)) + (frob-face-property face 'font 'mswindows-make-font-bold-italic + '(mswindows) locale tags)) ) '(([default] . [italic]) ([bold] . [bold-italic]) @@ -1043,10 +1132,10 @@ for more specifics on exactly how this function works." (defun make-face-unbold (face &optional locale tags) "Make FACE non-bold in LOCALE, if possible. -This will attempt to make the font non-bold for X locales and will -unset the highlight flag for TTY locales. -See `make-face-bold' for the semantics of the LOCALE argument and -for more specifics on exactly how this function works." +This will attempt to make the font non-bold for X/MS Windows locales +and will unset the highlight flag for TTY locales. See +`make-face-bold' for the semantics of the LOCALE argument and for more +specifics on exactly how this function works." (interactive (list (read-face-name "Make which face non-bold: "))) (frob-face-font-2 face locale tags 'bold 'default @@ -1055,11 +1144,16 @@ for more specifics on exactly how this function works." (when (featurep 'tty) (set-face-highlight-p face nil locale (cons 'tty tags)))) (lambda () - ;; handle X specific entries + ;; handle window-system specific entries + (when (featurep 'gtk) + (frob-face-property face 'font 'gtk-make-font-unbold + '(gtk) locale tags)) (when (featurep 'x) - (frob-face-property face 'font 'x-make-font-unbold locale tags)) + (frob-face-property face 'font 'x-make-font-unbold + '(x) locale tags)) (when (featurep 'mswindows) - (frob-face-property face 'font 'mswindows-make-font-unbold locale tags)) + (frob-face-property face 'font 'mswindows-make-font-unbold + '(mswindows) locale tags)) ) '(([default] . t) ([bold] . [default]) @@ -1068,10 +1162,10 @@ for more specifics on exactly how this function works." (defun make-face-unitalic (face &optional locale tags) "Make FACE non-italic in LOCALE, if possible. -This will attempt to make the font non-italic for X locales and will -unset the underline flag for TTY locales. -See `make-face-bold' for the semantics of the LOCALE argument and -for more specifics on exactly how this function works." +This will attempt to make the font non-italic for X/MS Windows locales +and will unset the underline flag for TTY locales. See +`make-face-bold' for the semantics of the LOCALE argument and for more +specifics on exactly how this function works." (interactive (list (read-face-name "Make which face non-italic: "))) (frob-face-font-2 face locale tags 'italic 'default @@ -1080,11 +1174,16 @@ for more specifics on exactly how this function works." (when (featurep 'tty) (set-face-underline-p face nil locale (cons 'tty tags)))) (lambda () - ;; handle X specific entries + ;; handle window-system specific entries + (when (featurep 'gtk) + (frob-face-property face 'font 'gtk-make-font-unitalic + '(gtk) locale tags)) (when (featurep 'x) - (frob-face-property face 'font 'x-make-font-unitalic locale tags)) + (frob-face-property face 'font 'x-make-font-unitalic + '(x) locale tags)) (when (featurep 'mswindows) - (frob-face-property face 'font 'mswindows-make-font-unitalic locale tags)) + (frob-face-property face 'font 'mswindows-make-font-unitalic + '(mswindows) locale tags)) ) '(([default] . t) ([bold] . t) @@ -1092,6 +1191,23 @@ for more specifics on exactly how this function works." ([bold-italic] . [bold])))) +;; Size frobbing +;; Thx Jan Vroonhof, Ref xemacs-beta <87oflypbum.fsf@petteflet.ntlworld.com> +;; Jan had a separate helper function +(defun make-face-size (face size &optional locale tags) + "Adjust FACE to SIZE in LOCALE, if possible. + +Add/replace settings specified by TAGS only." + (frob-face-property face 'font + ;; uses dynamic scope of size + #'(lambda (f d) + ;; keep the dependency on font.el for now + (let ((fo (font-create-object (font-instance-name f) + d))) + (set-font-size fo size) + (font-create-name fo d))) + nil locale tags)) + ;; Why do the following two functions lose so badly in so many ;; circumstances? @@ -1103,9 +1219,11 @@ because they don't make sense in this context." (interactive (list (read-face-name "Shrink which face: "))) ;; handle X specific entries (when (featurep 'x) - (frob-face-property face 'font 'x-find-smaller-font locale)) + (frob-face-property face 'font 'x-find-smaller-font + '(x) locale)) (when (featurep 'mswindows) - (frob-face-property face 'font 'mswindows-find-smaller-font locale))) + (frob-face-property face 'font 'mswindows-find-smaller-font + '(mswindows) locale))) (defun make-face-larger (face &optional locale) "Make the font of FACE be larger, if possible. @@ -1113,9 +1231,11 @@ See `make-face-smaller' for the semantics of the LOCALE argument." (interactive (list (read-face-name "Enlarge which face: "))) ;; handle X specific entries (when (featurep 'x) - (frob-face-property face 'font 'x-find-larger-font locale)) + (frob-face-property face 'font 'x-find-larger-font + '(x) locale)) (when (featurep 'mswindows) - (frob-face-property face 'font 'mswindows-find-larger-font locale))) + (frob-face-property face 'font 'mswindows-find-larger-font + '(mswindows) locale))) (defun invert-face (face &optional locale) "Swap the foreground and background colors of the face." @@ -1248,7 +1368,7 @@ See `defface' for information about SPEC." (defvar default-custom-frame-properties nil "The frame properties used for the global faces. -Frames not matching these propertiess should have frame local faces. +Frames not matching these properties should have frame local faces. The value should be nil, if uninitialized, or a plist otherwise. See `defface' for a list of valid keys and values for the plist.") @@ -1271,7 +1391,7 @@ If FRAME is nil, return the default frame properties." (defun face-spec-update-all-matching (spec display plist) "Update all entries in the face spec that could match display to -have the entries from the new plist and return the new spec" +have the entries from the new plist and return the new spec." (mapcar (lambda (e) (let ((entries (car e)) @@ -1299,8 +1419,8 @@ have the entries from the new plist and return the new spec" (setq new-options (cddr new-options))) (list entries options)))) (copy-sequence spec))) - - + + (defun face-spec-set-match-display (display &optional frame) "Return non-nil if DISPLAY matches FRAME. @@ -1424,6 +1544,8 @@ and 'global)." ;; Then do any device-specific initialization. (cond ((eq 'x (device-type device)) (x-init-device-faces device)) + ((eq 'gtk (device-type device)) + (gtk-init-device-faces device)) ((eq 'mswindows (device-type device)) (mswindows-init-device-faces device)) ;; Nothing to do for TTYs? @@ -1439,6 +1561,8 @@ and 'global)." ;; Then do any frame-specific initialization. (cond ((eq 'x (frame-type frame)) (x-init-frame-faces frame)) + ((eq 'gtk (frame-type frame)) + (gtk-init-frame-faces frame)) ((eq 'mswindows (frame-type frame)) (mswindows-init-frame-faces frame)) ;; Is there anything which should be done for TTY's? @@ -1455,7 +1579,9 @@ and 'global)." (loop for face in (face-list) do (init-face-from-resources face 'global)) ;; Further X frobbing. - (x-init-global-faces) + (and (featurep 'x) (x-init-global-faces)) + (and (featurep 'gtk) (gtk-init-global-faces)) + ;; for bold and the like, make the global specification be bold etc. ;; if the user didn't already specify a value. These will also be ;; frobbed further in init-other-random-faces. @@ -1488,10 +1614,12 @@ and 'global)." (defun face-complain-about-font (face device) (if (symbolp face) (setq face (symbol-name face))) ;; (if (not inhibit-font-complaints) - (display-warning - 'font - (let ((default-name (face-font-name 'default device))) - (format "%s: couldn't deduce %s %s version of the font + ;; complaining for printers is generally annoying. + (unless (device-printer-p device) + (display-warning + 'font + (let ((default-name (face-font-name 'default device))) + (format "%s: couldn't deduce %s %s version of the font %S. Please specify X resources to make the %s face @@ -1501,14 +1629,14 @@ For example, you could add one of the following to $HOME/Emacs: Emacs.%s.attributeFont: -dt-*-medium-i-* or Emacs.%s.attributeForeground: hotpink\n" - invocation-name - (if (string-match "\\`[aeiouAEIOU]" face) "an" "a") - face - default-name - face - face - face - )))) + invocation-name + (if (string-match "\\`[aeiouAEIOU]" face) "an" "a") + face + default-name + face + face + face + ))))) ;; #### This is quite a mess. We should use the custom mechanism for @@ -1609,7 +1737,7 @@ expected in this case, other types of image data will not work. If the optional FRAME argument is provided, change only in that frame; otherwise change each frame." (while (not (find-face face)) - (setq face (signal 'wrong-type-argument (list 'facep face)))) + (setq face (wrong-type-argument 'facep face))) (let ((bitmap-path (ecase (console-type) (x x-bitmap-file-path) (mswindows mswindows-bitmap-file-path))) @@ -1634,8 +1762,7 @@ in that frame; otherwise change each frame." (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)))) + (check-type frame (or null frame)) (set-face-background-pixmap face instantiator frame))) @@ -1651,7 +1778,7 @@ in that frame; otherwise change each frame." (make-face 'underline "Underlined text.") (or (face-differs-from-default-p 'underline) (set-face-underline-p 'underline t 'global '(default))) -(make-face 'zmacs-region "Used on highlightes region between point and mark.") +(make-face 'zmacs-region "Used on highlighted 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 @@ -1685,6 +1812,7 @@ in that frame; otherwise change each frame." 'global) (set-face-background-pixmap 'highlight '(((x default mono) . "gray1") + ((gtk default mono) . "gray1") ((mswindows default mono) . "gray1")) 'global) @@ -1696,6 +1824,7 @@ in that frame; otherwise change each frame." 'global) (set-face-background-pixmap 'zmacs-region '(((x default mono) . "gray3") + ((gtk default mono) . "gray3") ((mswindows default mono) . "gray3")) 'global) @@ -1703,6 +1832,9 @@ in that frame; otherwise change each frame." '(((x default color) . "gray68") ((x default grayscale) . "gray68") ((x default mono) . [default foreground]) + ((gtk default color) . "gray68") + ((gtk default grayscale) . "gray68") + ((gtk default mono) . [default foreground]) ((mswindows default color) . "gray68") ((mswindows default grayscale) . "gray68") ((mswindows default mono) . [default foreground])) @@ -1720,6 +1852,7 @@ in that frame; otherwise change each frame." 'global) (set-face-background-pixmap 'primary-selection '(((x default mono) . "gray3") + ((gtk default mono) . "gray3") ((mswindows default mono) . "gray3")) 'global) @@ -1727,18 +1860,24 @@ in that frame; otherwise change each frame." '(((x default color) . "paleturquoise") ((x default color) . "green") ((x default grayscale) . "gray53") + ((gtk default color) . "paleturquoise") + ((gtk default color) . "green") + ((gtk default grayscale) . "gray53") ((mswindows default color) . "paleturquoise") ((mswindows default color) . "green") ((mswindows default grayscale) . "gray53")) 'global) (set-face-background-pixmap 'secondary-selection '(((x default mono) . "gray1") + ((gtk default mono) . "gray1") ((mswindows default mono) . "gray1")) 'global) (set-face-background 'isearch '(((x default color) . "paleturquoise") ((x default color) . "green") + ((gtk default color) . "paleturquoise") + ((gtk default color) . "green") ((mswindows default color) . "paleturquoise") ((mswindows default color) . "green")) 'global) @@ -1754,23 +1893,25 @@ in that frame; otherwise change each frame." (if (featurep 'xpm) (setq xpm-color-symbols (list - (purecopy '("foreground" (face-foreground 'default))) - (purecopy '("background" (face-background 'default))) - (purecopy '("backgroundToolBarColor" - (or - (and - (featurep 'x) - (x-get-resource "backgroundToolBarColor" - "BackgroundToolBarColor" 'string)) - - (face-background 'toolbar)))) - (purecopy '("foregroundToolBarColor" - (or - (and - (featurep 'x) - (x-get-resource "foregroundToolBarColor" - "ForegroundToolBarColor" 'string)) - (face-foreground 'toolbar)))) + '("foreground" (face-foreground 'default)) + '("background" (face-background 'default)) + '("backgroundToolBarColor" + (or + (and + (featurep 'x) + (x-get-resource "backgroundToolBarColor" + "BackgroundToolBarColor" 'string + nil nil 'warn)) + + (face-background 'toolbar))) + '("foregroundToolBarColor" + (or + (and + (featurep 'x) + (x-get-resource "foregroundToolBarColor" + "ForegroundToolBarColor" 'string + nil nil 'warn)) + (face-foreground 'toolbar))) ))) (when (featurep 'tty)