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 ;; 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 (eval-and-compile
  58   (if (featurep 'xemacs)
  59       (if (featurep 'toolbar)
  60           (progn
  61             (defun riece-make-toolbar-from-menu (items menu-items map)
  62               (let ((pointer items)
  63                     toolbar
  64                     file
  65                     menu-item)
  66                 (while pointer
  67                   (setq file (locate-file (symbol-name (car pointer))
  68                                           (cons riece-data-directory load-path)
  69                                           '(".xpm" ".pbm" ".xbm"))
  70                         menu-item (riece-toolbar-find-menu-item (car pointer)))
  71                   (if (and file (file-exists-p file))
  72                       (setq toolbar
  73                             (toolbar-add-item
  74                              toolbar
  75                              (toolbar-new-button
  76                               file
  77                               (car pointer)
  78                               (if menu-item
  79                                   (aref menu-item 0)
  80                                 (symbol-name (car pointer)))))))
  81                   (setq pointer (cdr pointer)))
  82                 toolbar))
  83             (defvar riece-toolbar-original-toolbar nil)
  84             (defun riece-set-toolbar (toolbar)
  85               (make-local-variable 'riece-toolbar-original-toolbar)
  86               (setq riece-toolbar-original-toolbar
  87                     (specifier-specs default-toolbar (current-buffer)))
  88               (set-specifier default-toolbar toolbar (current-buffer)))
  89             (defun riece-unset-toolbar ()
  90               (if riece-toolbar-original-toolbar
  91                   (set-specifier default-toolbar riece-toolbar-original-toolbar
  92                                  (current-buffer))
  93                 (remove-specifier default-toolbar (current-buffer)))
  94               (kill-local-variable 'riece-toolbar-original-toolbar)))
  95         (defalias 'riece-make-toolbar-from-menu 'ignore)
  96         (defalias 'riece-set-toolbar 'ignore)
  97         (defalias 'riece-unset-toolbar 'ignore))
  98     (defun riece-make-toolbar-from-menu (items menu-items map)
  99       (let ((pointer items)
 100             (tool-bar-map (make-sparse-keymap)))
 101         (while pointer
 102           (tool-bar-add-item-from-menu (car pointer)
 103                                        (symbol-name (car pointer))
 104                                        map)
 105           (setq pointer (cdr pointer)))
 106         tool-bar-map))
 107     (defun riece-set-toolbar (toolbar)
 108       (make-local-variable 'tool-bar-map)
 109       (setq tool-bar-map toolbar))
 110     (defun riece-unset-toolbar ()
 111       (kill-local-variable 'tool-bar-map))))
 112
 113 (defvar riece-command-mode-map)
 114 (defun riece-toolbar-command-mode-hook ()
 115   (riece-set-toolbar
 116    (riece-make-toolbar-from-menu
 117     riece-toolbar-items
 118     riece-menu-items
 119     riece-command-mode-map)))
 120
 121 (defun riece-toolbar-requires ()
 122   '(riece-menu))
 123
 124 (defun riece-toolbar-insinuate ()
 125   (if riece-command-buffer
 126       (with-current-buffer riece-command-buffer
 127         (riece-toolbar-command-mode-hook)))
 128   (add-hook 'riece-command-mode-hook
 129             'riece-toolbar-command-mode-hook t))
 130
 131 (defun riece-toolbar-uninstall ()
 132   (if riece-command-buffer
 133       (with-current-buffer riece-command-buffer
 134         (riece-unset-toolbar)))
 135   (remove-hook 'riece-command-mode-hook
 136                'riece-toolbar-command-mode-hook))
 137
 138 (provide 'riece-toolbar)
 139
 140 ;;; riece-toolbar.el ends here