[COMMIT] Re: customize-face default value

[Didier Verna]

NOTE: This patch has been committed. The version below is informational
only. In particular, whitespace differences have been removed.


Andreas Röhler <andreas.roehler at online.de> wrote:

> With M-x `customize-face', diff below delivers face at
> point per default for customization.
>
> One strange thing remains: to accept default, user
> can't use num-pads "Enter"-key, keyboard-return must be
> pressed.

  FWIW, I don't get this behavior.

As for the patch, this is a good suggestion. You patch however will
break when there are several faces at point (in which case
get-char-property gives you a *list* of faces), and it doesn't update
customize-face-other-window accordingly either. Besides, the user might
not want to get this default value at all.

I've applied the following patch instead. It lets you call
customize-face[-other-window] with an optional prefix that will let you
make your choice amongst the faces at current point, instead of all of
them. See the updated docstrings for more information.


I hope you'll find it satisfactory.
Thanks for the feedback !



lisp/ChangeLog addition:

2008-03-05  Didier Verna  <didier at xemacs.org>

	Ease customization of face(s) under point.
	Suggested by Andreas Rohler.

	* cus-edit.el (custom-face-prompt): New (interactive call). Offer
	a prefix for choosing a face amongst those at point instead of all
	of them.
	* cus-edit.el (customize-face-1): New. Factor out from the
	functions below.
	* cus-edit.el (customize-face): Use it.
	* cus-edit.el (customize-face-other-window): Ditto.


XEmacs 21.5 source patch:
Diff command:   hg diff -wbB
Files affected: lisp/cus-edit.el

diff -r 1bf48c59700e lisp/cus-edit.el
--- lisp/cus-edit.el	Wed Mar 05 01:12:53 2008 -0800
+++ lisp/cus-edit.el	Wed Mar 05 10:34:59 2008 +0100
@@ -1,6 +1,6 @@
 ;;; cus-edit.el --- Tools for customizating Emacs and Lisp packages.
 ;;
-;; Copyright (C) 2007 Didier Verna
+;; Copyright (C) 2007, 2008 Didier Verna
 ;; Copyright (C) 2003 Ben Wing
 ;; Copyright (C) 1996, 1997, 2000 Free Software Foundation, Inc.
 ;;
@@ -870,39 +870,86 @@ Show the buffer in another window, but d
    (list (list symbol 'custom-variable))
    (format "*Customize Option: %s*" (custom-unlispify-tag-name symbol))))
 
-;;;###autoload
-(defun customize-face (&optional symbol)
-  "Customize SYMBOL, which should be a face name or nil.
-If SYMBOL is nil, customize all faces."
-  (interactive (list (completing-read "Customize face: (default all) "
-				      obarray 'find-face)))
-  (if (or (null symbol) (and (stringp symbol) (zerop (length symbol))))
-      (custom-buffer-create (custom-sort-items
-			     (mapcar (lambda (symbol)
-				       (list symbol 'custom-face))
-				     (face-list))
-			     t nil)
-			    "*Customize Faces*")
-    (when (stringp symbol)
-      (setq symbol (intern symbol)))
-    (check-argument-type 'symbolp symbol)
-    (custom-buffer-create (list (list symbol 'custom-face))
-			  (format "*Customize Face: %s*"
-				  (custom-unlispify-tag-name symbol)))))
-
-;;;###autoload
-(defun customize-face-other-window (&optional symbol)
-  "Show customization buffer for FACE in other window."
-  (interactive (list (completing-read "Customize face: "
-				      obarray 'find-face)))
-  (if (or (null symbol) (and (stringp symbol) (zerop (length symbol))))
-      ()
-    (if (stringp symbol)
-	(setq symbol (intern symbol)))
-    (check-argument-type 'symbolp symbol)
-    (custom-buffer-create-other-window
-     (list (list symbol 'custom-face))
-     (format "*Customize Face: %s*" (custom-unlispify-tag-name symbol)))))
+
+(defun custom-face-prompt ()
+  ;; Interactive call for `customize-face' and `customize-face-other-window'.
+  ;; See their docstrings for more information. Note that this call returns a
+  ;; list of only one element. This is because the callers'second arg AT-POINT
+  ;; is only used in interactive calls.
+  (let ((faces (get-char-property (point) 'face)))
+    (if (or (null faces) (not current-prefix-arg))
+	;; The default behavior, which is to prompt for all faces, is also
+	;; used as a fall back when a prefix is given but there's no face
+	;; under point:
+	(let ((choice (completing-read "Customize face: (default all) "
+				       obarray 'find-face)))
+	  (if (zerop (length choice))
+	      nil
+	    (list (intern choice))))
+      (cond ((symbolp faces)
+	     ;; Customize only this one:
+	     (list (list faces)))
+	    ((listp faces)
+	     ;; Make a choice only amongst the faces under point:
+	     (let ((choice (completing-read
+			    "Customize face: (default all faces at point) "
+			    (mapcar (lambda (face)
+				      (list (symbol-name face) face))
+				    faces)
+			    nil t)))
+	       (if (zerop (length choice))
+		   (list faces)
+		 (list (intern choice)))))))))
+
+(defun customize-face-1 (face custom-buffer-create-fn)
+  ;; Customize FACE in a buffer created with BUFFER-CREATE-FN.
+  ;; See the docstring of `customize-face' and `customize-face-other-window'
+  ;; for more information.
+  (cond ((null face)
+	 (funcall custom-buffer-create-fn
+		  (custom-sort-items
+		   (mapcar (lambda (symbol)
+			     (list symbol 'custom-face))
+			   (face-list))
+		   t nil)
+		  "*Customize All Faces*"))
+	((listp face)
+	 (funcall custom-buffer-create-fn
+		  (custom-sort-items
+		   (mapcar (lambda (symbol)
+			     (list symbol 'custom-face))
+			   face)
+		   t nil)
+		  "*Customize Some Faces*"))
+	((symbolp face)
+	 (funcall custom-buffer-create-fn
+		  (list (list face 'custom-face))
+		  (format "*Customize Face: %s*"
+			  (custom-unlispify-tag-name face))))
+	(t
+	 (signal-error 'wrong-type-argument
+		       '((or null listp symbolp) face)))))
+
+
+;;;###autoload
+(defun customize-face (&optional face at-point)
+  "Open a customization buffer for FACE.
+FACE should be either:
+- nil, meaning to customize all faces,
+- a list of symbols naming faces, meaning to customize only those,
+- a symbol naming a face, meaning to customize this face only.
+
+When called interactively, use a prefix (the AT-POINT argument) to
+make a choice among the faces found at current position."
+  (interactive (custom-face-prompt))
+  (customize-face-1 face #'custom-buffer-create))
+
+;;;###autoload
+(defun customize-face-other-window (&optional face at-point)
+  "Like `customize-face', but use another window."
+  (interactive (custom-face-prompt))
+  (customize-face-1 face #'custom-buffer-create-other-window))
+
 
 ;;;###autoload
 (defun customize-customized ()

-- 
5th European Lisp Workshop at ECOOP 2008, July 7: http://elw.bknr.net/2008/

Didier Verna, didier at lrde.epita.fr, http://www.lrde.epita.fr/~didier

EPITA / LRDE, 14-16 rue Voltaire   Tel.+33 (0)1 44 08 01 85
94276 Le Kremlin-Bicêtre, France   Fax.+33 (0)1 53 14 59 22  didier at xemacs.org