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             (if riece-toolbar-original-toolbar
  90                 (set-specifier default-toolbar riece-toolbar-original-toolbar
  91                                (current-buffer))
  92               (remove-specifier default-toolbar (current-buffer)))
  93             (kill-local-variable 'riece-toolbar-original-toolbar)))
  94       (defalias 'riece-make-toolbar-from-menu 'ignore)
  95       (defalias 'riece-set-toolbar 'ignore)
  96       (defalias 'riece-unset-toolbar 'ignore))
  97   (defun riece-make-toolbar-from-menu (items menu-items map)
  98     (let ((pointer items)
  99           (tool-bar-map (make-sparse-keymap)))
 100       (while pointer
 101         (tool-bar-add-item-from-menu (car pointer)
 102                                      (symbol-name (car pointer))
 103                                      map)
 104         (setq pointer (cdr pointer)))
 105       tool-bar-map))
 106   (defun riece-set-toolbar (toolbar)
 107     (make-local-variable 'tool-bar-map)
 108     (setq tool-bar-map toolbar))
 109   (defun riece-unset-toolbar ()
 110     (kill-local-variable 'tool-bar-map)))
 111
 112 (defvar riece-command-mode-map)
 113 (defun riece-toolbar-command-mode-hook ()
 114   (riece-set-toolbar
 115    (riece-make-toolbar-from-menu
 116     riece-toolbar-items
 117     riece-menu-items
 118     riece-command-mode-map)))
 119
 120 (defun riece-toolbar-requires ()
 121   '(riece-menu))
 122
 123 (defun riece-toolbar-insinuate ()
 124   (if riece-command-buffer
 125       (with-current-buffer riece-command-buffer
 126         (riece-toolbar-command-mode-hook)))
 127   (add-hook 'riece-command-mode-hook
 128             'riece-toolbar-command-mode-hook))
 129
 130 (defun riece-toolbar-uninstall ()
 131   (if riece-command-buffer
 132       (with-current-buffer riece-command-buffer
 133         (riece-unset-toolbar)))
 134   (remove-hook 'riece-command-mode-hook
 135                'riece-toolbar-command-mode-hook))
 136
 137 (provide 'riece-toolbar)
 138
 139 ;;; riece-toolbar.el ends here