Mercurial > hg > xemacs-beta
annotate lisp/toolbar.el @ 5767:4e69b24a2301
Disable ASLR on Mavericks.
| author | Marcus Crestani <crestani@informatik.uni-tuebingen.de> |
|---|---|
| date | Mon, 28 Oct 2013 16:03:53 +0100 |
| parents | 308d34e9f07d |
| children |
| rev | line source |
|---|---|
| 428 | 1 ;;; toolbar.el --- Toolbar support for XEmacs |
| 2 | |
| 3 ;; Copyright (C) 1995, 1997 Free Software Foundation, Inc. | |
| 771 | 4 ;; Copyright (C) 2002 Ben Wing. |
| 428 | 5 |
| 6 ;; Maintainer: XEmacs Development Team | |
| 7 ;; Keywords: extensions, internal, dumped | |
| 8 | |
| 9 ;; This file is part of XEmacs. | |
| 10 | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5228
diff
changeset
|
11 ;; XEmacs is free software: you can redistribute it and/or modify it |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5228
diff
changeset
|
12 ;; under the terms of the GNU General Public License as published by the |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5228
diff
changeset
|
13 ;; Free Software Foundation, either version 3 of the License, or (at your |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5228
diff
changeset
|
14 ;; option) any later version. |
| 428 | 15 |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5228
diff
changeset
|
16 ;; XEmacs is distributed in the hope that it will be useful, but WITHOUT |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5228
diff
changeset
|
17 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5228
diff
changeset
|
18 ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5228
diff
changeset
|
19 ;; for more details. |
| 428 | 20 |
| 21 ;; You should have received a copy of the GNU General Public License | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5228
diff
changeset
|
22 ;; along with XEmacs. If not, see <http://www.gnu.org/licenses/>. |
| 428 | 23 |
| 24 ;;; Synched up with: Not in FSF. | |
| 25 | |
| 26 ;;; Commentary: | |
| 27 | |
| 28 ;; This file is dumped with XEmacs (when toolbar support is compiled in). | |
| 29 | |
| 30 ;;; Code: | |
| 31 | |
| 32 (defcustom toolbar-visible-p ;; added for the options menu - dverna apr. 98 | |
| 33 (specifier-instance default-toolbar-visible-p) | |
| 763 | 34 "*Whether the default toolbar is globally visible. |
| 771 | 35 This option only has an effect when set using `customize-set-variable', |
| 36 or through the Options menu." | |
| 428 | 37 :group 'display |
| 38 :type 'boolean | |
| 39 :set #'(lambda (var val) | |
| 40 (set-specifier default-toolbar-visible-p val) | |
| 41 (setq toolbar-visible-p val)) | |
| 42 ) | |
| 43 | |
| 44 (defcustom toolbar-captioned-p ;; added for the options menu - dverna apr. 98 | |
| 45 (specifier-instance toolbar-buttons-captioned-p) | |
| 763 | 46 "*Whether the toolbars buttons are globally captioned. |
| 771 | 47 This option only has an effect when set using `customize-set-variable', |
| 48 or through the Options menu." | |
| 428 | 49 :group 'display |
| 50 :type 'boolean | |
| 51 :set #'(lambda (var val) | |
| 52 (set-specifier toolbar-buttons-captioned-p val) | |
| 53 (setq toolbar-captioned-p val)) | |
| 54 ) | |
| 55 | |
| 56 (defcustom default-toolbar-position ;; added for the options menu - dverna | |
| 57 (default-toolbar-position) | |
| 771 | 58 "*The location of the default toolbar: 'top, 'bottom, 'left or 'right. |
| 59 This option only has an effect when set using `customize-set-variable', | |
| 60 or through the Options menu." | |
| 428 | 61 :group 'display |
| 442 | 62 :type '(choice (const :tag "top" top) |
| 63 (const :tag "bottom" bottom) | |
| 64 (const :tag "left" left) | |
| 65 (const :tag "right" right)) | |
| 428 | 66 :set #'(lambda (var val) |
| 763 | 67 (let* ((height (window-height)) |
| 68 (hdiff (- (frame-height) height)) | |
| 69 (width (window-width))) | |
| 70 (set-default-toolbar-position val) | |
| 71 (setq default-toolbar-position val) | |
| 72 ;; needed or dimensions don't update? | |
| 73 (redisplay-frame) | |
| 74 ;; This probably only works correctly if there is only one | |
| 75 ;; Emacs window. If windows are split, it probably results in | |
| 76 ;; small adjustments in their sizes. | |
| 77 (set-frame-size (selected-frame) width (+ height hdiff)) | |
| 767 | 78 ))) |
| 428 | 79 |
| 80 (defvar toolbar-help-enabled t | |
| 81 "If non-nil help is echoed for toolbar buttons.") | |
| 82 | |
| 83 (defvar toolbar-icon-directory nil | |
| 84 "Location of standard toolbar icon bitmaps.") | |
| 85 | |
| 86 (defun toolbar-make-button-list (up &optional down disabled cap-up cap-down cap-disabled) | |
| 87 "Call make-glyph on each arg and return a list of the results." | |
| 88 (let ((up-glyph (make-glyph up)) | |
| 89 (down-glyph (and down (make-glyph down))) | |
| 90 (disabled-glyph (and disabled (make-glyph disabled))) | |
| 91 (cap-up-glyph (and cap-up (make-glyph cap-up))) | |
| 92 (cap-down-glyph (and cap-down (make-glyph cap-down))) | |
| 93 (cap-disabled-glyph (and cap-disabled (make-glyph cap-disabled)))) | |
| 94 (if cap-disabled | |
| 95 (list up-glyph down-glyph disabled-glyph | |
| 96 cap-up-glyph cap-down-glyph cap-disabled-glyph) | |
| 97 (if cap-down | |
| 98 (list up-glyph down-glyph disabled-glyph | |
| 99 cap-up-glyph cap-down-glyph) | |
| 100 (if cap-up | |
| 101 (list up-glyph down-glyph disabled-glyph cap-up-glyph) | |
| 102 (if disabled-glyph | |
| 103 (list up-glyph down-glyph disabled-glyph) | |
| 104 (if down-glyph | |
| 105 (list up-glyph down-glyph) | |
| 106 (list up-glyph)))))))) | |
| 107 | |
| 108 (defun init-toolbar-location () | |
| 109 (if (not toolbar-icon-directory) | |
| 110 (let ((name (locate-data-directory "toolbar"))) | |
| 111 (if name | |
| 112 (setq toolbar-icon-directory | |
| 113 (file-name-as-directory name)))))) | |
| 114 | |
| 487 | 115 ;; called from toolbar.c during device and frame initialization |
| 428 | 116 (defun init-toolbar-from-resources (locale) |
| 117 (if (and (featurep 'x) | |
| 118 (or (eq locale 'global) | |
| 119 (eq 'x (device-or-frame-type locale)))) | |
| 502 | 120 (declare-fboundp (x-init-toolbar-from-resources locale)))) |
| 428 | 121 |
| 122 | |
| 123 ;; #### Is this actually needed or will the code in | |
| 124 ;; default-mouse-motion-handler suffice? | |
| 125 (define-key global-map 'button1up 'release-toolbar-button) | |
| 126 | |
| 127 (defvar toolbar-map (let ((m (make-sparse-keymap))) | |
| 128 (set-keymap-name m 'toolbar-map) | |
| 129 m) | |
| 130 "Keymap consulted for mouse-clicks over a toolbar.") | |
| 131 | |
| 132 (define-key toolbar-map 'button1 'press-toolbar-button) | |
| 133 (define-key toolbar-map 'button1up 'release-and-activate-toolbar-button) | |
| 134 (defvar last-pressed-toolbar-button nil) | |
| 135 (defvar toolbar-active nil) | |
| 136 | |
| 442 | 137 (defvar toolbar-blank-press-function nil |
| 138 "Function to call if a blank area of the toolbar is pressed.") | |
| 139 | |
| 428 | 140 ;; |
| 141 ;; It really sucks that we also have to tie onto | |
| 142 ;; default-mouse-motion-handler to make sliding buttons work right. | |
| 143 ;; | |
| 144 (defun press-toolbar-button (event) | |
| 145 "Press a toolbar button. This only changes its appearance. | |
| 3061 | 146 Call function stored in `toolbar-blank-press-function', if any, with EVENT as |
| 428 | 147 an argument if press is over a blank area of the toolbar." |
| 148 (interactive "_e") | |
| 149 (setq this-command last-command) | |
| 150 (let ((button (event-toolbar-button event))) | |
| 151 ;; We silently ignore non-buttons. This most likely means we are | |
| 152 ;; over a blank part of the toolbar. | |
| 153 (setq toolbar-active t) | |
| 154 (if (toolbar-button-p button) | |
| 155 (progn | |
| 156 (set-toolbar-button-down-flag button t) | |
| 157 (setq last-pressed-toolbar-button button)) | |
| 158 ;; Added by Bob Weiner, Motorola Inc., 10/6/95, to handle | |
| 159 ;; presses on blank portions of toolbars. | |
| 442 | 160 (when (functionp toolbar-blank-press-function) |
| 161 (funcall toolbar-blank-press-function event))))) | |
| 428 | 162 |
| 163 (defun release-and-activate-toolbar-button (event) | |
| 164 "Release a toolbar button and activate its callback. | |
| 3061 | 165 Call function stored in `toolbar-blank-release-function', if any, with EVENT |
| 428 | 166 as an argument if release is over a blank area of the toolbar." |
| 167 (interactive "_e") | |
| 168 (or (button-release-event-p event) | |
| 169 (error "%s must be invoked by a mouse-release" this-command)) | |
| 170 (release-toolbar-button event) | |
| 171 (let ((button (event-toolbar-button event))) | |
| 172 (if (and (toolbar-button-p button) | |
| 173 (toolbar-button-enabled-p button) | |
| 174 (toolbar-button-callback button)) | |
| 175 (let ((callback (toolbar-button-callback button))) | |
| 176 (setq this-command callback) | |
| 177 ;; Handle arbitrary functions. | |
| 178 (if (functionp callback) | |
| 179 (if (commandp callback) | |
| 180 (call-interactively callback) | |
| 181 (funcall callback)) | |
| 182 (eval callback)))))) | |
| 183 | |
| 184 ;; If current is not t, then only release the toolbar button stored in | |
| 185 ;; last-pressed-toolbar-button | |
| 186 (defun release-toolbar-button-internal (event current) | |
| 187 (let ((button (event-toolbar-button event))) | |
| 188 (setq zmacs-region-stays t) | |
| 189 (if (and last-pressed-toolbar-button | |
| 190 (not (eq last-pressed-toolbar-button button)) | |
| 191 (toolbar-button-p last-pressed-toolbar-button)) | |
| 192 (progn | |
| 193 (set-toolbar-button-down-flag last-pressed-toolbar-button nil) | |
| 194 (setq last-pressed-toolbar-button nil))) | |
| 195 (if (and current (toolbar-button-p button)) | |
| 196 (set-toolbar-button-down-flag button nil)))) | |
| 197 | |
| 198 (defun release-toolbar-button (event) | |
| 199 "Release all pressed toolbar buttons." | |
| 200 (interactive "_e") | |
| 201 (or (button-release-event-p event) | |
| 202 (error "%s must be invoked by a mouse-release" this-command)) | |
| 203 (release-toolbar-button-internal event t) | |
| 204 ;; Don't set this-command if we're being called | |
| 205 ;; from release-and-activate-toolbar-button. | |
| 206 (if (interactive-p) | |
| 207 (setq this-command last-command)) | |
| 208 (setq toolbar-active nil)) | |
| 209 | |
| 210 (defun release-previous-toolbar-button (event) | |
| 211 (setq zmacs-region-stays t) | |
| 212 (release-toolbar-button-internal event nil)) | |
| 213 | |
| 442 | 214 (defun make-toolbar-specifier (spec-list) |
| 215 "Return a new `toolbar' specifier object with the given specification list. | |
| 216 SPEC-LIST can be a list of specifications (each of which is a cons of a | |
| 217 locale and a list of instantiators), a single instantiator, or a list | |
| 218 of instantiators. See `make-specifier' for more information about | |
| 219 specifiers. | |
| 220 | |
| 221 Toolbar specifiers are used to specify the format of a toolbar. | |
| 222 The values of the variables `default-toolbar', `top-toolbar', | |
| 223 `left-toolbar', `right-toolbar', and `bottom-toolbar' are always | |
| 224 toolbar specifiers. | |
| 225 | |
| 226 Valid toolbar instantiators are called \"toolbar descriptors\" | |
| 227 and are lists of vectors. See `default-toolbar' for a description | |
| 228 of the exact format." | |
| 229 (make-specifier-and-init 'toolbar spec-list)) | |
| 230 | |
| 428 | 231 ;;; toolbar.el ends here |