[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] /srv/bzr/emacs/trunk r112273: faces.el (read-face-name): D
From: |
Roland Winkler |
Subject: |
[Emacs-diffs] /srv/bzr/emacs/trunk r112273: faces.el (read-face-name): Do not override value of arg default, call instead face-at-point |
Date: |
Fri, 12 Apr 2013 20:10:09 -0500 |
User-agent: |
Bazaar (2.5.0) |
------------------------------------------------------------
revno: 112273
committer: Roland Winkler <address@hidden>
branch nick: trunk
timestamp: Fri 2013-04-12 20:10:09 -0500
message:
faces.el (read-face-name): Do not override value of arg default, call instead
face-at-point
modified:
lisp/ChangeLog
lisp/cus-edit.el
lisp/cus-theme.el
lisp/face-remap.el
lisp/facemenu.el
lisp/faces.el
=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog 2013-04-12 13:56:03 +0000
+++ b/lisp/ChangeLog 2013-04-13 01:10:09 +0000
@@ -1,3 +1,21 @@
+2013-04-12 Roland Winkler <address@hidden>
+
+ * faces.el (read-face-name): Do not override value of arg default.
+ Allow single faces and strings as default values. Remove those
+ elements from return value that are not faces.
+ (describe-face): Simplify.
+ (face-at-point): New optional args thing and multiple so that this
+ function can provide the same functionality previously provided by
+ read-face-name.
+ (make-face-bold, make-face-unbold, make-face-italic)
+ (make-face-unitalic, make-face-bold-italic, invert-face)
+ (modify-face, read-face-and-attribute): Use face-at-point.
+
+ * cus-edit.el (customize-face, customize-face-other-window)
+ * cus-theme.el (custom-theme-add-face)
+ * face-remap.el (buffer-face-set)
+ * facemenu.el (facemenu-set-face): Use face-at-point.
+
2013-04-12 Michael Albinus <address@hidden>
* info.el (Info-file-list-for-emacs): Add "tramp" and "dbus".
=== modified file 'lisp/cus-edit.el'
--- a/lisp/cus-edit.el 2013-02-12 04:46:18 +0000
+++ b/lisp/cus-edit.el 2013-04-13 01:10:09 +0000
@@ -1319,7 +1319,8 @@
Interactively, when point is on text which has a face specified,
suggest to customize that face, if it's customizable."
- (interactive (list (read-face-name "Customize face" "all faces" t)))
+ (interactive (list (read-face-name "Customize face"
+ (or (face-at-point t t) "all faces") t)))
(if (member face '(nil ""))
(setq face (face-list)))
(if (and (listp face) (null (cdr face)))
@@ -1350,7 +1351,8 @@
Interactively, when point is on text which has a face specified,
suggest to customize that face, if it's customizable."
- (interactive (list (read-face-name "Customize face" "all faces" t)))
+ (interactive (list (read-face-name "Customize face"
+ (or (face-at-point t t) "all faces") t)))
(customize-face face t))
(defalias 'customize-customized 'customize-unsaved)
=== modified file 'lisp/cus-theme.el'
--- a/lisp/cus-theme.el 2013-01-01 09:11:05 +0000
+++ b/lisp/cus-theme.el 2013-04-13 01:10:09 +0000
@@ -263,7 +263,7 @@
(defun custom-theme-add-face (face &optional spec)
"Add a widget for FACE (a symbol) to the *New Custom Theme* buffer.
SPEC, if non-nil, should be a face spec to which to set the widget."
- (interactive (list (read-face-name "Face name" nil nil) nil))
+ (interactive (list (read-face-name "Face name" (face-at-point t))))
(unless (or (facep face) spec)
(error "`%s' has no face definition" face))
(let ((entry (assq face custom-theme-faces)))
=== modified file 'lisp/face-remap.el'
--- a/lisp/face-remap.el 2013-01-01 09:11:05 +0000
+++ b/lisp/face-remap.el 2013-04-13 01:10:09 +0000
@@ -378,7 +378,7 @@
This function makes the variable `buffer-face-mode-face' buffer
local, and sets it to FACE."
- (interactive (list (read-face-name "Set buffer face")))
+ (interactive (list (read-face-name "Set buffer face" (face-at-point t))))
(while (and (consp specs) (null (cdr specs)))
(setq specs (car specs)))
(if (null specs)
=== modified file 'lisp/facemenu.el'
--- a/lisp/facemenu.el 2013-03-27 16:03:15 +0000
+++ b/lisp/facemenu.el 2013-04-13 01:10:09 +0000
@@ -329,7 +329,7 @@
if `facemenu-listed-faces' says to do that."
(interactive (list (progn
(barf-if-buffer-read-only)
- (read-face-name "Use face"))
+ (read-face-name "Use face" (face-at-point t)))
(if (and mark-active (not current-prefix-arg))
(region-beginning))
(if (and mark-active (not current-prefix-arg))
=== modified file 'lisp/faces.el'
--- a/lisp/faces.el 2013-04-04 02:12:25 +0000
+++ b/lisp/faces.el 2013-04-13 01:10:09 +0000
@@ -757,7 +757,8 @@
FRAME nil or not specified means change face on all frames.
Argument NOERROR is ignored and retained for compatibility.
Use `set-face-attribute' for finer control of the font weight."
- (interactive (list (read-face-name "Make which face bold")))
+ (interactive (list (read-face-name "Make which face bold"
+ (face-at-point t))))
(set-face-attribute face frame :weight 'bold))
@@ -765,7 +766,8 @@
"Make the font of FACE be non-bold, if possible.
FRAME nil or not specified means change face on all frames.
Argument NOERROR is ignored and retained for compatibility."
- (interactive (list (read-face-name "Make which face non-bold")))
+ (interactive (list (read-face-name "Make which face non-bold"
+ (face-at-point t))))
(set-face-attribute face frame :weight 'normal))
@@ -774,7 +776,8 @@
FRAME nil or not specified means change face on all frames.
Argument NOERROR is ignored and retained for compatibility.
Use `set-face-attribute' for finer control of the font slant."
- (interactive (list (read-face-name "Make which face italic")))
+ (interactive (list (read-face-name "Make which face italic"
+ (face-at-point t))))
(set-face-attribute face frame :slant 'italic))
@@ -782,7 +785,8 @@
"Make the font of FACE be non-italic, if possible.
FRAME nil or not specified means change face on all frames.
Argument NOERROR is ignored and retained for compatibility."
- (interactive (list (read-face-name "Make which face non-italic")))
+ (interactive (list (read-face-name "Make which face non-italic"
+ (face-at-point t))))
(set-face-attribute face frame :slant 'normal))
@@ -791,7 +795,8 @@
FRAME nil or not specified means change face on all frames.
Argument NOERROR is ignored and retained for compatibility.
Use `set-face-attribute' for finer control of font weight and slant."
- (interactive (list (read-face-name "Make which face bold-italic")))
+ (interactive (list (read-face-name "Make which face bold-italic"
+ (face-at-point t))))
(set-face-attribute face frame :weight 'bold :slant 'italic))
@@ -911,7 +916,7 @@
If FACE specifies neither foreground nor background color,
set its foreground and background to the background and foreground
of the default face. Value is FACE."
- (interactive (list (read-face-name "Invert face")))
+ (interactive (list (read-face-name "Invert face" (face-at-point t))))
(let ((fg (face-attribute face :foreground frame))
(bg (face-attribute face :background frame)))
(if (not (and (eq fg 'unspecified) (eq bg 'unspecified)))
@@ -929,85 +934,54 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun read-face-name (prompt &optional default multiple)
- "Read one or more face names, defaulting to the face(s) at point.
-PROMPT should be a prompt string; it should not end in a space or
-a colon.
-
-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 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 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.
+ "Read one or more face names, prompting with PROMPT.
+PROMPT should not end in a space or a colon.
+
+Return DEFAULT if the user enters the empty string.
+If DEFAULT is non-nil, it should be a list of face names (symbols or strings).
+In that case, return the `car' of DEFAULT (if MULTIPLE is non-nil),
+or DEFAULT (if MULTIPLE is nil). See below for the meaning of MULTIPLE.
+DEFAULT can also be a single 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."
- ;; Should we better not generate automagically a value for DEFAULT
- ;; when `read-face-name' was called with DEFAULT being nil?
- ;; Such magic is somewhat unusual for a function `read-...'.
- ;; Also, one cannot skip this magic by means of a suitable
- ;; value of DEFAULT. It would be cleaner to use
- ;; (read-face-name prompt (face-at-point)).
- (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.
- (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)
+as the separator regexp. Thus, the user may enter multiple face names,
+separated by commas.
+
+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,
+return 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."
+ (if (and default (not (stringp default)))
+ (setq default
+ (cond ((symbolp default)
+ (symbol-name default))
+ (multiple
+ (mapconcat (lambda (f) (if (symbolp f) (symbol-name f) f))
+ default ", "))
+ ;; If we only want one, and the default is more than one,
+ ;; discard the unwanted ones.
+ (t (symbol-name (car default))))))
+
+ (let (aliasfaces nonaliasfaces faces)
+ ;; Build up the completion tables.
(mapatoms (lambda (s)
- (if (custom-facep s)
+ (if (facep s)
(if (get s 'face-alias)
(push (symbol-name s) aliasfaces)
(push (symbol-name s) nonaliasfaces)))))
-
- (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
- faces
- (car faces)))))
+ (dolist (face (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))
+ ;; Ignore elements that are not faces
+ ;; (for example, because DEFAULT was "all faces")
+ (if (facep face) (push (intern face) faces)))
+ ;; Return either a list of faces or just one face.
+ (if multiple
+ (nreverse faces)
+ (last faces))))
;; Not defined without X, but behind window-system test.
(defvar x-bitmap-file-path)
@@ -1235,7 +1209,7 @@
:slant (if italic-p 'italic 'normal)
:underline underline
:inverse-video inverse-p)
- (setq face (read-face-name "Modify face"))
+ (setq face (read-face-name "Modify face" (face-at-point t)))
(apply #'set-face-attribute face frame
(read-all-face-attributes face frame))))
@@ -1247,13 +1221,13 @@
\(a symbol), and NEW-VALUE is value read."
(cond ((eq attribute :font)
(let* ((prompt "Set font-related attributes of face")
- (face (read-face-name prompt))
+ (face (read-face-name prompt (face-at-point t)))
(font (read-face-font face frame)))
(list face font)))
(t
(let* ((attribute-name (face-descriptive-attribute-name attribute))
(prompt (format "Set %s of face" attribute-name))
- (face (read-face-name prompt))
+ (face (read-face-name prompt (face-at-point t)))
(new-value (read-face-attribute face attribute frame)))
(list face new-value)))))
@@ -1363,8 +1337,7 @@
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"
- (if (eq 'default (face-at-point))
- '(default))
+ (or (face-at-point t) 'default)
t)))
(let* ((attrs '((:family . "Family")
(:foundry . "Foundry")
@@ -1879,23 +1852,33 @@
(when msg (message "Color: `%s'" color))
color))
-
-(defun face-at-point ()
+(defun face-at-point (&optional thing multiple)
"Return the face of the character after point.
If it has more than one face, return the first one.
-Return nil if it has no specified face."
- (let* ((faceprop (or (get-char-property (point) 'read-face-name)
- (get-char-property (point) 'face)
- 'default))
- (face (cond ((symbolp faceprop) faceprop)
- ;; List of faces (don't treat an attribute spec).
- ;; Just use the first face.
- ((and (consp faceprop) (not (keywordp (car faceprop)))
- (not (memq (car faceprop)
- '(foreground-color background-color))))
- (car faceprop))
- (t nil)))) ; Invalid face value.
- (if (facep face) face nil)))
+If THING is non-nil try first to get a face name from the buffer.
+IF MULTIPLE is non-nil, return a list of all faces.
+Return nil if there is no face."
+ (let (faces)
+ (if thing
+ ;; Try to get a face name from the buffer.
+ (let ((face (intern-soft (thing-at-point 'symbol))))
+ (if (facep face)
+ (push face faces))))
+ ;; Add the named faces that the `read-face-name' or `face' property uses.
+ (let ((faceprop (or (get-char-property (point) 'read-face-name)
+ (get-char-property (point) 'face))))
+ (cond ((facep faceprop)
+ (push faceprop faces))
+ ((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 (facep face)
+ (push face faces))))))
+ (setq faces (delete-dups (nreverse faces)))
+ (if multiple faces (car faces))))
(defun foreground-color-at-point ()
"Return the foreground color of the character after point."
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] /srv/bzr/emacs/trunk r112273: faces.el (read-face-name): Do not override value of arg default, call instead face-at-point,
Roland Winkler <=