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           (defun riece-set-toolbar (toolbar)
  83             (set-specifier default-toolbar toolbar (current-buffer))))
  84       (defalias 'riece-make-toolbar-from-menu 'ignore)
  85       (defalias 'riece-set-toolbar 'ignore))
  86   (defun riece-make-toolbar-from-menu (items menu-items map)
  87     (let ((pointer items)
  88           (tool-bar-map (make-sparse-keymap)))
  89       (while pointer
  90         (tool-bar-add-item-from-menu (car pointer)
  91                                      (symbol-name (car pointer))
  92                                      map)
  93         (setq pointer (cdr pointer)))
  94       tool-bar-map))
  95   (defun riece-set-toolbar (toolbar)
  96     (make-local-variable 'tool-bar-map)
  97     (setq tool-bar-map toolbar)))
  98
  99 (defvar riece-command-mode-map)
 100 (defun riece-toolbar-insinuate-in-command-buffer ()
 101   (riece-set-toolbar
 102    (riece-make-toolbar-from-menu
 103     riece-toolbar-items
 104     riece-menu-items
 105     riece-command-mode-map)))
 106
 107 (defun riece-toolbar-requires ()
 108   '(riece-menu))
 109
 110 (defun riece-toolbar-insinuate ()
 111   (add-hook 'riece-command-mode-hook
 112             'riece-toolbar-insinuate-in-command-buffer
 113             t))
 114
 115 (defun riece-toolbar-uninstall ()
 116   (remove-hook 'riece-command-mode-hook
 117                'riece-toolbar-insinuate-in-command-buffer)
 118   ;;FIXME: couldn't uninstall completely.
 119   )
 120
 121 (provide 'riece-toolbar)
 122
 123 ;;; riece-toolbar.el ends here