;;; 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-2014 Free Software Foundation, Inc.
;; Author: Boris Goldowsky <boris@gnu.org>
;; Keywords: faces
: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.
(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")
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))
`(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)
(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")
(+ (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)))
(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.")))
(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))))
HCoop / bpt / emacs.git / blobdiff