mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-26 07:33:47 +00:00
Code Issues Releases Activity

Fix 'face property handling in facemenu-add-face.

Browse Source 
* lisp/faces.el (face-list-p): Split from face-at-point.
(face-at-point): Use it.
* lisp/facemenu.el (facemenu-add-face): Likewise.

Fixes: debbugs:19912
This commit is contained in:
Ivan Shmakov 2015-02-26 18:09:48 +00:00
parent 5917b7907a
commit 619fc5c197
3 changed files with 19 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
lisp/ChangeLog
View File

@ -1,3 +1,9 @@
2015-02-26 Ivan Shmakov <ivan@siamics.net>
* faces.el (face-list-p): Split from face-at-point.
(face-at-point): Use it.
* facemenu.el (facemenu-add-face): Likewise. (Bug#19912)
2015-02-26 Oscar Fuentes <ofv@wanadoo.es>
* vc/vc.el (vc-annotate-switches): New defcustom.

2
lisp/facemenu.el
View File

@ -732,7 +732,7 @@ effect. See `facemenu-remove-face-function'."
face
(facemenu-active-faces
(cons face
(if (listp prev)
(if (face-list-p prev)
prev
(list prev)))
;; Specify the selected frame

17
lisp/faces.el
View File

@ -273,6 +273,17 @@ If FRAME is omitted or nil, use the selected frame."
(not (internal-lisp-face-empty-p face frame)))
(defun face-list-p (face-or-list)
"True if FACE-OR-LIST is a list of faces.
Return nil if FACE-OR-LIST is a non-nil atom, or a cons cell whose car
is either 'foreground-color, 'background-color, or a keyword."
;; The logic of merge_face_ref (xfaces.c) is recreated here.
(and (listp face-or-list)
(not (memq (car face-or-list)
'(foreground-color background-color)))
(not (keywordp (car face-or-list)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Setting face attributes from X resources.
@ -1922,11 +1933,7 @@ Return nil if there is no face."
(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))))
((face-list-p faceprop)
(dolist (face faceprop)
(if (facep face)
(push face faces))))))