Index: lisp/faces.el =================================================================== RCS file: /sources/emacs/emacs/lisp/faces.el,v retrieving revision 1.443 diff -U 8 -r1.443 faces.el --- lisp/faces.el 27 Jun 2009 20:44:07 -0000 1.443 +++ lisp/faces.el 3 Aug 2009 20:35:18 -0000 @@ -1626,18 +1626,18 @@ (defun color-defined-p (color &optional frame) "Return non-nil if color COLOR is supported on frame FRAME. If FRAME is omitted or nil, use the selected frame. If COLOR is the symbol `unspecified' or one of the strings \"unspecified-fg\" or \"unspecified-bg\", the value is nil." (if (member color '(unspecified "unspecified-bg" "unspecified-fg")) nil (if (member (framep (or frame (selected-frame))) '(x w32 ns)) - (xw-color-defined-p color frame) - (numberp (tty-color-translate color frame))))) + (xw-color-defined-p (or (colorscheme-lookup color frame) color) frame) + (numberp (tty-color-translate (or (colorscheme-lookup color frame) color) frame))))) (defalias 'x-color-defined-p 'color-defined-p) (declare-function xw-color-values "xfns.c" (color &optional frame)) (defun color-values (color &optional frame) "Return a description of the color named COLOR on frame FRAME. The value is a list of integer RGB values--(RED GREEN BLUE). These values appear to range from 0 to 65280 or 65535, depending @@ -2678,12 +2678,38 @@ (defun x-make-font-bold-italic (font) "Given an X font specification, make a bold and italic version of it. If that can't be done, return nil." (and (setq font (internal-frob-font-weight font "bold")) (internal-frob-font-slant font "i"))) (make-obsolete 'x-make-font-bold-italic 'make-face-bold-italic "21.1") + +(defun colorscheme-lookup (colorspec frame) + "Resolve '@table:name' to a named color via an alist in colorscheme-table + Used to allow indirect color specifications in face definitions." + ;; e.g. + ;; (setq colorscheme-lennart1 + ;; '(("builtin" "Orchid4") + ;; ("preprocessor" "DeepPink3") + ;; ("warning" "red2") + ;; ("comment" "Firebrick") + ;; ("constant" "#00765b") + ;; ("doc" "gold4") + ;; ("string" "#797900") + ;; ("variable-name" "#9b6900"))) + ;; + ;; (colorscheme-lookup "@lennart1:doc" (selected-frame)) + ;; => "gold4" + (save-match-data + (when (string-match "^@\\(.+\\):\\(.+\\)$" colorspec) + (let* ((table (match-string 1 colorspec)) + (key (match-string 2 colorspec)) + (tablesym (intern (concat "colorscheme-" table)))) + (when (and (boundp tablesym) key) + (cadr (assoc key (symbol-value tablesym)))))))) + + (provide 'faces) ;; arch-tag: 19a4759f-2963-445f-b004-425b9aadd7d6 ;;; faces.el ends here Index: lisp/font-lock.el =================================================================== RCS file: /sources/emacs/emacs/lisp/font-lock.el,v retrieving revision 1.351 diff -U 8 -r1.351 font-lock.el --- lisp/font-lock.el 2 Aug 2009 14:20:10 -0000 1.351 +++ lisp/font-lock.el 3 Aug 2009 20:35:18 -0000 @@ -1830,25 +1830,35 @@ (font-lock-remove-keywords nil removed-keywords)) ;; Now compile the keywords. (unless (eq (car font-lock-keywords) t) (setq font-lock-keywords (font-lock-compile-keywords font-lock-keywords)))))) ;;; Color etc. support. +(defvar colorscheme-fldefault + '(("builtin" "Orchid4") + ("preprocessor" "DeepPink3") ; FIXME: not adjusted below + ("warning" "red2") + ("comment" "Firebrick") + ("constant" "#00765b") + ("doc" "gold4") ; FIXME: not adjusted below + ("string" "#797900") + ("variable-name" "#9b6900"))) + ;; Note that `defface' will not overwrite any faces declared above via ;; `custom-declare-face'. (defface font-lock-comment-face '((((class grayscale) (background light)) (:foreground "DimGray" :weight bold :slant italic)) (((class grayscale) (background dark)) (:foreground "LightGray" :weight bold :slant italic)) (((class color) (min-colors 88) (background light)) - (:foreground "Firebrick")) + (:foreground "@fldefault:comment")) (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1")) (((class color) (min-colors 16) (background light)) (:foreground "red")) (((class color) (min-colors 16) (background dark)) (:foreground "red1")) (((class color) (min-colors 8) (background light)) (:foreground "red")) @@ -1867,17 +1877,17 @@ (((class color) (min-colors 8) (background dark)) :foreground "red1")) "Font Lock mode face used to highlight comment delimiters." :group 'font-lock-faces) (defface font-lock-string-face '((((class grayscale) (background light)) (:foreground "DimGray" :slant italic)) (((class grayscale) (background dark)) (:foreground "LightGray" :slant italic)) - (((class color) (min-colors 88) (background light)) (:foreground "VioletRed4")) + (((class color) (min-colors 88) (background light)) (:foreground "@fldefault:string")) (((class color) (min-colors 88) (background dark)) (:foreground "LightSalmon")) (((class color) (min-colors 16) (background light)) (:foreground "RosyBrown")) (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon")) (((class color) (min-colors 8)) (:foreground "green")) (t (:slant italic))) "Font Lock mode face used to highlight strings." :group 'font-lock-faces) @@ -1896,17 +1906,17 @@ (((class color) (min-colors 8)) (:foreground "cyan" :weight bold)) (t (:weight bold))) "Font Lock mode face used to highlight keywords." :group 'font-lock-faces) (defface font-lock-builtin-face '((((class grayscale) (background light)) (:foreground "LightGray" :weight bold)) (((class grayscale) (background dark)) (:foreground "DimGray" :weight bold)) - (((class color) (min-colors 88) (background light)) (:foreground "MediumOrchid4")) + (((class color) (min-colors 88) (background light)) (:foreground "@fldefault:builtin")) (((class color) (min-colors 88) (background dark)) (:foreground "LightSteelBlue")) (((class color) (min-colors 16) (background light)) (:foreground "Orchid")) (((class color) (min-colors 16) (background dark)) (:foreground "LightSteelBlue")) (((class color) (min-colors 8)) (:foreground "blue" :weight bold)) (t (:weight bold))) "Font Lock mode face used to highlight builtins." :group 'font-lock-faces) @@ -1920,17 +1930,17 @@ "Font Lock mode face used to highlight function names." :group 'font-lock-faces) (defface font-lock-variable-name-face '((((class grayscale) (background light)) (:foreground "Gray90" :weight bold :slant italic)) (((class grayscale) (background dark)) (:foreground "DimGray" :weight bold :slant italic)) - (((class color) (min-colors 88) (background light)) (:foreground "sienna")) + (((class color) (min-colors 88) (background light)) (:foreground "@fldefault:variable-name")) (((class color) (min-colors 88) (background dark)) (:foreground "LightGoldenrod")) (((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod")) (((class color) (min-colors 16) (background dark)) (:foreground "LightGoldenrod")) (((class color) (min-colors 8)) (:foreground "yellow" :weight light)) (t (:weight bold :slant italic))) "Font Lock mode face used to highlight variable names." :group 'font-lock-faces) @@ -1946,27 +1956,27 @@ "Font Lock mode face used to highlight type and classes." :group 'font-lock-faces) (defface font-lock-constant-face '((((class grayscale) (background light)) (:foreground "LightGray" :weight bold :underline t)) (((class grayscale) (background dark)) (:foreground "Gray50" :weight bold :underline t)) - (((class color) (min-colors 88) (background light)) (:foreground "dark cyan")) + (((class color) (min-colors 88) (background light)) (:foreground "@fldefault:constant")) (((class color) (min-colors 88) (background dark)) (:foreground "Aquamarine")) (((class color) (min-colors 16) (background light)) (:foreground "CadetBlue")) (((class color) (min-colors 16) (background dark)) (:foreground "Aquamarine")) (((class color) (min-colors 8)) (:foreground "magenta")) (t (:weight bold :underline t))) "Font Lock mode face used to highlight constants and labels." :group 'font-lock-faces) (defface font-lock-warning-face - '((((class color) (min-colors 88) (background light)) (:foreground "Red1" :weight bold)) + '((((class color) (min-colors 88) (background light)) (:foreground "@fldefault:warning" :weight bold)) (((class color) (min-colors 88) (background dark)) (:foreground "Pink" :weight bold)) (((class color) (min-colors 16) (background light)) (:foreground "Red1" :weight bold)) (((class color) (min-colors 16) (background dark)) (:foreground "Pink" :weight bold)) (((class color) (min-colors 8)) (:foreground "red")) (t (:inverse-video t :weight bold))) "Font Lock mode face used to highlight warnings." :group 'font-lock-faces) Index: src/xfaces.c =================================================================== RCS file: /sources/emacs/emacs/src/xfaces.c,v retrieving revision 1.438 diff -U 8 -r1.438 xfaces.c --- src/xfaces.c 27 Jul 2009 04:19:03 -0000 1.438 +++ src/xfaces.c 3 Aug 2009 20:35:18 -0000 @@ -448,16 +448,20 @@ static int next_lface_id; /* A vector mapping Lisp face Id's to face names. */ static Lisp_Object *lface_id_to_name; static int lface_id_to_name_size; +/* Colorscheme lookup function (defined in faces.el). */ + +Lisp_Object Qcolorscheme_lookup; + /* TTY color-related functions (defined in tty-colors.el). */ Lisp_Object Qtty_color_desc, Qtty_color_by_index, Qtty_color_standard_values; /* The name of the function used to compute colors on TTYs. */ Lisp_Object Qtty_color_alist; @@ -1246,29 +1250,48 @@ int defined_color (f, color_name, color_def, alloc) struct frame *f; char *color_name; XColor *color_def; int alloc; { + char *resolved_color_name; + resolved_color_name = color_name; + + /* indirect through colorscheme-lookup function if color_name starts with @ */ + if (color_name[0] == '@') { + if (!NILP (Ffboundp (Qcolorscheme_lookup))) + { + Lisp_Object frame; + Lisp_Object resolved_color; + + XSETFRAME (frame, f); + resolved_color = call2 (Qcolorscheme_lookup, build_string(color_name), frame); + if (STRINGP (resolved_color)) + { + resolved_color_name = SDATA(resolved_color); + } + } + } + if (!FRAME_WINDOW_P (f)) - return tty_defined_color (f, color_name, color_def, alloc); + return tty_defined_color (f, resolved_color_name, color_def, alloc); #ifdef HAVE_X_WINDOWS else if (FRAME_X_P (f)) - return x_defined_color (f, color_name, color_def, alloc); + return x_defined_color (f, resolved_color_name, color_def, alloc); #endif #ifdef WINDOWSNT else if (FRAME_W32_P (f)) - return w32_defined_color (f, color_name, color_def, alloc); + return w32_defined_color (f, resolved_color_name, color_def, alloc); #endif #ifdef HAVE_NS else if (FRAME_NS_P (f)) - return ns_defined_color (f, color_name, color_def, alloc, 1); + return ns_defined_color (f, resolved_color_name, color_def, alloc, 1); #endif else abort (); } /* Given the index IDX of a tty color on frame F, return its name, a Lisp string. */ @@ -6875,16 +6898,20 @@ Qborder = intern ("border"); staticpro (&Qborder); Qmouse = intern ("mouse"); staticpro (&Qmouse); Qmode_line_inactive = intern ("mode-line-inactive"); staticpro (&Qmode_line_inactive); Qvertical_border = intern ("vertical-border"); staticpro (&Qvertical_border); + + Qcolorscheme_lookup = intern ("colorscheme-lookup"); + staticpro (&Qcolorscheme_lookup); + Qtty_color_desc = intern ("tty-color-desc"); staticpro (&Qtty_color_desc); Qtty_color_standard_values = intern ("tty-color-standard-values"); staticpro (&Qtty_color_standard_values); Qtty_color_by_index = intern ("tty-color-by-index"); staticpro (&Qtty_color_by_index); Qtty_color_alist = intern ("tty-color-alist"); staticpro (&Qtty_color_alist); Index: src/xfns.c =================================================================== RCS file: /sources/emacs/emacs/src/xfns.c,v retrieving revision 1.742 diff -U 8 -r1.742 xfns.c --- src/xfns.c 10 Jul 2009 17:07:38 -0000 1.742 +++ src/xfns.c 3 Aug 2009 20:35:18 -0000 @@ -766,17 +766,19 @@ #endif /* Return MONO_COLOR for monochrome frames. */ if (FRAME_X_DISPLAY_INFO (f)->n_planes == 1) return mono_color; /* x_defined_color is responsible for coping with failures by looking for a near-miss. */ - if (x_defined_color (f, SDATA (color_name), &cdef, 1)) + /* call defined_color which will call x_defined_color for us + to allow @indirect color resolution to take place */ + if (defined_color (f, SDATA (color_name), &cdef, 1)) return cdef.pixel; signal_error ("Undefined color", color_name); } /* Change the `wait-for-wm' frame parameter of frame F. OLD_VALUE is