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