Mercurial > emacs

comparison lisp/faces.el @ 8999:c3a04b8a2786

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(x-create-frame-with-faces): Delete the frame if get error.
author Richard M. Stallman <rms@gnu.org>
date Thu, 22 Sep 1994 07:26:46 +0000
parents 58d6dc80af5c
children 3fe469325a8b
comparison
equal deleted inserted replaced
8998:25406f41c336 8999:c3a04b8a2786
814 (if (null global-face-data) 814 (if (null global-face-data)
815 (x-create-frame parameters) 815 (x-create-frame parameters)
816 (let* ((visibility-spec (assq 'visibility parameters)) 816 (let* ((visibility-spec (assq 'visibility parameters))
817 (frame (x-create-frame (cons '(visibility . nil) parameters))) 817 (frame (x-create-frame (cons '(visibility . nil) parameters)))
818 (faces (copy-alist global-face-data)) 818 (faces (copy-alist global-face-data))
819 success
819 (rest faces)) 820 (rest faces))
820 (set-frame-face-alist frame faces) 821 (unwind-protect
821 822 (progn
822 (if (cdr (or (assq 'reverse parameters) 823 (set-frame-face-alist frame faces)
823 (assq 'reverse default-frame-alist) 824
824 (let ((resource (x-get-resource "reverseVideo" 825 (if (cdr (or (assq 'reverse parameters)
825 "ReverseVideo"))) 826 (assq 'reverse default-frame-alist)
826 (if resource 827 (let ((resource (x-get-resource "reverseVideo"
827 (cons nil (member (downcase resource) 828 "ReverseVideo")))
828 '("on" "true"))))))) 829 (if resource
829 (let ((params (frame-parameters frame))) 830 (cons nil (member (downcase resource)
830 (modify-frame-parameters 831 '("on" "true")))))))
831 frame 832 (let ((params (frame-parameters frame)))
832 (list (cons 'foreground-color (cdr (assq 'background-color params))) 833 (modify-frame-parameters
833 (cons 'background-color (cdr (assq 'foreground-color params))) 834 frame
834 (cons 'mouse-color (cdr (assq 'background-color params))) 835 (list (cons 'foreground-color (cdr (assq 'background-color params)))
835 (cons 'border-color (cdr (assq 'background-color params))))) 836 (cons 'background-color (cdr (assq 'foreground-color params)))
836 (modify-frame-parameters 837 (cons 'mouse-color (cdr (assq 'background-color params)))
837 frame 838 (cons 'border-color (cdr (assq 'background-color params)))))
838 (list (cons 'cursor-color (cdr (assq 'background-color params))))))) 839 (modify-frame-parameters
839 840 frame
840 ;; Copy the vectors that represent the faces. 841 (list (cons 'cursor-color (cdr (assq 'background-color params)))))))
841 ;; Also fill them in from X resources. 842
842 (while rest 843 ;; Copy the vectors that represent the faces.
843 (let ((global (cdr (car rest)))) 844 ;; Also fill them in from X resources.
844 (setcdr (car rest) (vector 'face 845 (while rest
845 (face-name (cdr (car rest))) 846 (let ((global (cdr (car rest))))
846 (face-id (cdr (car rest))) 847 (setcdr (car rest) (vector 'face
847 nil nil nil nil nil)) 848 (face-name (cdr (car rest)))
848 (face-fill-in (car (car rest)) global frame)) 849 (face-id (cdr (car rest)))
849 (make-face-x-resource-internal (cdr (car rest)) frame t) 850 nil nil nil nil nil))
850 (setq rest (cdr rest))) 851 (face-fill-in (car (car rest)) global frame))
851 (if (null visibility-spec) 852 (make-face-x-resource-internal (cdr (car rest)) frame t)
852 (make-frame-visible frame) 853 (setq rest (cdr rest)))
853 (modify-frame-parameters frame (list visibility-spec))) 854 (if (null visibility-spec)
854 frame))) 855 (make-frame-visible frame)
856 (modify-frame-parameters frame (list visibility-spec)))
857 (setq success t)
858 frame)
859 (or success
860 (delete-frame frame))))))
855 861
856 ;; Update a frame's faces when we change its default font. 862 ;; Update a frame's faces when we change its default font.
857 (defun frame-update-faces (frame) 863 (defun frame-update-faces (frame)
858 (let* ((faces global-face-data) 864 (let* ((faces global-face-data)
859 (rest faces)) 865 (rest faces))