Source

xwem / lisp / xwem-icons.el

;;; xwem-icons.el --- Icons handling routines.

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

;; Author: Zajcev Evgeny <zevlg@yandex.ru>
;; Created: Sat Dec 27 15:38:24 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:

;; Icons support.

;;; Code:

(eval-when-compile
  (require 'xlib-xlib))
(require 'xlib-xpm)

(defvar xwem-icons-dir (locate-data-directory "xwem")
  "Directory where icons for use by XWEM lies.")

(defvar xwem-icons-list nil
  "List of already loaded icons.")

;;;###autoload
(defvar xwem-icons-alist
  ;; [ wm-name wm-class-name wm-class-instance ] . icon-name
  '(([".*" ".term" ".Term"] . "mini-term.xpm")
    ([".*" "xclock" "XClock"] . "mini-clock.xpm")
    ([".*" "xload" "XLoad"] . "mini-measure.xpm")
    ([".*" "xcalc" "XCalc"] . "mini-calc.xpm")
    
    ([".*" "xkeycaps" "XKeyCaps"] . "mini-xkeycaps.xpm")
    ([".*" "xdvi" "XDvi"] . "mini-xdvi.xpm")
    ([".*" "xv" "XV.*"] . "mini-xv.xpm")
    ([".*" ".*" "AcroRead"] . "mini-acroread.xpm")
    ([".*" ".*" "Xpdf"] . "mini-acroread.xpm")
    ([".*" ".*" "Xman"] . "mini-info.xpm")
    
    ([".*" "Mozilla" ".*"] . "mini-mozilla.xpm")
    ([".*" "gv" "GV"] . "mini-gv.xpm")
    ([".*" "ghostview" "Ghostview"] . "mini-gv.xpm")
    ([".*" "xfig" "Fig"] . "mini-xfig.xpm")
    ([".*" "ethereal" "Ethereal"] . "mini-ethereal.xpm")
    ([".*" "xfd" "Xfd"] . "mini-font.xpm")
    ([".*" "xfontsel" "XFontSel"] . "mini-font.xpm")
    ([".*" "xconsole" "XConsole"] . "mini-sh1.xpm")
    ([".*" "xcolors" "Xcolors"] . "mini-colors.xpm")
    ([".*" ".*" "X-Chat"] . "mini-xchat.xpm")

    ;; Match by WM_NAME since WM_CLASS is not setuped
    (["Lupe" ".*" ".*"] . "mini-zoom.xpm")
    (["xcmap" "" ".*"] . "mini-colors.xpm")
    
    ;; EMACS
    ([".*\\.tex.*" "emacs" "Emacs"] . "mini-xemacstex.xpm")
    ([".*\\.c.*" "emacs" "Emacs"] . "mini-xemacsC.xpm")
    ([".*\\.py.*" "emacs" "Emacs"] . "mini-xemacspy.xpm")
    ([".*\\(Group\\|Summary\\|Article\\).*" "emacs" "Emacs"] . "mini-xemacsgnus.xpm")
    ([".*\\*info\\*.*" "emacs" "Emacs"] . "mini-xemacsinfo.xpm")
    ([".*" "emacs" "Emacs"] . "mini-xemacs.xpm")

    ([".*" ".*" ".*"] . "mini-x2.xpm")))

(defun xwem-icons-cl-icon-name (cl)
  "Return icon name for CL."
  (let* ((hints (xwem-cl-hints cl))
	 (wm-name (xwem-hints-wm-name hints))
	 (wm-class (xwem-hints-wm-class hints))
	 (class-name (or (car wm-class) ""))
	 (class-inst (or (cadr wm-class) ""))
	 (ialist xwem-icons-alist))

    (while (and ialist
		(not (and (string-match (aref (car (car ialist)) 0) wm-name)
			  (string-match (aref (car (car ialist)) 1) class-name)
			  (string-match (aref (car (car ialist)) 2) class-inst))))
      (setq ialist (cdr ialist)))
    
    (cdr (car ialist))))

;;;###autoload
(defun xwem-icons-cl-icon (cl)
  "Get X-Image of CL's icon.
Return cons cell where car is X-Pixmap of icon and cdr is X-Pixmap
where mask for icon is stored."
  (let ((iname (xwem-icons-cl-icon-name cl))
	fname ximg ximg-mask-pixmap)
    (when iname
      (setq ximg (plist-get xwem-icons-list iname))
      (unless ximg
	(setq fname (concat xwem-icons-dir "/" iname))
	(setq ximg (X:xpm-pixmap-from-file (xwem-dpy) (XDefaultRootWindow (xwem-dpy)) fname))
	(setq ximg-mask-pixmap (X:xpm-pixmap-from-file (xwem-dpy) (XDefaultRootWindow (xwem-dpy)) fname t))

	(setq xwem-icons-list (plist-put xwem-icons-list iname (cons ximg ximg-mask-pixmap)))
	(setq ximg (plist-get xwem-icons-list iname)))

      ximg)))


(provide 'xwem-icons)

;;; xwem-icons.el ends here