Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
What's new
10
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Open sidebar
emacs
emacs
Commits
011cddd6
Commit
011cddd6
authored
Apr 12, 2013
by
Roland Winkler
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
faces.el (read-face-name): Do not override value of arg default, call instead face-at-point
parent
562c6ee9
Changes
6
Hide whitespace changes
Inline
Side-by-side
Showing
6 changed files
with
106 additions
and
103 deletions
+106
-103
lisp/ChangeLog
lisp/ChangeLog
+18
-0
lisp/cus-edit.el
lisp/cus-edit.el
+4
-2
lisp/cus-theme.el
lisp/cus-theme.el
+1
-1
lisp/face-remap.el
lisp/face-remap.el
+1
-1
lisp/facemenu.el
lisp/facemenu.el
+1
-1
lisp/faces.el
lisp/faces.el
+81
-98
No files found.
lisp/ChangeLog
View file @
011cddd6
2013-04-12 Roland Winkler <winkler@gnu.org>
* 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 <michael.albinus@gmx.de>
* info.el (Info-file-list-for-emacs): Add "tramp" and "dbus".
...
...
lisp/cus-edit.el
View file @
011cddd6
...
...
@@ -1319,7 +1319,8 @@ If OTHER-WINDOW is non-nil, display in another window.
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 @@ If FACE is actually a face-alias, customize the face it is aliased to.
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
)
...
...
lisp/cus-theme.el
View file @
011cddd6
...
...
@@ -263,7 +263,7 @@ interactively, this defaults to the current value of VAR."
(
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
)))
...
...
lisp/face-remap.el
View file @
011cddd6
...
...
@@ -378,7 +378,7 @@ one face is listed, that specifies an aggregate face, like in a
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
)
...
...
lisp/facemenu.el
View file @
011cddd6
...
...
@@ -329,7 +329,7 @@ This command can also add FACE to the menu of faces,
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
))
...
...
lisp/faces.el
View file @
011cddd6
...
...
@@ -757,7 +757,8 @@ is specified, `:italic' is ignored."
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 @@ Use `set-face-attribute' for finer control of the font weight."
"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 @@ Argument NOERROR is ignored and retained for compatibility."
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 @@ Use `set-face-attribute' for finer control of the font slant."
"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 @@ Argument NOERROR is ignored and retained for compatibility."
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 FRAME is omitted or nil, it means change face on all frames.
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 @@ of the default face. Value is FACE."
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(
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.
"Read one or more face names, prompting with PROMPT.
PROMPT 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.
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 @@ and the face and its settings are obtained by querying the user."
: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 @@ Value is a list (FACE NEW-VALUE) where FACE is the face read
\(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 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"
(
if
(
eq
'default
(
face-at-point
))
'
(
default
))
(
or
(
face-at-point
t
)
'default
)
t
)))
(
let*
((
attrs
'
((
:family
.
"Family"
)
(
:foundry
.
"Foundry"
)
...
...
@@ -1879,23 +1852,33 @@ resulting color name in the echo area."
(
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."
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment