Mercurial > emacs
changeset 111145:127f4f5efa50
Merge read-color and facemenu-read-color (Bug#7242).
* lisp/facemenu.el (facemenu-read-color): Alias for read-color.
(facemenu-set-foreground, facemenu-set-background): Use
read-color.
* lisp/faces.el (read-color): Use the completion code from
facemenu-read-color. Require match in completion. Doc fix.
* lisp/frame.el (set-background-color, set-foreground-color)
(set-cursor-color, set-mouse-color, set-border-color): Use
read-color.
| author | Chong Yidong <cyd@stupidchicken.com> |
|---|---|
| date | Sun, 24 Oct 2010 14:43:31 -0400 |
| parents | f349e65969e5 |
| children | 25f363b1aa1f |
| files | etc/NEWS lisp/ChangeLog lisp/facemenu.el lisp/faces.el lisp/frame.el |
| diffstat | 5 files changed, 87 insertions(+), 95 deletions(-) [+] |
line wrap: on
line diff
--- a/etc/NEWS Sun Oct 24 13:24:24 2010 -0400 +++ b/etc/NEWS Sun Oct 24 14:43:31 2010 -0400 @@ -663,6 +663,12 @@ ** New completion style `substring'. +** `facemenu-read-color' is now an alias for `read-color'. +The command `read-color' now requires a match for a color name or RGB +triplet, instead of signalling an error if the user provides a invalid +input. + + ** Image API *** When the image type is one of listed in `image-animated-types'
--- a/lisp/ChangeLog Sun Oct 24 13:24:24 2010 -0400 +++ b/lisp/ChangeLog Sun Oct 24 14:43:31 2010 -0400 @@ -1,3 +1,18 @@ +2010-10-24 Chong Yidong <cyd@stupidchicken.com> + + Merge read-color and facemenu-read-color (Bug#7242). + + * faces.el (read-color): Use the completion code from + facemenu-read-color. Require match in completion. Doc fix. + + * facemenu.el (facemenu-read-color): Alias for read-color. + (facemenu-set-foreground, facemenu-set-background): Use + read-color. + + * frame.el (set-background-color, set-foreground-color) + (set-cursor-color, set-mouse-color, set-border-color): Use + read-color. + 2010-10-24 Leo <sdl.web@gmail.com> * eshell/em-unix.el (eshell-remove-entries): Use the TRASH
--- a/lisp/facemenu.el Sun Oct 24 13:24:24 2010 -0400 +++ b/lisp/facemenu.el Sun Oct 24 14:43:31 2010 -0400 @@ -358,7 +358,7 @@ typing a character to insert cancels the specification." (interactive (list (progn (barf-if-buffer-read-only) - (facemenu-read-color "Foreground color: ")) + (read-color "Foreground color: ")) (if (and mark-active (not current-prefix-arg)) (region-beginning)) (if (and mark-active (not current-prefix-arg)) @@ -380,7 +380,7 @@ typing a character to insert cancels the specification." (interactive (list (progn (barf-if-buffer-read-only) - (facemenu-read-color "Background color: ")) + (read-color "Background color: ")) (if (and mark-active (not current-prefix-arg)) (region-beginning)) (if (and mark-active (not current-prefix-arg)) @@ -462,23 +462,7 @@ (remove-text-properties start end '(invisible nil intangible nil read-only nil)))) -(defun facemenu-read-color (&optional prompt) - "Read a color using the minibuffer." - (let* ((completion-ignore-case t) - (color-list (or facemenu-color-alist (defined-colors))) - (completer - (lambda (string pred all-completions) - (if all-completions - (or (all-completions string color-list pred) - (if (color-defined-p string) - (list string))) - (or (try-completion string color-list pred) - (if (color-defined-p string) - string))))) - (col (completing-read (or prompt "Color: ") completer nil t))) - (if (equal "" col) - nil - col))) +(defalias 'facemenu-read-color 'read-color) (defun color-rgb-to-hsv (r g b) "For R, G, B color components return a list of hue, saturation, value.
--- a/lisp/faces.el Sun Oct 24 13:24:24 2010 -0400 +++ b/lisp/faces.el Sun Oct 24 14:43:31 2010 -0400 @@ -1676,89 +1676,76 @@ (t (> (tty-color-gray-shades display) 2))))) -(defun read-color (&optional prompt convert-to-RGB-p allow-empty-name-p msg-p) - "Read a color name or RGB hex value: #RRRRGGGGBBBB. -Completion is available for color names, but not for RGB hex strings. -If the user inputs an RGB hex string, it must have the form -#XXXXXXXXXXXX or XXXXXXXXXXXX, where each X is a hex digit. The -number of Xs must be a multiple of 3, with the same number of Xs for -each of red, green, and blue. The order is red, green, blue. +(defun read-color (&optional prompt convert-to-RGB allow-empty-name msg) + "Read a color name or RGB triplet of the form \"#RRRRGGGGBBBB\". +Completion is available for color names, but not for RGB triplets. -In addition to standard color names and RGB hex values, the following -are available as color candidates. In each case, the corresponding -color is used. +RGB triplets have the form #XXXXXXXXXXXX, where each X is a hex +digit. The number of Xs must be a multiple of 3, with the same +number of Xs for each of red, green, and blue. The order is red, +green, blue. + +In addition to standard color names and RGB hex values, the +following are available as color candidates. In each case, the +corresponding color is used. * `foreground at point' - foreground under the cursor * `background at point' - background under the cursor -Checks input to be sure it represents a valid color. If not, raises -an error (but see exception for empty input with non-nil -ALLOW-EMPTY-NAME-P). +Optional arg PROMPT is the prompt; if nil, use a default prompt. -Optional arg PROMPT is the prompt; if nil, uses a default prompt. - -Interactively, or with optional arg CONVERT-TO-RGB-P non-nil, converts -an input color name to an RGB hex string. Returns the RGB hex string. +Interactively, or with optional arg CONVERT-TO-RGB-P non-nil, +convert an input color name to an RGB hex string. Return the RGB +hex string. -Optional arg ALLOW-EMPTY-NAME-P controls what happens if the user -enters an empty color name (that is, just hits `RET'). If non-nil, -then returns an empty color name, \"\". If nil, then raises an error. -Programs must test for \"\" if ALLOW-EMPTY-NAME-P is non-nil. They -can then perform an appropriate action in case of empty input. +If optional arg ALLOW-EMPTY-NAME is non-nil, the user is allowed +to enter an empty color name (the empty string). -Interactively, or with optional arg MSG-P non-nil, echoes the color in -a message." +Interactively, or with optional arg MSG non-nil, print the +resulting color name in the echo area." (interactive "i\np\ni\np") ; Always convert to RGB interactively. (let* ((completion-ignore-case t) - (colors (append '("foreground at point" "background at point") - (defined-colors))) - (color (completing-read (or prompt "Color (name or #R+G+B+): ") - colors)) - hex-string) - (cond ((string= "foreground at point" color) - (setq color (foreground-color-at-point))) - ((string= "background at point" color) - (setq color (background-color-at-point)))) - (unless color - (setq color "")) - (setq hex-string - (string-match "^#?\\([a-fA-F0-9][a-fA-F0-9][a-fA-F0-9]\\)+$" color)) - (if (and allow-empty-name-p (string= "" color)) - "" - (when (and hex-string (not (eq (aref color 0) ?#))) - (setq color (concat "#" color))) ; No #; add it. - (unless hex-string - (when (or (string= "" color) (not (test-completion color colors))) - (error "No such color: %S" color)) - (when convert-to-RGB-p - (let ((components (x-color-values color))) - (unless components (error "No such color: %S" color)) - (unless (string-match "^#\\([a-fA-F0-9][a-fA-F0-9][a-fA-F0-9]\\)+$" color) - (setq color (format "#%04X%04X%04X" - (logand 65535 (nth 0 components)) - (logand 65535 (nth 1 components)) - (logand 65535 (nth 2 components)))))))) - (when msg-p (message "Color: `%s'" color)) - color))) + (colors (or facemenu-color-alist + (append '("foreground at point" "background at point") + (if allow-empty-name '("")) + (defined-colors)))) + (color (completing-read + (or prompt "Color (name or #RGB triplet): ") + ;; Completing function for reading colors, accepting + ;; both color names and RGB triplets. + (lambda (string pred flag) + (cond + ((null flag) ; Try completion. + (or (try-completion string colors pred) + (if (color-defined-p string) + string))) + ((eq flag t) ; List all completions. + (or (all-completions string colors pred) + (if (color-defined-p string) + (list string)))) + ((eq flag 'lambda) ; Test completion. + (or (memq string colors) + (color-defined-p string))))) + nil t)) + hex-string) -;; Commented out because I decided it is better to include the -;; duplicates in read-color's completion list. + ;; Process named colors. + (when (member color colors) + (cond ((string-equal color "foreground at point") + (setq color (foreground-color-at-point))) + ((string-equal color "background at point") + (setq color (background-color-at-point)))) + (when (and convert-to-RGB + (not (string-equal color ""))) + (let ((components (x-color-values color))) + (unless (string-match "^#\\([a-fA-F0-9][a-fA-F0-9][a-fA-F0-9]\\)+$" color) + (setq color (format "#%04X%04X%04X" + (logand 65535 (nth 0 components)) + (logand 65535 (nth 1 components)) + (logand 65535 (nth 2 components)))))))) + (when msg (message "Color: `%s'" color)) + color)) -;; (defun defined-colors-without-duplicates () -;; "Return the list of defined colors, without the no-space versions. -;; For each color name, we keep the variant that DOES have spaces." -;; (let ((result (copy-sequence (defined-colors))) -;; to-be-rejected) -;; (save-match-data -;; (dolist (this result) -;; (if (string-match " " this) -;; (push (replace-regexp-in-string " " "" -;; this) -;; to-be-rejected))) -;; (dolist (elt to-be-rejected) -;; (let ((as-found (car (member-ignore-case elt result)))) -;; (setq result (delete as-found result))))) -;; result)) (defun face-at-point () "Return the face of the character after point.
--- a/lisp/frame.el Sun Oct 24 13:24:24 2010 -0400 +++ b/lisp/frame.el Sun Oct 24 14:43:31 2010 -0400 @@ -1067,7 +1067,7 @@ "Set the background color of the selected frame to COLOR-NAME. When called interactively, prompt for the name of the color to use. To get the frame's current background color, use `frame-parameters'." - (interactive (list (facemenu-read-color "Background color: "))) + (interactive (list (read-color "Background color: "))) (modify-frame-parameters (selected-frame) (list (cons 'background-color color-name))) (or window-system @@ -1077,7 +1077,7 @@ "Set the foreground color of the selected frame to COLOR-NAME. When called interactively, prompt for the name of the color to use. To get the frame's current foreground color, use `frame-parameters'." - (interactive (list (facemenu-read-color "Foreground color: "))) + (interactive (list (read-color "Foreground color: "))) (modify-frame-parameters (selected-frame) (list (cons 'foreground-color color-name))) (or window-system @@ -1087,7 +1087,7 @@ "Set the text cursor color of the selected frame to COLOR-NAME. When called interactively, prompt for the name of the color to use. To get the frame's current cursor color, use `frame-parameters'." - (interactive (list (facemenu-read-color "Cursor color: "))) + (interactive (list (read-color "Cursor color: "))) (modify-frame-parameters (selected-frame) (list (cons 'cursor-color color-name)))) @@ -1095,7 +1095,7 @@ "Set the color of the mouse pointer of the selected frame to COLOR-NAME. When called interactively, prompt for the name of the color to use. To get the frame's current mouse color, use `frame-parameters'." - (interactive (list (facemenu-read-color "Mouse color: "))) + (interactive (list (read-color "Mouse color: "))) (modify-frame-parameters (selected-frame) (list (cons 'mouse-color (or color-name @@ -1106,7 +1106,7 @@ "Set the color of the border of the selected frame to COLOR-NAME. When called interactively, prompt for the name of the color to use. To get the frame's current border color, use `frame-parameters'." - (interactive (list (facemenu-read-color "Border color: "))) + (interactive (list (read-color "Border color: "))) (modify-frame-parameters (selected-frame) (list (cons 'border-color color-name))))