Github/emacs
2
0
Fork 1
mirror of git://git.sv.gnu.org/emacs.git synced 2026-02-16 17:24:23 +00:00
Code Issues Projects Releases Packages Wiki Activity

Merge read-color and facemenu-read-color (Bug#7242).

Browse source 
* 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.
This commit is contained in:
Chong Yidong 2010-10-24 14:43:31 -04:00
parent 59dd6f738c
commit 9317e49920
5 changed files with 87 additions and 95 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
etc/NEWS
View file

@ -663,6 +663,12 @@ argument is supplied (see Trash changes, above).
** 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'

15
lisp/ChangeLog
View file

@ -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

22
lisp/facemenu.el
View file

@ -358,7 +358,7 @@ inserted. Moving point or switching buffers before
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 @@ inserted. Moving point or switching buffers before
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 @@ These special properties include `invisible', `intangible' and `read-only'."
(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.

129
lisp/faces.el
View file

@ -1676,89 +1676,76 @@ If omitted or nil, that stands for the selected frame's display."
(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,
convert an input color name to an RGB hex string. Return the RGB
hex string.
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.
If optional arg ALLOW-EMPTY-NAME is non-nil, the user is allowed
to enter an empty color name (the empty 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.
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.

10
lisp/frame.el
View file

@ -1067,7 +1067,7 @@ See `modify-frame-parameters'."
"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 @@ To get the frame's current background color, use `frame-parameters'."
"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 @@ To get the frame's current foreground color, use `frame-parameters'."
"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 @@ To get the frame's current cursor color, use `frame-parameters'."
"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 @@ To get the frame's current mouse color, use `frame-parameters'."
"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))))