Mercurial > hg > xemacs-beta
annotate src/native-gtk-toolbar.c @ 5882:bbe4146603db
Reduce regexp usage, now CL-oriented non-regexp code available, core Lisp
lisp/ChangeLog addition:
2015-04-01 Aidan Kehoe <kehoea@parhasard.net>
When calling #'string-match with a REGEXP without regular
expression special characters, call #'search, #'mismatch, #'find,
etc. instead, making our code less likely to side-effect other
functions' match data and a little faster.
* apropos.el (apropos-command):
* apropos.el (apropos):
Call (position ?\n ...) rather than (string-match "\n" ...) here.
* buff-menu.el:
* buff-menu.el (buffers-menu-omit-invisible-buffers):
Don't fire up the regexp engine just to check if a string starts
with a space.
* buff-menu.el (select-buffers-tab-buffers-by-mode):
Don't fire up the regexp engine just to compare mode basenames.
* buff-menu.el (format-buffers-tab-line):
* buff-menu.el (build-buffers-tab-internal): Moved to being a
label within the following.
* buff-menu.el (buffers-tab-items): Use the label.
* bytecomp.el (byte-compile-log-1):
Don't fire up the regexp engine just to look for a newline.
* cus-edit.el (get):
Ditto.
* cus-edit.el (custom-variable-value-create):
Ditto, but for a colon.
* descr-text.el (describe-text-sexp):
Ditto.
* descr-text.el (describe-char-unicode-data):
Use #'split-string-by-char given that we're just looking for a
semicolon.
* descr-text.el (describe-char):
Don't fire up the regexp engine just to look for a newline.
* disass.el (disassemble-internal):
Ditto.
* files.el (file-name-sans-extension):
Implement this using #'position.
* files.el (file-name-extension):
Correct this function's docstring, implement it in terms of
#'position.
* files.el (insert-directory):
Don't fire up the regexp engine to split a string by space; don't
reverse the list of switches, this is actually a longstand bug as
far as I can see.
* gnuserv.el (gnuserv-process-filter):
Use #'position here, instead of consing inside #'split-string
needlessly.
* gtk-file-dialog.el (gtk-file-dialog-update-dropdown):
Use #'split-string-by-char here, don't fire up #'split-string for
directory-sep-char.
* gtk-font-menu.el (hack-font-truename):
Implement this more cheaply in terms of #'find,
#'split-string-by-char, #'equal, rather than #'string-match,
#'split-string, #'string-equal.
* hyper-apropos.el (hyper-apropos-grok-functions):
* hyper-apropos.el (hyper-apropos-grok-variables):
Look for a newline using #'position rather than #'string-match in
these functions.
* info.el (Info-insert-dir):
* info.el (Info-insert-file-contents):
* info.el (Info-follow-reference):
* info.el (Info-extract-menu-node-name):
* info.el (Info-menu):
Look for fixed strings using #'position or #'search as appropriate
in this file.
* ldap.el (ldap-decode-string):
* ldap.el (ldap-encode-string):
#'encode-coding-string, #'decode-coding-string are always
available, don't check if they're fboundp.
* ldap.el (ldap-decode-address):
* ldap.el (ldap-encode-address):
Use #'split-string-by-char in these functions.
* lisp-mnt.el (lm-creation-date):
* lisp-mnt.el (lm-last-modified-date):
Don't fire up the regexp engine just to look for spaces in this file.
* menubar-items.el (default-menubar):
Use (not (mismatch ...)) rather than #'string-match here, for
simple regexp.
Use (search "beta" ...) rather than (string-match "beta" ...)
* menubar-items.el (sort-buffers-menu-alphabetically):
* menubar-items.el (sort-buffers-menu-by-mode-then-alphabetically):
* menubar-items.el (group-buffers-menu-by-mode-then-alphabetically):
Don't fire up the regexp engine to check if a string starts with
a space or an asterisk.
Use the more fine-grained results of #'compare-strings; compare
case-insensitively for the buffer menu.
* menubar-items.el (list-all-buffers):
* menubar-items.el (tutorials-menu-filter):
Use #'equal rather than #'string-equal, which, in this context,
has the drawback of not having a bytecode, and no redeeming
features.
* minibuf.el:
* minibuf.el (un-substitute-in-file-name):
Use #'count, rather than counting the occurences of $ using the
regexp engine.
* minibuf.el (read-file-name-internal-1):
Don't fire up the regexp engine to search for ?=.
* mouse.el (mouse-eval-sexp):
Check for newline with #'find.
* msw-font-menu.el (mswindows-reset-device-font-menus):
Split a string by newline with #'split-string-by-char.
* mule/japanese.el:
* mule/japanese.el ("Japanese"):
Use #'search rather than #'string-match; canoncase before
comparing; fix a bug I had introduced where I had been making case
insensitive comparisons where the case mattered.
* mule/korea-util.el (default-korean-keyboard):
Look for ?3 using #'find, not #'string-march.
* mule/korea-util.el (quail-hangul-switch-hanja):
Search for a fixed string using #'search.
* mule/mule-cmds.el (set-locale-for-language-environment):
#'position, #'substitute rather than #'string-match,
#'replace-in-string.
* newcomment.el (comment-make-extra-lines):
Use #'search rather than #'string-match for a simple string.
* package-get.el (package-get-remote-filename):
Use #'position when looking for ?@
* process.el (setenv):
* process.el (read-envvar-name):
Use #'position when looking for ?=.
* replace.el (map-query-replace-regexp):
Use #'split-string-by-char instead of using an inline
implementation of it.
* select.el (select-convert-from-cf-text):
* select.el (select-convert-from-cf-unicodetext):
Use #'position rather than #'string-match in these functions.
* setup-paths.el (paths-emacs-data-root-p):
Use #'search when looking for simple string.
* sound.el (load-sound-file):
Use #'split-string-by-char rather than an inline reimplementation
of same.
* startup.el (splash-screen-window-body):
* startup.el (splash-screen-tty-body):
Search for simple strings using #'search.
* version.el (emacs-version):
Ditto.
* x-font-menu.el (hack-font-truename):
Implement this more cheaply in terms of #'find,
#'split-string-by-char, #'equal, rather than #'string-match,
#'split-string, #'string-equal.
* x-font-menu.el (x-reset-device-font-menus-core):
Use #'split-string-by-char here.
* x-init.el (x-initialize-keyboard):
Search for a simple string using #'search.
author | Aidan Kehoe <kehoea@parhasard.net> |
---|---|
date | Wed, 01 Apr 2015 14:28:20 +0100 |
parents | 308d34e9f07d |
children |
rev | line source |
---|---|
462 | 1 /* toolbar implementation -- GTK interface. |
2 Copyright (C) 2000 Aaron Lehmann | |
5077
d372b17f63ce
clean up toolbar/gutter edge geometry
Ben Wing <ben@xemacs.org>
parents:
2500
diff
changeset
|
3 Copyright (C) 2010 Ben Wing. |
462 | 4 |
5 This file is part of XEmacs. | |
6 | |
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5178
diff
changeset
|
7 XEmacs is free software: you can redistribute it and/or modify it |
462 | 8 under the terms of the GNU General Public License as published by the |
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5178
diff
changeset
|
9 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:
5178
diff
changeset
|
10 option) any later version. |
462 | 11 |
12 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
15 for more details. | |
16 | |
17 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:
5178
diff
changeset
|
18 along with XEmacs. If not, see <http://www.gnu.org/licenses/>. */ |
462 | 19 |
20 /* Synched up with: Not in FSF. */ | |
21 | |
22 #include <config.h> | |
23 #include "lisp.h" | |
24 | |
25 #include "console-gtk.h" | |
26 #include "glyphs-gtk.h" | |
5176
8b2f75cecb89
rename objects* (.c, .h and .el files) to fontcolor*
Ben Wing <ben@xemacs.org>
parents:
2500
diff
changeset
|
27 #include "fontcolor-gtk.h" |
462 | 28 |
29 #include "faces.h" | |
30 #include "frame.h" | |
31 #include "toolbar.h" | |
32 #include "window.h" | |
33 | |
34 static void | |
5077
d372b17f63ce
clean up toolbar/gutter edge geometry
Ben Wing <ben@xemacs.org>
parents:
2500
diff
changeset
|
35 gtk_clear_toolbar (struct frame *f, enum edge_pos pos); |
462 | 36 |
37 static void | |
2286 | 38 gtk_toolbar_callback (GtkWidget *UNUSED (w), gpointer user_data) |
462 | 39 { |
40 struct toolbar_button *tb = (struct toolbar_button *) user_data; | |
41 | |
42 call0 (tb->callback); | |
43 } | |
44 | |
45 | |
46 static void | |
5077
d372b17f63ce
clean up toolbar/gutter edge geometry
Ben Wing <ben@xemacs.org>
parents:
2500
diff
changeset
|
47 gtk_output_toolbar (struct frame *f, enum edge_pos pos) |
462 | 48 { |
49 GtkWidget *toolbar; | |
50 Lisp_Object button, window, glyph, instance; | |
51 unsigned int checksum = 0; | |
52 struct window *w; | |
53 int x, y, bar_width, bar_height, vert; | |
54 int cur_x, cur_y; | |
55 | |
56 window = FRAME_LAST_NONMINIBUF_WINDOW (f); | |
57 w = XWINDOW (window); | |
58 | |
59 get_toolbar_coords (f, pos, &x, &y, &bar_width, &bar_height, &vert, 0); | |
60 | |
61 /* Get the toolbar and delete the old widgets in it */ | |
62 button = FRAME_TOOLBAR_BUTTONS (f, pos); | |
63 | |
64 /* First loop over all of the buttons to determine how many there | |
65 are. This loop will also make sure that all instances are | |
66 instantiated so when we actually output them they will come up | |
67 immediately. */ | |
68 while (!NILP (button)) | |
69 { | |
70 struct toolbar_button *tb = XTOOLBAR_BUTTON (button); | |
71 checksum = HASH4 (checksum, | |
72 internal_hash (get_toolbar_button_glyph(w, tb), 0), | |
73 internal_hash (tb->callback, 0), | |
74 0 /* width */); | |
75 button = tb->next; | |
76 } | |
77 | |
78 /* Only do updates if the toolbar has changed, or this is the first | |
79 time we have drawn it in this position | |
80 */ | |
81 if (FRAME_GTK_TOOLBAR_WIDGET (f)[pos] && | |
82 FRAME_GTK_TOOLBAR_CHECKSUM (f, pos) == checksum) | |
83 { | |
84 return; | |
85 } | |
86 | |
87 /* Loop through buttons and add them to our toolbar. | |
88 This code ignores the button dimensions as we let GTK handle that :) | |
89 Attach the toolbar_button struct to the toolbar button so we know what | |
90 function to use as a callback. */ | |
91 | |
92 { | |
93 gtk_clear_toolbar (f, pos); | |
94 FRAME_GTK_TOOLBAR_WIDGET (f)[pos] = toolbar = | |
5077
d372b17f63ce
clean up toolbar/gutter edge geometry
Ben Wing <ben@xemacs.org>
parents:
2500
diff
changeset
|
95 gtk_toolbar_new (((pos == TOP_EDGE) || (pos == BOTTOM_EDGE)) ? |
462 | 96 GTK_ORIENTATION_HORIZONTAL : GTK_ORIENTATION_VERTICAL, |
97 GTK_TOOLBAR_BOTH); | |
98 } | |
99 | |
100 if (NILP (w->toolbar_buttons_captioned_p)) | |
101 gtk_toolbar_set_style (toolbar, GTK_TOOLBAR_ICONS); | |
102 else | |
103 gtk_toolbar_set_style (toolbar, GTK_TOOLBAR_BOTH); | |
104 | |
105 FRAME_GTK_TOOLBAR_CHECKSUM(f, pos) = checksum; | |
106 button = FRAME_TOOLBAR_BUTTONS (f, pos); | |
107 | |
108 cur_x = 0; | |
109 cur_y = 0; | |
110 | |
111 while (!NILP (button)) | |
112 { | |
113 struct toolbar_button *tb = XTOOLBAR_BUTTON (button); | |
114 | |
115 if (tb->blank) | |
116 { | |
117 /* It is a blank space... we do not pay attention to the | |
118 size, because the GTK toolbar does not allow us to | |
119 specify different spacings. *sigh* | |
120 */ | |
121 gtk_toolbar_append_space (GTK_TOOLBAR (toolbar)); | |
122 } | |
123 else | |
124 { | |
125 /* It actually has a glyph associated with it! What WILL | |
126 they think of next? | |
127 */ | |
128 glyph = tb->up_glyph; | |
129 | |
130 /* #### It is currently possible for users to trash us by directly | |
131 changing the toolbar glyphs. Avoid crashing in that case. */ | |
132 if (GLYPHP (glyph)) | |
793 | 133 instance = glyph_image_instance (glyph, window, |
134 ERROR_ME_DEBUG_WARN, 1); | |
462 | 135 else |
136 instance = Qnil; | |
137 | |
138 if (IMAGE_INSTANCEP(instance)) | |
139 { | |
140 GtkWidget *pixmapwid; | |
141 GdkPixmap *pixmap; | |
142 GdkBitmap *mask; | |
143 char *tooltip = NULL; | |
144 | |
145 if (STRINGP (tb->help_string)) | |
146 tooltip = XSTRING_DATA (tb->help_string); | |
147 | |
148 pixmap = XIMAGE_INSTANCE_GTK_PIXMAP(instance); | |
149 mask = XIMAGE_INSTANCE_GTK_MASK(instance); | |
150 pixmapwid = gtk_pixmap_new (pixmap, mask); | |
151 | |
152 gtk_widget_set_usize (pixmapwid, tb->width, tb->height); | |
153 | |
154 gtk_toolbar_append_item (GTK_TOOLBAR(toolbar), NULL, tooltip, NULL, | |
155 pixmapwid, gtk_toolbar_callback, (gpointer) tb); | |
156 } | |
157 } | |
158 cur_x += vert ? 0 : tb->width; | |
159 cur_y += vert ? tb->height : 0; | |
160 /* Who's idea was it to use a linked list for toolbar buttons? */ | |
161 button = tb->next; | |
162 } | |
163 | |
164 SET_TOOLBAR_WAS_VISIBLE_FLAG (f, pos, 1); | |
165 | |
166 x -= vert ? 3 : 2; | |
167 y -= vert ? 2 : 3; | |
168 | |
169 gtk_fixed_put (GTK_FIXED (FRAME_GTK_TEXT_WIDGET (f)), FRAME_GTK_TOOLBAR_WIDGET (f)[pos],x, y); | |
170 gtk_widget_show_all (FRAME_GTK_TOOLBAR_WIDGET (f)[pos]); | |
171 } | |
172 | |
173 static void | |
5077
d372b17f63ce
clean up toolbar/gutter edge geometry
Ben Wing <ben@xemacs.org>
parents:
2500
diff
changeset
|
174 gtk_clear_toolbar (struct frame *f, enum edge_pos pos) |
462 | 175 { |
176 FRAME_GTK_TOOLBAR_CHECKSUM (f, pos) = 0; | |
177 SET_TOOLBAR_WAS_VISIBLE_FLAG (f, pos, 0); | |
178 if (FRAME_GTK_TOOLBAR_WIDGET(f)[pos]) | |
179 gtk_widget_destroy (FRAME_GTK_TOOLBAR_WIDGET(f)[pos]); | |
180 } | |
181 | |
182 static void | |
183 gtk_output_frame_toolbars (struct frame *f) | |
184 { | |
5077
d372b17f63ce
clean up toolbar/gutter edge geometry
Ben Wing <ben@xemacs.org>
parents:
2500
diff
changeset
|
185 enum edge_pos pos; |
462 | 186 |
5077
d372b17f63ce
clean up toolbar/gutter edge geometry
Ben Wing <ben@xemacs.org>
parents:
2500
diff
changeset
|
187 EDGE_POS_LOOP (pos) |
d372b17f63ce
clean up toolbar/gutter edge geometry
Ben Wing <ben@xemacs.org>
parents:
2500
diff
changeset
|
188 { |
d372b17f63ce
clean up toolbar/gutter edge geometry
Ben Wing <ben@xemacs.org>
parents:
2500
diff
changeset
|
189 if (FRAME_REAL_TOOLBAR_VISIBLE (f, pos)) |
d372b17f63ce
clean up toolbar/gutter edge geometry
Ben Wing <ben@xemacs.org>
parents:
2500
diff
changeset
|
190 gtk_output_toolbar (f, pos); |
d372b17f63ce
clean up toolbar/gutter edge geometry
Ben Wing <ben@xemacs.org>
parents:
2500
diff
changeset
|
191 else if (f->toolbar_was_visible[pos]) |
d372b17f63ce
clean up toolbar/gutter edge geometry
Ben Wing <ben@xemacs.org>
parents:
2500
diff
changeset
|
192 gtk_clear_toolbar (f, pos); |
d372b17f63ce
clean up toolbar/gutter edge geometry
Ben Wing <ben@xemacs.org>
parents:
2500
diff
changeset
|
193 } |
462 | 194 } |
195 | |
196 static void | |
2286 | 197 gtk_initialize_frame_toolbars (struct frame *UNUSED (f)) |
462 | 198 { |
199 stderr_out ("We should draw toolbars\n"); | |
200 } | |
201 | |
202 | |
203 /************************************************************************/ | |
204 /* initialization */ | |
205 /************************************************************************/ | |
206 | |
207 void | |
208 console_type_create_toolbar_gtk (void) | |
209 { | |
210 CONSOLE_HAS_METHOD (gtk, output_frame_toolbars); | |
211 CONSOLE_HAS_METHOD (gtk, initialize_frame_toolbars); | |
212 } |