comparison lisp/faces.el @ 83395:b31326248cf6

Merged from miles@gnu.org--gnu-2005 (patch 142-148, 615-628) Patches applied: * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-615 Merge from gnus--rel--5.10 * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-616 Add lisp/mh-e/.arch-inventory * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-617 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-618 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-619 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-620 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-621 Merge from gnus--rel--5.10 * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-622 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-623 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-624 Update from CVS: lisp/smerge-mode.el: Add 'tools' to file keywords. * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-625 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-626 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-627 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-628 Update from CVS * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-142 Update from CVS * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-143 Update from CVS * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-144 Update from CVS * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-145 Update from CVS * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-146 Update from CVS * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-147 Update from CVS * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-148 Update from CVS git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-435
author Karoly Lorentey <lorentey@elte.hu>
date Tue, 01 Nov 2005 06:23:08 +0000
parents 2a679c81f552 fcb2ec449238
children 693e794b57bf
comparison
equal deleted inserted replaced
83394:7d093d9d4479 83395:b31326248cf6
31 (require 'cl) 31 (require 'cl)
32 ;; Warning suppression -- can't require x-win in batch: 32 ;; Warning suppression -- can't require x-win in batch:
33 (autoload 'xw-defined-colors "x-win")) 33 (autoload 'xw-defined-colors "x-win"))
34 34
35 (defvar help-xref-stack-item) 35 (defvar help-xref-stack-item)
36
37 36
38 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 37 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
39 ;;; Font selection. 38 ;;; Font selection.
40 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 39 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
41 40
545 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 544 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
546 ;; Setting face attributes. 545 ;; Setting face attributes.
547 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 546 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
548 547
549 548
549 (defvar inhibit-face-set-after-frame-default nil
550 "If non-nil, that tells `face-set-after-frame-default' to do nothing.")
551
550 (defun set-face-attribute (face frame &rest args) 552 (defun set-face-attribute (face frame &rest args)
551 "Set attributes of FACE on FRAME from ARGS. 553 "Set attributes of FACE on FRAME from ARGS.
552 554
553 FRAME nil means change attributes on all frames. FRAME t means change 555 FRAME nil means change attributes on all frames. FRAME t means change
554 the default for new frames (this is done automatically each time an 556 the default for new frames (this is done automatically each time an
675 (setq args (purecopy args)) 677 (setq args (purecopy args))
676 ;; If we set the new-frame defaults, this face is modified outside Custom. 678 ;; If we set the new-frame defaults, this face is modified outside Custom.
677 (if (memq where '(0 t)) 679 (if (memq where '(0 t))
678 (put (or (get face 'face-alias) face) 'face-modified t)) 680 (put (or (get face 'face-alias) face) 'face-modified t))
679 (while args 681 (while args
680 (internal-set-lisp-face-attribute face (car args) 682 ;; Don't recursively set the attributes from the frame's font param
681 (purecopy (cadr args)) 683 ;; when we update the frame's font param fro the attributes.
682 where) 684 (let ((inhibit-face-set-after-frame-default t))
685 (internal-set-lisp-face-attribute face (car args)
686 (purecopy (cadr args))
687 where))
683 (setq args (cdr (cdr args)))))) 688 (setq args (cdr (cdr args))))))
684 689
685 690
686 (defun make-face-bold (face &optional frame noerror) 691 (defun make-face-bold (face &optional frame noerror)
687 "Make the font of FACE be bold, if possible. 692 "Make the font of FACE be bold, if possible.
1295 (concat "\\(" customize-label "\\)") nil t) 1300 (concat "\\(" customize-label "\\)") nil t)
1296 (help-xref-button 1 'help-customize-face f))) 1301 (help-xref-button 1 'help-customize-face f)))
1297 ;; The next 4 sexps are copied from describe-function-1 1302 ;; The next 4 sexps are copied from describe-function-1
1298 ;; and simplified. 1303 ;; and simplified.
1299 (setq file-name (symbol-file f 'defface)) 1304 (setq file-name (symbol-file f 'defface))
1305 (setq file-name (describe-simplify-lib-file-name file-name))
1300 (when file-name 1306 (when file-name
1301 (princ "Defined in `") 1307 (princ "Defined in `")
1302 (princ file-name) 1308 (princ file-name)
1303 (princ "'") 1309 (princ "'")
1304 ;; Make a hyperlink to the library. 1310 ;; Make a hyperlink to the library.
1736 (setq success t)) 1742 (setq success t))
1737 (unless success 1743 (unless success
1738 (delete-frame frame))) 1744 (delete-frame frame)))
1739 frame)) 1745 frame))
1740 1746
1741
1742 (defun face-set-after-frame-default (frame) 1747 (defun face-set-after-frame-default (frame)
1743 "Set frame-local faces of FRAME from face specs and resources. 1748 "Set frame-local faces of FRAME from face specs and resources.
1744 Initialize colors of certain faces from frame parameters." 1749 Initialize colors of certain faces from frame parameters."
1745 (if (face-attribute 'default :font t) 1750 (unless inhibit-face-set-after-frame-default
1746 (set-face-attribute 'default frame :font 1751 (if (face-attribute 'default :font t)
1747 (face-attribute 'default :font t)) 1752 (set-face-attribute 'default frame :font
1748 (set-face-attribute 'default frame :family 1753 (face-attribute 'default :font t))
1749 (face-attribute 'default :family t)) 1754 (set-face-attribute 'default frame :family
1750 (set-face-attribute 'default frame :height 1755 (face-attribute 'default :family t))
1751 (face-attribute 'default :height t)) 1756 (set-face-attribute 'default frame :height
1752 (set-face-attribute 'default frame :slant 1757 (face-attribute 'default :height t))
1753 (face-attribute 'default :slant t)) 1758 (set-face-attribute 'default frame :slant
1754 (set-face-attribute 'default frame :weight 1759 (face-attribute 'default :slant t))
1755 (face-attribute 'default :weight t)) 1760 (set-face-attribute 'default frame :weight
1756 (set-face-attribute 'default frame :width 1761 (face-attribute 'default :weight t))
1757 (face-attribute 'default :width t))) 1762 (set-face-attribute 'default frame :width
1763 (face-attribute 'default :width t))))
1758 (dolist (face (face-list)) 1764 (dolist (face (face-list))
1759 ;; Don't let frame creation fail because of an invalid face spec. 1765 ;; Don't let frame creation fail because of an invalid face spec.
1760 (condition-case () 1766 (condition-case ()
1761 (when (not (equal face 'default)) 1767 (when (not (equal face 'default))
1762 (face-spec-set face (face-user-default-spec face) frame) 1768 (face-spec-set face (face-user-default-spec face) frame)