[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: Darkening font-lock colors
From: |
David De La Harpe Golden |
Subject: |
Re: Darkening font-lock colors |
Date: |
Mon, 03 Aug 2009 21:42:21 +0100 |
User-agent: |
Mozilla-Thunderbird 2.0.0.22 (X11/20090701) |
address@hidden wrote:
That would indeed be splendid.
Can't we start merging the existing color-theme package, and iron out
whatever wrinkles it has?
Hmm. I've never really looked at it before. I think "color-theme" might
be a bit of a misnomer as it's apparently quite capable of theming the
other face properties - it's really "face-theme" e.g. the bundled
example munges bold/italic. Not saying that's a bad thing, but the
code is therefore a lot more complex than a purely color oriented system.
Related to recent discussions about color name parsing - how about
being able to say "@blah:comment" in a color string (e.g. face
foreground property), that indirects through an alist in
colorscheme-blah, looking up "comment"? (or whatever, that particular
scheme was just simple to implement)
Quick proof of concept patch attached. Potentially with a small can of
worms regarding display and background dependence, but frame is also
passed through to colorscheme-lookup, the simple colorscheme-lookup
function included in the patch just doesn't do anything much with it.
Less powerful overall than color-theme? Undoubtedly. But may in fact be
complementary (themes could set face colors to
@themes-colorscheme-name:key and/or redefine relevant colorscheme-blah
alists), and could in principle also be used for colors other than face
colors.
OTOH, may very well be needlessly complicating things.
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 "address@hidden(.+\\):\\(.+\\)$" 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
- Re: Darkening font-lock colors, (continued)
- Re: Darkening font-lock colors, Lennart Borgman, 2009/08/02
- Re: Darkening font-lock colors, David De La Harpe Golden, 2009/08/03
- Re: Darkening font-lock colors, Miles Bader, 2009/08/03
- RE: Darkening font-lock colors, Drew Adams, 2009/08/03
- Re: Darkening font-lock colors, Juri Linkov, 2009/08/03
- Re: Darkening font-lock colors, Daniel Clemente, 2009/08/03
- RE: Darkening font-lock colors, Drew Adams, 2009/08/03
- Re: Darkening font-lock colors, Juri Linkov, 2009/08/03
- RE: Darkening font-lock colors, Drew Adams, 2009/08/03
- Re: Darkening font-lock colors, joakim, 2009/08/03
- Re: Darkening font-lock colors,
David De La Harpe Golden <=
- Color themes (was: Darkening font-lock colors), Juri Linkov, 2009/08/08
- Re: Color themes, joakim, 2009/08/08
- Re: Color themes, Chong Yidong, 2009/08/08
- Re: Color themes, Leo, 2009/08/09
- Re: Color themes, Chong Yidong, 2009/08/09
- Re: Color themes, CHENG Gao, 2009/08/09
- Re: Color themes, Lennart Borgman, 2009/08/09
- Re: Color themes, joakim, 2009/08/09
- Re: Color themes, Leo, 2009/08/10
- Re: Color themes, Juri Linkov, 2009/08/10