-;;; riece-toolbar.el --- show icons on toolbar
+;;; riece-toolbar.el --- display toolbar icons -*- lexical-binding: t -*-
;; Copyright (C) 1998-2004 Daiki Ueno
;; Author: Daiki Ueno <ueno@unixuser.org>
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
-;; NOTE: This add-on doesn't support XEmacs yet.
+;; Image files are taken from stock icons:
-;; To use, add the following line to your ~/.riece/init.el:
-;; (add-to-list 'riece-addons 'riece-toolbar)
+;; riece-command-next-channel.xpm gtk-go-forward
+;; riece-command-previous-channel.xpm gtk-go-back
+;; riece-command-configure-windows.xpm gtk-refresh
+;; riece-command-list-addons gtk-preferences
+;; riece-command-join gtk-new
+;; riece-command-part gtk-close
+
+;; NOTE: This is an add-on module for Riece.
;;; Code:
(require 'riece-menu)
-(defvar riece-toolbar-item-list
- '((riece-command-quit "riece-command-quit")
- (riece-command-join "riece-command-join")
- (riece-command-part "riece-command-part")
- (riece-command-next-channel "riece-command-next-channel")
- (riece-command-previous-channel "riece-command-previous-channel")
- (riece-command-change-window-layout "riece-command-change-window-layout")))
-
-(if (fboundp 'tool-bar-local-item-from-menu)
- (defalias 'riece-tool-bar-local-item-from-menu
- 'tool-bar-local-item-from-menu)
- (if (fboundp 'tool-bar-add-item-from-menu)
- (defun riece-tool-bar-local-item-from-menu (command icon in-map
- &optional from-map
- &rest props)
- "Define tool bar binding for COMMAND using the given ICON in \
-keymap IN-MAP."
- (let ((tool-bar-map in-map))
- (apply #'tool-bar-add-item-from-menu command icon from-map props)))
- (defalias 'riece-tool-bar-local-item-from-menu 'ignore)))
+(defconst riece-toolbar-description
+ "Display toolbar icons.")
+
+(defvar riece-toolbar-items
+ '((riece-command-previous-channel . "left-arrow")
+ (riece-command-next-channel . "right-arrow")
+ (riece-command-configure-windows . "refresh")
+ (riece-command-join . "new")
+ (riece-command-part . "close")
+ (riece-command-list-addons . "preferences")))
+
+(defun riece-toolbar-find-menu-item (command)
+ (let ((pointer riece-menu-items)
+ item)
+ (while pointer
+ (if (and (not (stringp (car pointer)))
+ (vectorp (car pointer))
+ (eq (aref (car pointer) 1) command))
+ (setq item (car pointer)
+ pointer nil)
+ (setq pointer (cdr pointer))))
+ item))
+
+(eval-and-compile
+ (if (featurep 'xemacs)
+ (if (featurep 'toolbar)
+ (progn
+ (defun riece-make-toolbar-from-menu (items _menu-items _map)
+ (let ((pointer items)
+ toolbar
+ file
+ menu-item)
+ (while pointer
+ (setq file (locate-file (symbol-name (car (car pointer)))
+ (cons riece-data-directory load-path)
+ '(".xpm" ".pbm" ".xbm"))
+ menu-item (riece-toolbar-find-menu-item
+ (car (car pointer))))
+ (if (and file (file-exists-p file))
+ (setq toolbar
+ (toolbar-add-item
+ toolbar
+ (toolbar-new-button
+ file
+ (car (car pointer))
+ (if menu-item
+ (aref menu-item 0)
+ (symbol-name (car (car pointer))))))))
+ (setq pointer (cdr pointer)))
+ toolbar))
+ (defvar riece-toolbar-original-toolbar nil)
+ (defun riece-set-toolbar (toolbar)
+ (make-local-variable 'riece-toolbar-original-toolbar)
+ (setq riece-toolbar-original-toolbar
+ (specifier-specs default-toolbar (current-buffer)))
+ (set-specifier default-toolbar toolbar (current-buffer)))
+ (defun riece-unset-toolbar ()
+ (if riece-toolbar-original-toolbar
+ (set-specifier default-toolbar riece-toolbar-original-toolbar
+ (current-buffer))
+ (remove-specifier default-toolbar (current-buffer)))
+ (kill-local-variable 'riece-toolbar-original-toolbar)))
+ (defalias 'riece-make-toolbar-from-menu 'ignore)
+ (defalias 'riece-set-toolbar 'ignore)
+ (defalias 'riece-unset-toolbar 'ignore))
+ (defun riece-make-toolbar-from-menu (items _menu-items map)
+ (let ((pointer items)
+ (tool-bar-map (make-sparse-keymap)))
+ (while pointer
+ (tool-bar-add-item-from-menu (car (car pointer))
+ (cdr (car pointer))
+ map)
+ (setq pointer (cdr pointer)))
+ tool-bar-map))
+ (defun riece-set-toolbar (toolbar)
+ (make-local-variable 'tool-bar-map)
+ (setq tool-bar-map toolbar))
+ (defun riece-unset-toolbar ()
+ (kill-local-variable 'tool-bar-map))))
(defvar riece-command-mode-map)
-(defun riece-toolbar-insinuate-in-command-buffer ()
- (when (boundp 'tool-bar-map)
- (make-local-variable 'tool-bar-map)
- (setq tool-bar-map
- (let ((map (make-sparse-keymap))
- (pointer riece-toolbar-item-list))
- (while pointer
- (riece-tool-bar-local-item-from-menu (car (car pointer))
- (nth 1 (car pointer))
- map riece-command-mode-map)
- (setq pointer (cdr pointer)))
- map))))
+(defun riece-toolbar-command-mode-hook ()
+ (riece-set-toolbar
+ (riece-make-toolbar-from-menu
+ riece-toolbar-items
+ riece-menu-items
+ riece-command-mode-map)))
(defun riece-toolbar-requires ()
'(riece-menu))
(defun riece-toolbar-insinuate ()
+ (if riece-command-buffer
+ (with-current-buffer riece-command-buffer
+ (riece-toolbar-command-mode-hook)))
(add-hook 'riece-command-mode-hook
- (lambda ()
- (riece-toolbar-insinuate-in-command-buffer))
- t))
+ 'riece-toolbar-command-mode-hook t))
+
+(defun riece-toolbar-uninstall ()
+ (if riece-command-buffer
+ (with-current-buffer riece-command-buffer
+ (riece-unset-toolbar)))
+ (remove-hook 'riece-command-mode-hook
+ 'riece-toolbar-command-mode-hook))
(provide 'riece-toolbar)
-;;; riece-toolbar.el ends here
\ No newline at end of file
+;;; riece-toolbar.el ends here
projects / riece / blobdiff