X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/0a20c80c9cee34a71b975bb37ac811bd339eaf9f..929aeac608c271b2448dffec29aeea85c69d6bff:/lisp/facemenu.el diff --git a/lisp/facemenu.el b/lisp/facemenu.el index 1b42aa9ea7..e86c1c23d6 100644 --- a/lisp/facemenu.el +++ b/lisp/facemenu.el @@ -1,6 +1,6 @@ ;;; facemenu.el --- create a face menu for interactively adding fonts to text -;; Copyright (C) 1994-1996, 2001-2011 Free Software Foundation, Inc. +;; Copyright (C) 1994-1996, 2001-2013 Free Software Foundation, Inc. ;; Author: Boris Goldowsky ;; Keywords: faces @@ -127,15 +127,6 @@ just before \"Other\" at the end." :type 'boolean :group 'facemenu) -(defvar facemenu-unlisted-faces - `(modeline region secondary-selection highlight scratch-face - ,(purecopy "^font-lock-") ,(purecopy "^gnus-") ,(purecopy "^message-") - ,(purecopy "^ediff-") ,(purecopy "^term-") ,(purecopy "^vc-") - ,(purecopy "^widget-") ,(purecopy "^custom-") ,(purecopy "^vm-")) - "*List of faces that are of no interest to the user.") -(make-obsolete-variable 'facemenu-unlisted-faces 'facemenu-listed-faces - "22.1,\n and has no effect on the Face menu") - (defcustom facemenu-listed-faces nil "List of faces to include in the Face menu. Each element should be a symbol, the name of a face. @@ -241,10 +232,12 @@ it will remove any faces not explicitly in the list." (define-key map [df] (cons (purecopy "Display Faces") 'list-faces-display)) (define-key map [dp] (cons (purecopy "Describe Properties") 'describe-text-properties)) - (define-key map [ra] (cons (purecopy "Remove Text Properties") - 'facemenu-remove-all)) - (define-key map [rm] (cons (purecopy "Remove Face Properties") - 'facemenu-remove-face-props)) + (define-key map [ra] (list 'menu-item (purecopy "Remove Text Properties") + 'facemenu-remove-all + :enable 'mark-active)) + (define-key map [rm] (list 'menu-item (purecopy "Remove Face Properties") + 'facemenu-remove-face-props + :enable 'mark-active)) (define-key map [s1] (list (purecopy "--")))) (let ((map facemenu-menu)) (define-key map [in] (cons (purecopy "Indentation") @@ -471,7 +464,8 @@ These special properties include `invisible', `intangible' and `read-only'." `(rgb-dist . COLOR)' sorts by the RGB distance to the specified color. `hsv' sorts by hue, saturation, value. `(hsv-dist . COLOR)' sorts by the HSV distance to the specified color -and excludes grayscale colors." +and excludes grayscale colors. +`luminance' sorts by relative luminance in the CIE XYZ color space." :type '(choice (const :tag "Unsorted" nil) (const :tag "Color Name" name) (const :tag "Red-Green-Blue" rgb) @@ -481,7 +475,8 @@ and excludes grayscale colors." (const :tag "Hue-Saturation-Value" hsv) (cons :tag "Distance on HSV cylinder" (const :tag "Distance from Color" hsv-dist) - (color :tag "Source Color Name"))) + (color :tag "Source Color Name")) + (const :tag "Luminance" luminance)) :group 'facemenu :version "24.1") @@ -511,23 +506,25 @@ filter out the color from the output." (+ (expt (- 180 (abs (- 180 (abs (- (nth 0 c-hsv) ; wrap hue (nth 0 o-hsv)))))) 2) (expt (- (nth 1 c-hsv) (nth 1 o-hsv)) 2) - (expt (- (nth 2 c-hsv) (nth 2 o-hsv)) 2))))))) + (expt (- (nth 2 c-hsv) (nth 2 o-hsv)) 2))))) + ((eq list-colors-sort 'luminance) + (let ((c-rgb (color-name-to-rgb color))) + (+ (* (nth 0 c-rgb) 0.21266729) + (* (nth 1 c-rgb) 0.7151522) + (* (nth 2 c-rgb) 0.0721750)))))) (defun list-colors-display (&optional list buffer-name callback) "Display names of defined colors, and show what they look like. If the optional argument LIST is non-nil, it should be a list of colors to display. Otherwise, this command computes a list of -colors that the current display can handle. +colors that the current display can handle. Customize +`list-colors-sort' to change the order in which colors are shown. -If the optional argument BUFFER-NAME is nil, it defaults to -*Colors*. +If the optional argument BUFFER-NAME is nil, it defaults to *Colors*. If the optional argument CALLBACK is non-nil, it should be a function to call each time the user types RET or clicks on a -color. The function should accept a single argument, the color -name. - -You can change the color sort order by customizing `list-colors-sort'." +color. The function should accept a single argument, the color name." (interactive) (when (and (null list) (> (display-color-cells) 0)) (setq list (list-colors-duplicates (defined-colors))) @@ -637,8 +634,17 @@ a list of colors that the current display can handle." (l list)) (while (cdr l) (if (and (facemenu-color-equal (car (car l)) (car (car (cdr l)))) - (not (if (fboundp 'w32-default-color-map) - (not (assoc (car (car l)) (w32-default-color-map)))))) + ;; On MS-Windows, there are logical colors that might have + ;; the same value but different names and meanings. For + ;; example, `SystemMenuText' (the color w32 uses for the + ;; text in menu entries) and `SystemWindowText' (the default + ;; color w32 uses for the text in windows and dialogs) may + ;; be the same display color and be adjacent in the list. + ;; These system colors all have names prefixed with "System", + ;; which is hardcoded in w32fns.c (SYSTEM_COLOR_PREFIX). + ;; This makes them different to any other color. Bug#9722 + (not (and (eq system-type 'windows-nt) + (string-match-p "^System" (car (car l)))))) (progn (setcdr (car l) (cons (car (car (cdr l))) (cdr (car l)))) (setcdr l (cdr (cdr l))))