Mercurial > hg > xemacs-beta
annotate src/glyphs-shared.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 |
---|---|
608 | 1 /* Routines shared between window-system backends for glyph objects. |
563 | 2 Copyright (C) 1993, 1994 Free Software Foundation, Inc. |
4226 | 3 Copyright (C) 1995 Board of Trustees, University of Illinois |
563 | 4 Copyright (C) 1995 Tinker Systems |
771 | 5 Copyright (C) 1995, 1996, 2001 Ben Wing |
563 | 6 Copyright (C) 1995 Sun Microsystems |
4226 | 7 Copyright (C) 1998, 1999, 2000 Andy Piper |
563 | 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:
4834
diff
changeset
|
11 XEmacs is free software: you can redistribute it and/or modify it |
563 | 12 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:
4834
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:
4834
diff
changeset
|
14 option) any later version. |
563 | 15 |
16 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
17 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
18 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
19 for more details. | |
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:
4834
diff
changeset
|
22 along with XEmacs. If not, see <http://www.gnu.org/licenses/>. */ |
563 | 23 |
24 /* Synched up with: Not in FSF. */ | |
25 | |
26 /* taken from glyphs-*.c | |
27 HINT HINT HINT Bill Perry: Please put code here and avoid massive | |
28 duplication in *-gtk.c!!! */ | |
29 | |
30 #include <config.h> | |
31 #include "lisp.h" | |
32 | |
800 | 33 #include "buffer.h" |
563 | 34 #include "elhash.h" |
800 | 35 #include "faces.h" |
563 | 36 #include "frame.h" |
800 | 37 #include "glyphs.h" |
38 #include "imgproc.h" | |
563 | 39 #include "insdel.h" |
800 | 40 #include "lstream.h" |
563 | 41 #include "opaque.h" |
42 #include "sysdep.h" | |
800 | 43 #include "window.h" |
44 | |
563 | 45 #include "sysfile.h" |
46 | |
47 Lisp_Object Q_resource_type, Q_resource_id; | |
48 | |
49 void | |
50 shared_resource_validate (Lisp_Object instantiator) | |
51 { | |
52 if ((NILP (find_keyword_in_vector (instantiator, Q_file)) | |
53 && | |
54 NILP (find_keyword_in_vector (instantiator, Q_resource_id))) | |
55 || | |
56 NILP (find_keyword_in_vector (instantiator, Q_resource_type))) | |
57 sferror ("Must supply :file, :resource-id and :resource-type", | |
58 instantiator); | |
59 } | |
60 | |
61 | |
62 Lisp_Object | |
63 shared_resource_normalize (Lisp_Object inst, Lisp_Object console_type, | |
2286 | 64 Lisp_Object UNUSED (dest_mask), Lisp_Object tag) |
563 | 65 { |
66 /* This function can call lisp */ | |
67 Lisp_Object file = Qnil; | |
68 struct gcpro gcpro1, gcpro2; | |
69 Lisp_Object alist = Qnil; | |
70 | |
71 GCPRO2 (file, alist); | |
72 | |
73 file = potential_pixmap_file_instantiator (inst, Q_file, Q_data, | |
74 console_type); | |
75 | |
4226 | 76 if (NILP (file)) /* normalization impossible for the console type */ |
77 RETURN_UNGCPRO (Qnil); | |
78 | |
563 | 79 if (CONSP (file)) /* failure locating filename */ |
80 signal_double_image_error ("Opening pixmap file", | |
81 "no such file or directory", | |
82 Fcar (file)); | |
83 | |
4226 | 84 if (EQ (file, Qt)) /* no conversion necessary */ |
563 | 85 RETURN_UNGCPRO (inst); |
86 | |
87 alist = tagged_vector_to_alist (inst); | |
88 | |
89 { | |
90 alist = remassq_no_quit (Q_file, alist); | |
91 alist = Fcons (Fcons (Q_file, file), alist); | |
92 } | |
93 | |
94 { | |
95 Lisp_Object result = alist_to_tagged_vector (tag, alist); | |
96 free_alist (alist); | |
97 RETURN_UNGCPRO (result); | |
98 } | |
99 } | |
100 | |
608 | 101 /* Originally from xmu.c, but is now shared across X11, GTK, and MSW. */ |
102 /* | |
103 * Based on an optimized version provided by Jim Becker, August 5, 1988. | |
104 */ | |
105 | |
106 | |
107 #ifndef BitmapSuccess | |
108 #define BitmapSuccess 0 | |
109 #define BitmapOpenFailed 1 | |
110 #define BitmapFileInvalid 2 | |
111 #define BitmapNoMemory 3 | |
112 #endif | |
113 | |
114 #define MAX_SIZE 255 | |
115 | |
116 /* shared data for the image read/parse logic */ | |
117 static short hexTable[256]; /* conversion value */ | |
118 static int hex_initialized; /* easier to fill in at run time */ | |
119 | |
120 | |
121 /* | |
122 * Table index for the hex values. Initialized once, first time. | |
123 * Used for translation value or delimiter significance lookup. | |
124 */ | |
125 static void initHexTable (void) | |
126 { | |
127 /* | |
128 * We build the table at run time for several reasons: | |
129 * | |
130 * 1. portable to non-ASCII machines. | |
131 * 2. still reentrant since we set the init flag after setting table. | |
132 * 3. easier to extend. | |
133 * 4. less prone to bugs. | |
134 */ | |
135 hexTable['0'] = 0; hexTable['1'] = 1; | |
136 hexTable['2'] = 2; hexTable['3'] = 3; | |
137 hexTable['4'] = 4; hexTable['5'] = 5; | |
138 hexTable['6'] = 6; hexTable['7'] = 7; | |
139 hexTable['8'] = 8; hexTable['9'] = 9; | |
140 hexTable['A'] = 10; hexTable['B'] = 11; | |
141 hexTable['C'] = 12; hexTable['D'] = 13; | |
142 hexTable['E'] = 14; hexTable['F'] = 15; | |
143 hexTable['a'] = 10; hexTable['b'] = 11; | |
144 hexTable['c'] = 12; hexTable['d'] = 13; | |
145 hexTable['e'] = 14; hexTable['f'] = 15; | |
146 | |
147 /* delimiters of significance are flagged w/ negative value */ | |
148 hexTable[' '] = -1; hexTable[','] = -1; | |
149 hexTable['}'] = -1; hexTable['\n'] = -1; | |
150 hexTable['\t'] = -1; | |
151 | |
152 hex_initialized = 1; | |
153 } | |
154 | |
155 /* | |
156 * read next hex value in the input stream, return -1 if EOF | |
157 */ | |
158 static int NextInt (FILE *fstream) | |
159 { | |
160 int ch; | |
161 int value = 0; | |
162 int gotone = 0; | |
163 int done = 0; | |
164 | |
165 /* loop, accumulate hex value until find delimiter */ | |
166 /* skip any initial delimiters found in read stream */ | |
167 | |
168 while (!done) { | |
169 ch = getc(fstream); | |
170 if (ch == EOF) { | |
171 value = -1; | |
172 done++; | |
173 } else { | |
174 /* trim high bits, check type and accumulate */ | |
175 ch &= 0xff; | |
176 if (isascii(ch) && isxdigit(ch)) { | |
177 value = (value << 4) + hexTable[ch]; | |
178 gotone++; | |
179 } else if ((hexTable[ch]) < 0 && gotone) | |
180 done++; | |
181 } | |
182 } | |
183 return value; | |
184 } | |
185 | |
186 | |
187 /* | |
188 * The data returned by the following routine is always in left-most byte | |
189 * first and left-most bit first. If it doesn't return BitmapSuccess then | |
190 * its arguments won't have been touched. This routine should look as much | |
191 * like the Xlib routine XReadBitmapfile as possible. | |
192 */ | |
611 | 193 static int |
2367 | 194 read_bitmap_data (FILE *fstream, int *width, int *height, Binbyte **datap, |
611 | 195 int *x_hot, int *y_hot) |
608 | 196 { |
2367 | 197 Binbyte *data = NULL; /* working variable */ |
198 Ascbyte line[MAX_SIZE]; /* input line from file */ | |
608 | 199 int size; /* number of bytes of data */ |
2367 | 200 Ascbyte name_and_type[MAX_SIZE]; /* an input line */ |
201 Ascbyte *type; /* for parsing */ | |
608 | 202 int value; /* from an input line */ |
203 int version10p; /* boolean, old format */ | |
204 int padding; /* to handle alignment */ | |
205 int bytes_per_line; /* per scanline of data */ | |
647 | 206 int ww = 0; /* width */ |
207 int hh = 0; /* height */ | |
608 | 208 int hx = -1; /* x hotspot */ |
209 int hy = -1; /* y hotspot */ | |
210 | |
211 #ifndef Xmalloc | |
212 #define Xmalloc(size) malloc(size) | |
213 #endif | |
214 | |
215 /* first time initialization */ | |
216 if (!hex_initialized) initHexTable(); | |
217 | |
218 /* error cleanup and return macro */ | |
219 #define RETURN(code) { if (data) free (data); return code; } | |
220 | |
221 while (fgets(line, MAX_SIZE, fstream)) { | |
222 if (strlen(line) == MAX_SIZE-1) { | |
223 RETURN (BitmapFileInvalid); | |
224 } | |
225 if (sscanf(line,"#define %s %d",name_and_type,&value) == 2) { | |
226 if (!(type = strrchr(name_and_type, '_'))) | |
227 type = name_and_type; | |
228 else | |
229 type++; | |
230 | |
231 if (!strcmp("width", type)) | |
647 | 232 ww = value; |
608 | 233 if (!strcmp("height", type)) |
647 | 234 hh = value; |
608 | 235 if (!strcmp("hot", type)) { |
236 if (type-- == name_and_type || type-- == name_and_type) | |
237 continue; | |
238 if (!strcmp("x_hot", type)) | |
239 hx = value; | |
240 if (!strcmp("y_hot", type)) | |
241 hy = value; | |
242 } | |
243 continue; | |
244 } | |
245 | |
246 if (sscanf(line, "static short %s = {", name_and_type) == 1) | |
247 version10p = 1; | |
248 else if (sscanf(line,"static unsigned char %s = {",name_and_type) == 1) | |
249 version10p = 0; | |
250 else if (sscanf(line, "static char %s = {", name_and_type) == 1) | |
251 version10p = 0; | |
252 else | |
253 continue; | |
254 | |
255 if (!(type = strrchr(name_and_type, '_'))) | |
256 type = name_and_type; | |
257 else | |
258 type++; | |
259 | |
260 if (strcmp("bits[]", type)) | |
261 continue; | |
262 | |
263 if (!ww || !hh) | |
264 RETURN (BitmapFileInvalid); | |
265 | |
266 if ((ww % 16) && ((ww % 16) < 9) && version10p) | |
267 padding = 1; | |
268 else | |
269 padding = 0; | |
270 | |
271 bytes_per_line = (ww+7)/8 + padding; | |
272 | |
273 size = bytes_per_line * hh; | |
2367 | 274 data = (Binbyte *) Xmalloc ((unsigned int) size); |
608 | 275 if (!data) |
276 RETURN (BitmapNoMemory); | |
277 | |
278 if (version10p) { | |
2367 | 279 Binbyte *ptr; |
608 | 280 int bytes; |
281 | |
282 for (bytes=0, ptr=data; bytes<size; (bytes += 2)) { | |
283 if ((value = NextInt(fstream)) < 0) | |
284 RETURN (BitmapFileInvalid); | |
285 *(ptr++) = value; | |
286 if (!padding || ((bytes+2) % bytes_per_line)) | |
287 *(ptr++) = value >> 8; | |
288 } | |
289 } else { | |
2367 | 290 Binbyte *ptr; |
608 | 291 int bytes; |
292 | |
293 for (bytes=0, ptr=data; bytes<size; bytes++, ptr++) { | |
294 if ((value = NextInt(fstream)) < 0) | |
295 RETURN (BitmapFileInvalid); | |
296 *ptr=value; | |
297 } | |
298 } | |
299 break; | |
300 } /* end while */ | |
301 | |
302 if (data == NULL) { | |
303 RETURN (BitmapFileInvalid); | |
304 } | |
305 | |
306 *datap = data; | |
307 data = NULL; | |
308 *width = ww; | |
309 *height = hh; | |
310 if (x_hot) *x_hot = hx; | |
311 if (y_hot) *y_hot = hy; | |
312 | |
313 RETURN (BitmapSuccess); | |
314 } | |
315 | |
316 | |
611 | 317 int |
771 | 318 read_bitmap_data_from_file (Lisp_Object filename, |
611 | 319 /* Remaining args are RETURNED */ |
647 | 320 int *width, |
321 int *height, | |
2367 | 322 Binbyte **datap, |
611 | 323 int *x_hot, int *y_hot) |
608 | 324 { |
771 | 325 FILE *fstream; |
326 int status; | |
327 Extbyte *fileext; | |
608 | 328 |
4834
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4226
diff
changeset
|
329 LISP_PATHNAME_CONVERT_OUT (filename, fileext); |
771 | 330 if ((fstream = fopen (fileext, "r")) == NULL) |
331 return BitmapOpenFailed; | |
332 status = read_bitmap_data (fstream, width, height, datap, x_hot, y_hot); | |
333 retry_fclose (fstream); | |
334 return status; | |
608 | 335 } |
336 | |
563 | 337 void |
338 syms_of_glyphs_shared (void) | |
339 { | |
340 DEFKEYWORD (Q_resource_id); | |
341 DEFKEYWORD (Q_resource_type); | |
342 } |