From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: David De La Harpe Golden Newsgroups: gmane.emacs.devel Subject: Re: Darkening font-lock colors Date: Mon, 03 Aug 2009 21:42:21 +0100 Message-ID: <4A774BAD.7010601@harpegolden.net> References: <87d47hoox5.fsf@stupidchicken.com> <200907302221.n6UMLUWZ009001@godzilla.ics.uci.edu> <4A722F7B.20101@harpegolden.net> <87d47hisbq.fsf@cyd.mit.edu> <87zlahrggt.fsf@cyd.mit.edu> <87tz0pg1uk.fsf@mail.jurta.org> <4A76481C.6000602@harpegolden.net> <87hbwp32ep.fsf@catnip.gol.com> <432BC810AC84409882C7E7FB5183D8DD@us.oracle.com> <8763d516ox.fsf@mail.jurta.org> NNTP-Posting-Host: lo.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="------------020100080204050904080307" X-Trace: ger.gmane.org 1249344774 7606 80.91.229.12 (4 Aug 2009 00:12:54 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Tue, 4 Aug 2009 00:12:54 +0000 (UTC) Cc: 'Chong Yidong' , 'Lennart Borgman' , emacs-devel@gnu.org, Juri Linkov , 'Dan Nicolaescu' , 'Stefan Monnier' , Drew Adams , 'Miles Bader' To: joakim@verona.se Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Tue Aug 04 02:12:45 2009 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([199.232.76.165]) by lo.gmane.org with esmtp (Exim 4.50) id 1MY7dw-00035M-Pe for ged-emacs-devel@m.gmane.org; Tue, 04 Aug 2009 02:12:41 +0200 Original-Received: from localhost ([127.0.0.1]:40314 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1MY7dv-0007Xa-Sr for ged-emacs-devel@m.gmane.org; Mon, 03 Aug 2009 20:12:40 -0400 Original-Received: from mailman by lists.gnu.org with tmda-scanned (Exim 4.43) id 1MY4Mg-0004K4-CX for emacs-devel@gnu.org; Mon, 03 Aug 2009 16:42:38 -0400 Original-Received: from exim by lists.gnu.org with spam-scanned (Exim 4.43) id 1MY4Ma-00047X-Vi for emacs-devel@gnu.org; Mon, 03 Aug 2009 16:42:37 -0400 Original-Received: from [199.232.76.173] (port=37082 helo=monty-python.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1MY4Ma-000472-Jb for emacs-devel@gnu.org; Mon, 03 Aug 2009 16:42:32 -0400 Original-Received: from harpegolden.net ([65.99.215.13]:60254) by monty-python.gnu.org with esmtp (Exim 4.60) (envelope-from ) id 1MY4MV-0007eH-Gc; Mon, 03 Aug 2009 16:42:27 -0400 Original-Received: from [87.198.54.194] (87-198-54-194.ptr.magnet.ie [87.198.54.194]) (using TLSv1 with cipher DHE-RSA-AES256-SHA (256/256 bits)) (Client CN "David De La Harpe Golden", Issuer "David De La Harpe Golden Personal CA rev 3" (verified OK)) by harpegolden.net (Postfix) with ESMTP id DFD8C8275; Mon, 3 Aug 2009 21:42:23 +0100 (IST) User-Agent: Mozilla-Thunderbird 2.0.0.22 (X11/20090701) In-Reply-To: X-detected-operating-system: by monty-python.gnu.org: Genre and OS details not recognized. X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.5 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:113623 Archived-At: This is a multi-part message in MIME format. --------------020100080204050904080307 Content-Type: text/plain; charset=ISO-8859-1; format=flowed Content-Transfer-Encoding: 7bit joakim@verona.se 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. --------------020100080204050904080307 Content-Type: text/x-patch; name="colorscheme_r1.diff" Content-Transfer-Encoding: 7bit Content-Disposition: inline; filename="colorscheme_r1.diff" 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 --------------020100080204050904080307--