X-Git-Url: http://cgit.sxemacs.org/?p=riece;a=blobdiff_plain;f=lisp%2Friece-toolbar.el;h=48c39090bee3d530f50b1aa5dfb31d677ea3bf97;hp=1bdba0ca96d3710817a24ad8c09eb908ce785e9f;hb=2ca8922fb84a9a42bf2fe4c65faf1db3c7ff7426;hpb=3118995657584202ecf27271a039dca007f9bca3 diff --git a/lisp/riece-toolbar.el b/lisp/riece-toolbar.el index 1bdba0c..48c3909 100644 --- a/lisp/riece-toolbar.el +++ b/lisp/riece-toolbar.el @@ -1,4 +1,4 @@ -;;; riece-toolbar.el --- show icons on toolbar +;;; riece-toolbar.el --- display toolbar icons ;; Copyright (C) 1998-2004 Daiki Ueno ;; Author: Daiki Ueno @@ -19,64 +19,122 @@ ;; 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. - -;; To use, add the following line to your ~/.riece/init.el: -;; (add-to-list 'riece-addons 'riece-toolbar) +;; 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-quit + riece-command-join + riece-command-part + riece-command-previous-channel + riece-command-next-channel + riece-command-change-layout + riece-submit-bug-report)) + +(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 pointer)) + (cons riece-data-directory load-path) + '(".xpm" ".pbm" ".xbm")) + menu-item (riece-toolbar-find-menu-item (car pointer))) + (if (and file (file-exists-p file)) + (setq toolbar + (toolbar-add-item + toolbar + (toolbar-new-button + file + (car pointer) + (if menu-item + (aref menu-item 0) + (symbol-name (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 pointer) + (symbol-name (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