cgit.sxemacs.org Git - riece/blob - lisp/riece-toolbar.el

   1 ;;; riece-toolbar.el --- show toolbar icons
   2 ;; Copyright (C) 1998-2004 Daiki Ueno
   3
   4 ;; Author: Daiki Ueno <ueno@unixuser.org>
   5 ;; Created: 1998-09-28
   6 ;; Keywords: IRC, riece
   7
   8 ;; This file is part of Riece.
   9
  10 ;; This program is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  14
  15 ;; This program is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24
  25 ;;; Commentary:
  26
  27 ;; To use, add the following line to your ~/.riece/init.el:
  28 ;; (add-to-list 'riece-addons 'riece-toolbar)
  29
  30 ;;; Code:
  31
  32 (require 'riece-menu)
  33
  34 (defvar riece-toolbar-items
  35   '(riece-command-quit
  36     riece-command-join
  37     riece-command-part
  38     riece-command-previous-channel
  39     riece-command-next-channel
  40     riece-command-change-layout
  41     riece-submit-bug-report))
  42
  43 (defun riece-toolbar-find-menu-item (command)
  44   (let ((pointer riece-menu-items)
  45         item)
  46     (while pointer
  47       (if (and (not (stringp (car pointer)))
  48                (vectorp (car pointer))
  49                (eq (aref (car pointer) 1) command))
  50           (setq item (car pointer)
  51                 pointer nil)
  52         (setq pointer (cdr pointer))))
  53     item))
  54
  55 (if (featurep 'xemacs)
  56     (if (featurep 'toolbar)
  57         (progn
  58           (defun riece-make-toolbar-from-menu (items menu-items map)
  59             (let ((pointer items)
  60                   toolbar
  61                   file
  62                   menu-item)
  63               (while pointer
  64                 (setq file (locate-file (symbol-name (car pointer))
  65                                         load-path
  66                                         '(".xpm" ".pbm" ".xbm"))
  67                       menu-item (riece-toolbar-find-menu-item (car pointer)))
  68                 (if (and file (file-exists-p file))
  69                     (setq toolbar
  70                           (toolbar-add-item
  71                            toolbar
  72                            (toolbar-new-button
  73                             file
  74                             (car pointer)
  75                             (if menu-item
  76                                 (aref menu-item 0)
  77                               (symbol-name (car pointer)))))))
  78                 (setq pointer (cdr pointer)))
  79               toolbar))
  80           (defun riece-set-toolbar (toolbar)
  81             (set-specifier default-toolbar toolbar (current-buffer))))
  82       (defalias 'riece-make-toolbar-from-menu 'ignore)
  83       (defalias 'riece-set-toolbar 'ignore))
  84   (defun riece-make-toolbar-from-menu (items menu-items map)
  85     (let ((pointer items)
  86           (tool-bar-map (make-sparse-keymap)))
  87       (while pointer
  88         (tool-bar-add-item-from-menu (car pointer)
  89                                      (symbol-name (car pointer))
  90                                      map)
  91         (setq pointer (cdr pointer)))
  92       tool-bar-map))
  93   (defun riece-set-toolbar (toolbar)
  94     (make-local-variable 'tool-bar-map)
  95     (setq tool-bar-map toolbar)))
  96
  97 (defvar riece-command-mode-map)
  98 (defun riece-toolbar-insinuate-in-command-buffer ()
  99   (riece-set-toolbar
 100    (riece-make-toolbar-from-menu
 101     riece-toolbar-items
 102     riece-menu-items
 103     riece-command-mode-map)))
 104
 105 (defun riece-toolbar-requires ()
 106   '(riece-menu))
 107
 108 (defun riece-toolbar-insinuate ()
 109   (add-hook 'riece-command-mode-hook
 110             'riece-toolbar-insinuate-in-command-buffer
 111             t))
 112
 113 (provide 'riece-toolbar)
 114
 115 ;;; riece-toolbar.el ends here