[Emacs-diffs] /srv/bzr/emacs/trunk r102082: Merge read-color and facemenu-read-color (Bug#7242).

[Chong Yidong]

------------------------------------------------------------
revno: 102082
committer: Chong Yidong <address@hidden>
branch nick: trunk
timestamp: Sun 2010-10-24 14:43:31 -0400
message:
  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.
modified:
  etc/NEWS
  lisp/ChangeLog
  lisp/facemenu.el
  lisp/faces.el
  lisp/frame.el

=== modified file 'etc/NEWS'
--- a/etc/NEWS  2010-10-23 09:18:19 +0000
+++ b/etc/NEWS  2010-10-24 18:43:31 +0000
@@ -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'

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2010-10-24 17:24:24 +0000
+++ b/lisp/ChangeLog    2010-10-24 18:43:31 +0000
@@ -1,3 +1,18 @@
+2010-10-24  Chong Yidong  <address@hidden>
+
+       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 <address@hidden>
 
        * eshell/em-unix.el (eshell-remove-entries): Use the TRASH

=== modified file 'lisp/facemenu.el'
--- a/lisp/facemenu.el  2010-08-29 16:17:13 +0000
+++ b/lisp/facemenu.el  2010-10-24 18:43:31 +0000
@@ -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.

=== modified file 'lisp/faces.el'
--- a/lisp/faces.el     2010-10-14 03:55:18 +0000
+++ b/lisp/faces.el     2010-10-24 18:43:31 +0000
@@ -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.
-
-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.
+(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.
+
+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, 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.
-
-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."
+Optional arg PROMPT is the prompt; if nil, use 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.
+
+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 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)))
-
-;; Commented out because I decided it is better to include the
-;; duplicates in read-color's completion list.
-
-;; (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))
+        (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)
+
+    ;; 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 face-at-point ()
   "Return the face of the character after point.

=== modified file 'lisp/frame.el'
--- a/lisp/frame.el     2010-10-24 00:58:22 +0000
+++ b/lisp/frame.el     2010-10-24 18:43:31 +0000
@@ -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))))