Mercurial > hg > xemacs-beta

comparison lisp/prim/toolbar.el @ 155:43dd3413c7c7 r20-3b4

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-3b4
author cvs
date Mon, 13 Aug 2007 09:39:39 +0200
parents 131b0175ea99
children
comparison
equal deleted inserted replaced
154:94141801dd7e 155:43dd3413c7c7
1 ;; Toolbar support. 1 ;;; toolbar.el --- Toolbar support for XEmacs
2 ;; Copyright (C) 1995 Board of Trustees, University of Illinois 2
3 ;; Copyright (C) 1995, 1997 Free Software Foundation, Inc.
4
5 ;; Maintainer: XEmacs Development Team
6 ;; Keywords: extensions, internal
3 7
4 ;; This file is part of XEmacs. 8 ;; This file is part of XEmacs.
5 9
6 ;; XEmacs is free software; you can redistribute it and/or modify it 10 ;; XEmacs is free software; you can redistribute it and/or modify it
7 ;; under the terms of the GNU General Public License as published by 11 ;; under the terms of the GNU General Public License as published by
17 ;; along with XEmacs; see the file COPYING. If not, write to the 21 ;; along with XEmacs; see the file COPYING. If not, write to the
18 ;; Free Software Foundation, 59 Temple Place - Suite 330, 22 ;; Free Software Foundation, 59 Temple Place - Suite 330,
19 ;; Boston, MA 02111-1307, USA. 23 ;; Boston, MA 02111-1307, USA.
20 24
21 ;;; Synched up with: Not in FSF. 25 ;;; Synched up with: Not in FSF.
26
27 ;;; Commentary:
28
29 ;;; Code:
22 30
23 (defvar toolbar-help-enabled t 31 (defvar toolbar-help-enabled t
24 "If non-nil help is echoed for toolbar buttons.") 32 "If non-nil help is echoed for toolbar buttons.")
25 33
26 (defvar toolbar-icon-directory nil 34 (defvar toolbar-icon-directory nil
80 ;; 88 ;;
81 ;; It really sucks that we also have to tie onto 89 ;; It really sucks that we also have to tie onto
82 ;; default-mouse-motion-handler to make sliding buttons work right. 90 ;; default-mouse-motion-handler to make sliding buttons work right.
83 ;; 91 ;;
84 (defun press-toolbar-button (event) 92 (defun press-toolbar-button (event)
85 "Press a toolbar button. This only changes its appearance." 93 "Press a toolbar button. This only changes its appearance.
94 Call function stored in `toolbar-blank-press-function,' if any, with EVENT as
95 an argument if press is over a blank area of the toolbar."
86 (interactive "_e") 96 (interactive "_e")
87 (setq this-command last-command) 97 (setq this-command last-command)
88 (let ((button (event-toolbar-button event))) 98 (let ((button (event-toolbar-button event)))
89 ;; We silently ignore non-buttons. This most likely means we are 99 ;; We silently ignore non-buttons. This most likely means we are
90 ;; over a blank part of the toolbar. 100 ;; over a blank part of the toolbar.
91 (setq toolbar-active t) 101 (setq toolbar-active t)
92 (if (toolbar-button-p button) 102 (if (toolbar-button-p button)
93 (progn 103 (progn
94 (set-toolbar-button-down-flag button t) 104 (set-toolbar-button-down-flag button t)
95 (setq last-pressed-toolbar-button button))))) 105 (setq last-pressed-toolbar-button button))
106 ;; Added by Bob Weiner, Motorola Inc., 10/6/95, to handle
107 ;; presses on blank portions of toolbars.
108 (and (boundp 'toolbar-blank-press-function)
109 (functionp toolbar-blank-press-function)
110 (funcall toolbar-blank-press-function event)))))
96 111
97 (defun release-and-activate-toolbar-button (event) 112 (defun release-and-activate-toolbar-button (event)
98 "Release a toolbar button and activate its callback." 113 "Release a toolbar button and activate its callback.
114 Call function stored in `toolbar-blank-release-function,' if any, with EVENT
115 as an argument if release is over a blank area of the toolbar."
99 (interactive "_e") 116 (interactive "_e")
100 (or (button-release-event-p event) 117 (or (button-release-event-p event)
101 (error "%s must be invoked by a mouse-release" this-command)) 118 (error "%s must be invoked by a mouse-release" this-command))
102 (release-toolbar-button event) 119 (release-toolbar-button event)
103 (let ((button (event-toolbar-button event))) 120 (let ((button (event-toolbar-button event)))
104 (if (and (toolbar-button-p button) 121 (if (and (toolbar-button-p button)
105 (toolbar-button-enabled-p button) 122 (toolbar-button-enabled-p button)
106 (toolbar-button-callback button)) 123 (toolbar-button-callback button))
107 (let ((callback (toolbar-button-callback button))) 124 (let ((callback (toolbar-button-callback button)))
108 (setq this-command callback) 125 (setq this-command callback)
109 (if (symbolp callback) 126 ;; Handle arbitrary functions.
110 (call-interactively callback) 127 (if (functionp callback)
128 (if (commandp callback)
129 (call-interactively callback)
130 (funcall callback))
111 (eval callback)))))) 131 (eval callback))))))
112 132
113 ;; If current is not t, then only release the toolbar button stored in 133 ;; If current is not t, then only release the toolbar button stored in
114 ;; last-pressed-toolbar-button 134 ;; last-pressed-toolbar-button
115 (defun release-toolbar-button-internal (event current) 135 (defun release-toolbar-button-internal (event current)
138 158
139 (defun release-previous-toolbar-button (event) 159 (defun release-previous-toolbar-button (event)
140 (setq zmacs-region-stays t) 160 (setq zmacs-region-stays t)
141 (release-toolbar-button-internal event nil)) 161 (release-toolbar-button-internal event nil))
142 162
163 ;;; toolbar.el ends here