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

   1 ;;; riece-toolbar.el --- display toolbar icons -*- lexical-binding: t -*-
   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 stock icons:
  28
  29 ;; riece-command-next-channel.xpm       gtk-go-forward
  30 ;; riece-command-previous-channel.xpm   gtk-go-back
  31 ;; riece-command-configure-windows.xpm  gtk-refresh
  32 ;; riece-command-list-addons            gtk-preferences
  33 ;; riece-command-join                   gtk-new
  34 ;; riece-command-part                   gtk-close
  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 . "left-arrow")
  47     (riece-command-next-channel . "right-arrow")
  48     (riece-command-configure-windows . "refresh")
  49     (riece-command-join . "new")
  50     (riece-command-part . "close")
  51     (riece-command-list-addons . "preferences")))
  52
  53 (defun riece-toolbar-find-menu-item (command)
  54   (let ((pointer riece-menu-items)
  55         item)
  56     (while pointer
  57       (if (and (not (stringp (car pointer)))
  58                (vectorp (car pointer))
  59                (eq (aref (car pointer) 1) command))
  60           (setq item (car pointer)
  61                 pointer nil)
  62         (setq pointer (cdr pointer))))
  63     item))
  64
  65 (eval-and-compile
  66   (if (featurep 'xemacs)
  67       (if (featurep 'toolbar)
  68           (progn
  69             (defun riece-make-toolbar-from-menu (items _menu-items _map)
  70               (let ((pointer items)
  71                     toolbar
  72                     file
  73                     menu-item)
  74                 (while pointer
  75                   (setq file (locate-file (symbol-name (car (car pointer)))
  76                                           (cons riece-data-directory load-path)
  77                                           '(".xpm" ".pbm" ".xbm"))
  78                         menu-item (riece-toolbar-find-menu-item
  79                                    (car (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 (car pointer))
  87                               (if menu-item
  88                                   (aref menu-item 0)
  89                                 (symbol-name (car (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 (car pointer))
 112                                        (cdr (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