Skip to content
Snippets Groups Projects
xwem-faces.el 5.61 KiB
Newer Older
viteno's avatar
viteno committed
;;; xwem-faces.el --- XWEM can handle Emacs faces.

;; Copyright (C) 2003 by Free Software Foundation, Inc.

;; Author: Zajcev Evgeny <zevlg@yandex.ru>
;; Created: Mon Dec 29 12:04:19 MSK 2003
;; Keywords: xwem
;; X-CVS: $Id$

;; This file is part of XWEM.

;; XWEM is free software; you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; XWEM is distributed in the hope that it will be useful, but WITHOUT
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
;; License for more details.

;; You should have received a copy of the GNU General Public License
;; along with XEmacs; see the file COPYING.  If not, write to the Free
;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
;; 02111-1307, USA.

;;; Synched up with: Not in FSF

;;; Commentary:

;; Faces support.

;;; Code:
(require 'cus-face)			; for `custom-face-get-spec'


(defgroup xwem-faces nil
  "*Group to customize faces used by XWEM."
  :prefix "xwem-face-"
  :group 'xwem)

(defface xwem-face-white
  `((t (:foreground "white" :background "black")))
  "White color face."
  :group 'xwem-faces)
  
(defface xwem-face-black
  `((t (:foreground "black" :background "black")))
  "Black color face."
  :group 'xwem-faces)
  
(defface xwem-face-red
  `((t (:foreground "red" :background "black")))
  "Red color face."
  :group 'xwem-faces)
  
(defface xwem-face-green
  `((t (:foreground "green" :background "black")))
  "Green color face."
  :group 'xwem-faces)

(defface xwem-face-blue
  `((t (:foreground "blue" :background "black")))
  "Blue color face."
  :group 'xwem-faces)

(defface xwem-face-yellow
  `((t (:foreground "yellow" :background "black")))
  "Yellow color face."
  :group 'xwem-faces)

(defface xwem-face-cyan
  `((t (:foreground "cyan" :background "black")))
  "Cyan color face."
  :group 'xwem-faces)

(defface xwem-face-magenta
  `((t (:foreground "magenta" :background "black")))
  "Magenta color face."
  :group 'xwem-faces)

(defface xwem-face-darkgray
  `((t (:foreground "gray20" :background "black")))
  "DarkGray color face."
  :group 'xwem-faces)

(defface xwem-face-lightgray
  `((t (:foreground "gray80" :background "black")))
  "LightGray color face."
  :group 'xwem-faces)

(defface xwem-face-gray
  `((t (:foreground "gray50" :background "black")))
  "Gray color face."
  :group 'xwem-faces)

(defface xwem-face-outline1
  `((t (:foreground "red" :background "black")))
  "Face used to outline something."
  :group 'xwem-faces)

(defface xwem-face-outline2
  `((t (:foreground "blue" :background "black")))
  "Face used to outline something."
  :group 'xwem-faces)

(defface xwem-face-outline3
  `((t (:foreground "cyan" :background "black")))
  "Face used to outline something."
  :group 'xwem-faces)


;;; Functions
(defun xwem-eface-to-gc (xdpy face &optional d)
  "On display XDPY convert Emacs FACE to X graphical context.
Drawable D.
TOOD: - maybe add support for domains?."
  (let* ((cmap (XDefaultColormap xdpy))
	 (fgcol (xwem-misc-colorspec->rgb-vector-safe (face-foreground-name face) [0 0 0]))
	 (bgcol (xwem-misc-colorspec->rgb-vector-safe (face-background-name face) [0 0 0]))
	 (gc (XCreateGC
	      xdpy (or (and (X-Drawable-p d) d)
		       (XDefaultRootWindow xdpy))
	      (make-X-Gc :dpy xdpy :id (X-Dpy-get-id xdpy)
			 :line-style (xwem-face-tag face :line-style)
			 :line-width (xwem-face-tag face :line-width)
			 :cap-style (xwem-face-tag face :cap-style)
			 :join-style (xwem-face-tag face :join-style)
			 :function (xwem-face-tag face :function)
			 :subwindow-mode (xwem-face-tag face :subwindow-mode)
			 :graphics-exposures (xwem-face-tag face :graphics-exposures)
			 :foreground (XAllocColor xdpy cmap
						  (make-X-Color :id (X-Dpy-get-id xdpy)
								:cmap cmap
								:red (aref fgcol 0)
								:green (aref fgcol 1)
								:blue (aref fgcol 2)))
			 :background (XAllocColor xdpy cmap
						  (make-X-Color :id (X-Dpy-get-id xdpy)
								:cmap cmap
								:red (aref bgcol 0)
								:green (aref bgcol 1)
								:blue (aref bgcol 2)))
			 :font (X-Font-get xdpy (face-font-name face))))))

    (put face 'xwem-face-gc gc)
    gc))

;;;###autoload
(defun xwem-init-faces ()
  "Initialize faces."

  (xwem-message 'info "Initializing faces ...")

  ;; NOTE:
  ;;  - Faces initialization now dynamic.
  )

;;;###autoload
(defun xwem-face-tag (face tag)
  "Get FACE's TAG value.
For example \\(xwem-face-tag 'xwem-face-win-selected :line-width\\)."
  (let ((spec (custom-face-get-spec face)))
    (while (and spec
		(not (eq (car (car spec)) t)))
      (setq spec (cdr spec)))

    (when (car spec)
      (plist-get (cadr (car spec)) tag))))

;;;###autoload
(defun xwem-face-get-gc (name &optional xdpy d)
  "Return X-Gc with NAME.
Name can be symbol or string."
  (let ((gc (get name 'xwem-face-gc)))
    (unless (X-Gc-p gc)
      (xwem-eface-to-gc (or xdpy (xwem-dpy)) name d)
      (setq gc (get name 'xwem-face-gc)))

    gc))

;;;###autoload
(defun xwem-face-set-foreground (face fg)
  "Set FACE's foreground color to FG."
  
  (set-face-foreground face fg)

  (let ((xdpy (xwem-dpy))
	(gc (xwem-face-get-gc face))
	(fgcol (xwem-misc-colorspec->rgb-vector-safe (face-foreground-name face) [0 0 0])))
    (setf (X-Gc-foreground (XAllocColor xdpy (XDefaultColormap xdpy)
					(make-X-Color :id (X-Dpy-get-id xdpy)
						      :cmap (XDefaultColormap xdpy)
						      :red (aref fgcol 0)
						      :green (aref fgcol 1)
						      :blue (aref fgcol 2)))))
    (XChangeGC xdpy gc)))


(provide 'xwem-faces)

;;; xwem-faces.el ends here