X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/f0ecbca80a004824d74ca9bc8b77cc94b2489b34..5811404f0b86c9fa92c3e0b22505a9bb05f04145:/lisp/facemenu.el diff --git a/lisp/facemenu.el b/lisp/facemenu.el index 4f9db02b5e..8b01c4e47b 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-2016 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. @@ -338,7 +329,7 @@ This command can also add FACE to the menu of faces, if `facemenu-listed-faces' says to do that." (interactive (list (progn (barf-if-buffer-read-only) - (read-face-name "Use face")) + (read-face-name "Use face" (face-at-point t))) (if (and mark-active (not current-prefix-arg)) (region-beginning)) (if (and mark-active (not current-prefix-arg)) @@ -467,13 +458,14 @@ These special properties include `invisible', `intangible' and `read-only'." (defcustom list-colors-sort nil "Color sort order for `list-colors-display'. -`nil' means default implementation-dependent order (defined in `x-colors'). +nil means default implementation-dependent order (defined in `x-colors'). `name' sorts by color name. `rgb' sorts by red, green, blue components. `(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) @@ -483,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") @@ -513,23 +506,36 @@ 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)))))) + +(defvar list-colors-callback nil + "Value of CALLBACK arg passed to `list-colors-display'; internal use.") + +(defun list-colors-redisplay (_ignore-auto _noconfirm) + "Redisplay the colors using `list-colors-sort'. + +This is installed as a `revert-buffer-function' in the *Colors* buffer." + (list-colors-display nil (buffer-name) list-colors-callback)) (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. +Type `g' or \\[revert-buffer] after customizing `list-colors-sort' +to redisplay colors in the new order. -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))) @@ -571,7 +577,9 @@ You can change the color sort order by customizing `list-colors-sort'." (erase-buffer) (list-colors-print list callback) (set-buffer-modified-p nil) - (setq truncate-lines t))) + (setq truncate-lines t) + (setq-local list-colors-callback callback) + (setq revert-buffer-function 'list-colors-redisplay))) (when callback (pop-to-buffer buffer-name) (message "Click on a color to select it."))) @@ -612,7 +620,7 @@ You can change the color sort order by customizing `list-colors-sort'." 'help-echo (let ((hsv (apply 'color-rgb-to-hsv (color-name-to-rgb (car color))))) - (format "H:%d S:%d V:%d" + (format "H:%.2f S:%.2f V:%.2f" (nth 0 hsv) (nth 1 hsv) (nth 2 hsv))))) (when callback (make-text-button @@ -629,8 +637,8 @@ You can change the color sort order by customizing `list-colors-sort'." (defun list-colors-duplicates (&optional list) "Return a list of colors with grouped duplicate colors. If a color has no duplicates, then the element of the returned list -has the form '(COLOR-NAME). The element of the returned list with -duplicate colors has the form '(COLOR-NAME DUPLICATE-COLOR-NAME ...). +has the form (COLOR-NAME). The element of the returned list with +duplicate colors has the form (COLOR-NAME DUPLICATE-COLOR-NAME ...). This function uses the predicate `facemenu-color-equal' to compare color names. If the optional argument LIST is non-nil, it should be a list of colors to display. Otherwise, this function uses @@ -724,7 +732,7 @@ effect. See `facemenu-remove-face-function'." face (facemenu-active-faces (cons face - (if (listp prev) + (if (face-list-p prev) prev (list prev))) ;; Specify the selected frame