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

   1 ;;; riece-toolbar.el --- display 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., 51 Franklin Street, Fifth Floor,
  23 ;; Boston, MA 02110-1301, USA.
  24
  25 ;;; Commentary:
  26
  27 ;; Image files are taken from GNOME stock icons:
  28 ;; riece-command-next-channel.xpm       stock_next.png
  29 ;; riece-command-previous-channel.xpm   stock_previous.png
  30 ;; riece-command-configure-windows.xpm  stock_refresh.png
  31 ;; riece-command-list-addons            stock_styles.png
  32 ;; riece-command-join                   stock_people.png
  33 ;; riece-command-part                   stock_calc-cancel.png
  34 ;; riece-command-quit                   stock_exit.png
  35
  36 ;; NOTE: This is an add-on module for Riece.
  37
  38 ;;; Code:
  39
  40 (require 'riece-menu)
  41
  42 (defconst riece-toolbar-description
  43   "Display toolbar icons.")
  44
  45 (defvar riece-toolbar-items
  46   '(riece-command-previous-channel
  47     riece-command-next-channel
  48     riece-command-configure-windows
  49     riece-command-list-addons
  50     riece-command-join
  51     riece-command-part
  52     riece-command-quit))
  53
  54 (defun riece-toolbar-find-menu-item (command)
  55   (let ((pointer riece-menu-items)
  56         item)
  57     (while pointer
  58       (if (and (not (stringp (car pointer)))
  59                (vectorp (car pointer))
  60                (eq (aref (car pointer) 1) command))
  61           (setq item (car pointer)
  62                 pointer nil)
  63         (setq pointer (cdr pointer))))
  64     item))
  65
  66 (eval-and-compile
  67   (if (featurep 'xemacs)
  68       (if (featurep 'toolbar)
  69           (progn
  70             (defun riece-make-toolbar-from-menu (items menu-items map)
  71               (let ((pointer items)
  72                     toolbar
  73                     file
  74                     menu-item)
  75                 (while pointer
  76                   (setq file (locate-file (symbol-name (car pointer))
  77                                           (cons riece-data-directory load-path)
  78                                           '(".xpm" ".pbm" ".xbm"))
  79                         menu-item (riece-toolbar-find-menu-item (car pointer)))
  80                   (if (and file (file-exists-p file))
  81                       (setq toolbar
  82                             (toolbar-add-item
  83                              toolbar
  84                              (toolbar-new-button
  85                               file
  86                               (car pointer)
  87                               (if menu-item
  88                                   (aref menu-item 0)
  89                                 (symbol-name (car pointer)))))))
  90                   (setq pointer (cdr pointer)))
  91                 toolbar))
  92             (defvar riece-toolbar-original-toolbar nil)
  93             (defun riece-set-toolbar (toolbar)
  94               (make-local-variable 'riece-toolbar-original-toolbar)
  95               (setq riece-toolbar-original-toolbar
  96                     (specifier-specs default-toolbar (current-buffer)))
  97               (set-specifier default-toolbar toolbar (current-buffer)))
  98             (defun riece-unset-toolbar ()
  99               (if riece-toolbar-original-toolbar
 100                   (set-specifier default-toolbar riece-toolbar-original-toolbar
 101                                  (current-buffer))
 102                 (remove-specifier default-toolbar (current-buffer)))
 103               (kill-local-variable 'riece-toolbar-original-toolbar)))
 104         (defalias 'riece-make-toolbar-from-menu 'ignore)
 105         (defalias 'riece-set-toolbar 'ignore)
 106         (defalias 'riece-unset-toolbar 'ignore))
 107     (defun riece-make-toolbar-from-menu (items menu-items map)
 108       (let ((pointer items)
 109             (tool-bar-map (make-sparse-keymap)))
 110         (while pointer
 111           (tool-bar-add-item-from-menu (car pointer)
 112                                        (symbol-name (car pointer))
 113                                        map)
 114           (setq pointer (cdr pointer)))
 115         tool-bar-map))
 116     (defun riece-set-toolbar (toolbar)
 117       (make-local-variable 'tool-bar-map)
 118       (setq tool-bar-map toolbar))
 119     (defun riece-unset-toolbar ()
 120       (kill-local-variable 'tool-bar-map))))
 121
 122 (defvar riece-command-mode-map)
 123 (defun riece-toolbar-command-mode-hook ()
 124   (riece-set-toolbar
 125    (riece-make-toolbar-from-menu
 126     riece-toolbar-items
 127     riece-menu-items
 128     riece-command-mode-map)))
 129
 130 (defun riece-toolbar-requires ()
 131   '(riece-menu))
 132
 133 (defun riece-toolbar-insinuate ()
 134   (if riece-command-buffer
 135       (with-current-buffer riece-command-buffer
 136         (riece-toolbar-command-mode-hook)))
 137   (add-hook 'riece-command-mode-hook
 138             'riece-toolbar-command-mode-hook t))
 139
 140 (defun riece-toolbar-uninstall ()
 141   (if riece-command-buffer
 142       (with-current-buffer riece-command-buffer
 143         (riece-unset-toolbar)))
 144   (remove-hook 'riece-command-mode-hook
 145                'riece-toolbar-command-mode-hook))
 146
 147 (provide 'riece-toolbar)
 148
 149 ;;; riece-toolbar.el ends here