NOTE: This patch has been committed. The version below is informational only. In particular, whitespace differences have been removed. Andreas Röhler <andreas.roehler(a)online.de&gt; wrote: 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(a)xemacs.org&gt; 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(a)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(a)xemacs.org _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches