* make read-face-name behave as promised
@ 2013-04-01 1:35 Roland Winkler
2013-04-03 17:57 ` Stefan Monnier
0 siblings, 1 reply; 3+ messages in thread
From: Roland Winkler @ 2013-04-01 1:35 UTC (permalink / raw)
To: emacs-devel
[-- Attachment #1: message body text --]
[-- Type: text/plain, Size: 1141 bytes --]
After fixing a bug in completing-read-multiple (remove empty strings
from the list of read strings) I thought I could also clean up
read-face-name, which worked around this bug.
Yet I got side-tracked by the fact that currently read-face-name
does not behave as promised by its doc string:
- The arg DEFAULT is treated like a single string, though the doc
string says it should be a list of faces.
- The arg DEFAULT is ignored if the text at point has a
`read-face-name' or `face' property. This appears like a bug to me
because it makes the arg DEFAULT useless in this case.
- If the thing at point is a face, this is taken as the first element
of DEFAULT.
The patch below makes read-face-name behave as promised by its doc
string. Yet this may cause trouble elsewhere if code relies on the
current behavior of read-face-name. So I first wanted to post this
patch to emacs-devel. In the emacs trunk, I found only one function
(describe-face) that relies on the current behavior of
read-face-name. So the patch below fixes this, too. But there might
be other emacs packages (not part of the trunk) that I do not know
about.
[-- Attachment #2: faces.patch --]
[-- Type: application/octet-stream, Size: 6203 bytes --]
=== modified file 'lisp/faces.el'
--- lisp/faces.el 2013-01-10 03:43:02 +0000
+++ lisp/faces.el 2013-04-01 01:29:04 +0000
@@ -935,80 +935,75 @@
The optional argument DEFAULT specifies the default face name(s)
to return if the user just types RET. If its value is non-nil,
-it should be a list of face names (symbols); in that case, the
-default return value is the `car' of DEFAULT (if the argument
+it should be a list of face names (symbols or strings); in that case,
+the default return value is the `car' of DEFAULT (if the argument
MULTIPLE is non-nil), or DEFAULT (if MULTIPLE is nil). See below
for the meaning of MULTIPLE.
If DEFAULT is nil, the list of default face names is taken from
-the `read-face-name' property of the text at point, or, if that
-is nil, from the `face' property of the text at point.
+the symbol at point and the `read-face-name' property of the text at point,
+or, if that is nil, from the `face' property of the text at point.
-This function uses `completing-read-multiple' with \",\" as the
-separator character. Thus, the user may enter multiple face
+This function uses `completing-read-multiple' with \"[ \\t]*,[ \\t]*\"
+as the separator regexp. Thus, the user may enter multiple face
names, separated by commas. The optional argument MULTIPLE
specifies the form of the return value. If MULTIPLE is non-nil,
return a list of face names; if the user entered just one face
name, the return value would be a list of one face name.
Otherwise, return a single face name; if the user entered more
than one face name, return only the first one."
- (let ((faceprop (or (get-char-property (point) 'read-face-name)
- (get-char-property (point) 'face)))
- (aliasfaces nil)
- (nonaliasfaces nil)
- faces)
- ;; Try to get a face name from the buffer.
- (if (memq (intern-soft (thing-at-point 'symbol)) (face-list))
- (setq faces (list (intern-soft (thing-at-point 'symbol)))))
- ;; Add the named faces that the `face' property uses.
- (if (and (listp faceprop)
- ;; Don't treat an attribute spec as a list of faces.
- (not (keywordp (car faceprop)))
- (not (memq (car faceprop) '(foreground-color background-color))))
- (dolist (f faceprop)
- (if (symbolp f)
- (push f faces)))
- (if (symbolp faceprop)
- (push faceprop faces)))
- (delete-dups faces)
-
- ;; Build up the completion tables.
+ (unless default
+ ;; Try to get a default face name from the buffer.
+ (let ((thing (intern-soft (thing-at-point 'symbol))))
+ (if (memq thing (face-list))
+ (setq default (list thing))))
+ ;; Add the named faces that the `read-face-name' or `face' property uses.
+ ;; Should we use the default face (as in `face-at-point') if both
+ ;; the `read-face-name' or `face' properties are nil?
+ (let ((faceprop (or (get-char-property (point) 'read-face-name)
+ (get-char-property (point) 'face))))
+ (if (and (listp faceprop)
+ ;; Don't treat an attribute spec as a list of faces.
+ (not (keywordp (car faceprop)))
+ (not (memq (car faceprop) '(foreground-color background-color))))
+ (dolist (face faceprop)
+ (if (symbolp face)
+ (push face default)))
+ (if (symbolp faceprop)
+ (push faceprop default)))
+ (delete-dups default)))
+
+ ;; If we only want one, and the default is more than one,
+ ;; discard the unwanted ones now.
+ (if (and default (not multiple))
+ (setq default (list (car default))))
+
+ (if default
+ (setq default (mapconcat (lambda (f)
+ (if (symbolp f) (symbol-name f) f))
+ default ", ")))
+
+ ;; Build up the completion tables.
+ (let (aliasfaces nonaliasfaces)
(mapatoms (lambda (s)
(if (custom-facep s)
(if (get s 'face-alias)
(push (symbol-name s) aliasfaces)
(push (symbol-name s) nonaliasfaces)))))
- ;; If we only want one, and the default is more than one,
- ;; discard the unwanted ones now.
- (unless multiple
- (if faces
- (setq faces (list (car faces)))))
- (require 'crm)
- (let* ((input
- ;; Read the input.
- (completing-read-multiple
- (if (or faces default)
- (format "%s (default `%s'): " prompt
- (if faces (mapconcat 'symbol-name faces ",")
- default))
- (format "%s: " prompt))
- (completion-table-in-turn nonaliasfaces aliasfaces)
- nil t nil 'face-name-history
- (if faces (mapconcat 'symbol-name faces ","))))
- ;; Canonicalize the output.
- (output
- (cond ((or (equal input "") (equal input '("")))
- (or faces (unless (stringp default) default)))
- ((stringp input)
- (mapcar 'intern (split-string input ", *" t)))
- ((listp input)
- (mapcar 'intern input))
- (input))))
+ (let ((faces
+ ;; Read the faces.
+ (mapcar 'intern
+ (completing-read-multiple
+ (if default
+ (format "%s (default `%s'): " prompt default)
+ (format "%s: " prompt))
+ (completion-table-in-turn nonaliasfaces aliasfaces)
+ nil t nil 'face-name-history default))))
;; Return either a list of faces or just one face.
(if multiple
- output
- (car output)))))
+ faces
+ (car faces)))))
;; Not defined without X, but behind window-system test.
(defvar x-bitmap-file-path)
@@ -1363,7 +1358,10 @@
If the optional argument FRAME is given, report on face FACE in that frame.
If FRAME is t, report on the defaults for face FACE (for new frames).
If FRAME is omitted or nil, use the selected frame."
- (interactive (list (read-face-name "Describe face" 'default t)))
+ (interactive (list (read-face-name "Describe face"
+ (if (eq 'default (face-at-point))
+ '(default))
+ t)))
(let* ((attrs '((:family . "Family")
(:foundry . "Foundry")
(:width . "Width")
^ permalink raw reply [flat|nested] 3+ messages in thread
* Re: make read-face-name behave as promised
2013-04-01 1:35 make read-face-name behave as promised Roland Winkler
@ 2013-04-03 17:57 ` Stefan Monnier
2013-04-04 2:13 ` Roland Winkler
0 siblings, 1 reply; 3+ messages in thread
From: Stefan Monnier @ 2013-04-03 17:57 UTC (permalink / raw)
To: Roland Winkler; +Cc: emacs-devel
> The patch below makes read-face-name behave as promised by its doc
> string. Yet this may cause trouble elsewhere if code relies on the
> current behavior of read-face-name. So I first wanted to post this
> patch to emacs-devel. In the emacs trunk, I found only one function
> (describe-face) that relies on the current behavior of
> read-face-name. So the patch below fixes this, too. But there might
> be other emacs packages (not part of the trunk) that I do not know
> about.
The patch looks fine to me. The best way to find out if it breaks other
uses is to install it in the trunk and see who screams.
Stefan
^ permalink raw reply [flat|nested] 3+ messages in thread
* Re: make read-face-name behave as promised
2013-04-03 17:57 ` Stefan Monnier
@ 2013-04-04 2:13 ` Roland Winkler
0 siblings, 0 replies; 3+ messages in thread
From: Roland Winkler @ 2013-04-04 2:13 UTC (permalink / raw)
To: Stefan Monnier; +Cc: emacs-devel
On Wed Apr 3 2013 Stefan Monnier wrote:
> The patch looks fine to me. The best way to find out if it breaks
> other uses is to install it in the trunk and see who screams.
Installed. (revision 112218)
^ permalink raw reply [flat|nested] 3+ messages in thread
end of thread, other threads:[~2013-04-04 2:13 UTC | newest]
Thread overview: 3+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2013-04-01 1:35 make read-face-name behave as promised Roland Winkler
2013-04-03 17:57 ` Stefan Monnier
2013-04-04 2:13 ` Roland Winkler
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).