Mercurial > hg > xemacs-beta
annotate src/tparam.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 |
---|---|
0 | 1 /* Merge parameters into a termcap entry string. |
2 Copyright (C) 1985, 1987, 1992, 1993, 1994 Free Software Foundation, Inc. | |
3 | |
4 This file is part of XEmacs. | |
5 | |
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
3025
diff
changeset
|
6 XEmacs is free software: you can redistribute it and/or modify it |
0 | 7 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:
3025
diff
changeset
|
8 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:
3025
diff
changeset
|
9 option) any later version. |
0 | 10 |
11 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
12 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
13 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
14 for more details. | |
15 | |
16 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:
3025
diff
changeset
|
17 along with XEmacs. If not, see <http://www.gnu.org/licenses/>. */ |
0 | 18 |
19 /* Synched up with: Not synched with FSF. */ | |
20 | |
21 /* config.h may rename various library functions such as malloc. */ | |
22 #include <config.h> | |
647 | 23 #include "lisp.h" |
0 | 24 |
551 | 25 #undef realloc |
26 #undef malloc | |
0 | 27 #define realloc xrealloc |
28 #define malloc xmalloc | |
29 | |
30 /* Assuming STRING is the value of a termcap string entry | |
31 containing `%' constructs to expand parameters, | |
32 merge in parameter values and store result in block OUTSTRING points to. | |
33 LEN is the length of OUTSTRING. If more space is needed, | |
34 a block is allocated with `malloc'. | |
35 | |
36 The value returned is the address of the resulting string. | |
37 This may be OUTSTRING or may be the address of a block got with `malloc'. | |
38 In the latter case, the caller must free the block. | |
39 | |
40 The fourth and following args to tparam serve as the parameter values. */ | |
41 | |
398 | 42 static char *tparam1 (const char *string, char *outstring, int len, |
43 const char *up, const char *left, | |
0 | 44 int *argp); |
45 | |
46 /* XEmacs: renamed this function because just tparam() conflicts with | |
47 ncurses */ | |
398 | 48 char *emacs_tparam (const char *string, char *outstring, int len, int arg0, |
0 | 49 int arg1, int arg2, int arg3); |
50 char * | |
398 | 51 emacs_tparam (const char *string, char *outstring, int len, int arg0, |
0 | 52 int arg1, int arg2, int arg3) |
53 { | |
54 int arg[4]; | |
55 arg[0] = arg0; | |
56 arg[1] = arg1; | |
57 arg[2] = arg2; | |
58 arg[3] = arg3; | |
59 return tparam1 (string, outstring, len, 0, 0, arg); | |
60 } | |
61 | |
398 | 62 const char *BC; |
63 const char *UP; | |
0 | 64 |
65 static char tgoto_buf[50]; | |
66 | |
398 | 67 char *tgoto (const char *cm, int hpos, int vpos); |
0 | 68 char * |
398 | 69 tgoto (const char *cm, int hpos, int vpos) |
0 | 70 { |
71 int args[2]; | |
72 if (!cm) | |
73 return 0; | |
74 args[0] = vpos; | |
75 args[1] = hpos; | |
76 return tparam1 (cm, tgoto_buf, 50, UP, BC, args); | |
77 } | |
78 | |
79 static char * | |
398 | 80 tparam1 (const char *string, char *outstring, int len, const char *up, |
81 const char *left, int *argp) | |
0 | 82 { |
83 int c; | |
398 | 84 const char *p = string; |
0 | 85 char *op = outstring; |
86 char *outend; | |
87 int outlen = 0; | |
88 | |
89 int tem; | |
90 int *old_argp = argp; | |
91 int doleft = 0; | |
92 int doup = 0; | |
93 | |
94 outend = outstring + len; | |
95 | |
96 while (1) | |
97 { | |
98 /* If the buffer might be too short, make it bigger. */ | |
99 if (op + 5 >= outend) | |
100 { | |
3025 | 101 char *new_; |
0 | 102 if (outlen == 0) |
103 { | |
104 outlen = len + 40; | |
3025 | 105 new_ = (char *) malloc (outlen); |
0 | 106 outend += 40; |
3025 | 107 memcpy (new_, outstring, op - outstring); |
0 | 108 } |
109 else | |
110 { | |
111 outend += outlen; | |
112 outlen *= 2; | |
3025 | 113 new_ = (char *) realloc (outstring, outlen); |
0 | 114 } |
3025 | 115 op += new_ - outstring; |
116 outend += new_ - outstring; | |
117 outstring = new_; | |
0 | 118 } |
119 c = *p++; | |
120 if (!c) | |
121 break; | |
122 if (c == '%') | |
123 { | |
124 c = *p++; | |
125 tem = *argp; | |
126 switch (c) | |
127 { | |
128 case 'd': /* %d means output in decimal. */ | |
129 if (tem < 10) | |
130 goto onedigit; | |
131 if (tem < 100) | |
132 goto twodigit; | |
133 case '3': /* %3 means output in decimal, 3 digits. */ | |
134 if (tem > 999) | |
135 { | |
136 *op++ = tem / 1000 + '0'; | |
137 tem %= 1000; | |
138 } | |
139 *op++ = tem / 100 + '0'; | |
140 case '2': /* %2 means output in decimal, 2 digits. */ | |
141 twodigit: | |
142 tem %= 100; | |
143 *op++ = tem / 10 + '0'; | |
144 onedigit: | |
145 *op++ = tem % 10 + '0'; | |
146 argp++; | |
147 break; | |
148 | |
149 case 'C': | |
150 /* For c-100: print quotient of value by 96, if nonzero, | |
151 then do like %+. */ | |
152 if (tem >= 96) | |
153 { | |
154 *op++ = tem / 96; | |
155 tem %= 96; | |
156 } | |
157 case '+': /* %+x means add character code of char x. */ | |
158 tem += *p++; | |
159 case '.': /* %. means output as character. */ | |
160 if (left) | |
161 { | |
162 /* If want to forbid output of 0 and \n and \t, | |
163 and this is one of them, increment it. */ | |
164 while (tem == 0 || tem == '\n' || tem == '\t') | |
165 { | |
166 tem++; | |
167 if (argp == old_argp) | |
168 doup++, outend -= strlen (up); | |
169 else | |
170 doleft++, outend -= strlen (left); | |
171 } | |
172 } | |
173 *op++ = tem | 0200; | |
174 case 'f': /* %f means discard next arg. */ | |
175 argp++; | |
176 break; | |
177 | |
178 case 'b': /* %b means back up one arg (and re-use it). */ | |
179 argp--; | |
180 break; | |
181 | |
182 case 'r': /* %r means interchange following two args. */ | |
183 argp[0] = argp[1]; | |
184 argp[1] = tem; | |
185 old_argp++; | |
186 break; | |
187 | |
188 case '>': /* %>xy means if arg is > char code of x, */ | |
189 if (argp[0] > *p++) /* then add char code of y to the arg, */ | |
190 argp[0] += *p; /* and in any case don't output. */ | |
191 p++; /* Leave the arg to be output later. */ | |
192 break; | |
193 | |
194 case 'a': /* %a means arithmetic. */ | |
195 /* Next character says what operation. | |
196 Add or subtract either a constant or some other arg. */ | |
197 /* First following character is + to add or - to subtract | |
198 or = to assign. */ | |
199 /* Next following char is 'p' and an arg spec | |
200 (0100 plus position of that arg relative to this one) | |
201 or 'c' and a constant stored in a character. */ | |
202 tem = p[2] & 0177; | |
203 if (p[1] == 'p') | |
204 tem = argp[tem - 0100]; | |
205 if (p[0] == '-') | |
206 argp[0] -= tem; | |
207 else if (p[0] == '+') | |
208 argp[0] += tem; | |
209 else if (p[0] == '*') | |
210 argp[0] *= tem; | |
211 else if (p[0] == '/') | |
212 argp[0] /= tem; | |
213 else | |
214 argp[0] = tem; | |
215 | |
216 p += 3; | |
217 break; | |
218 | |
219 case 'i': /* %i means add one to arg, */ | |
220 argp[0] ++; /* and leave it to be output later. */ | |
221 argp[1] ++; /* Increment the following arg, too! */ | |
222 break; | |
223 | |
224 case '%': /* %% means output %; no arg. */ | |
225 goto ordinary; | |
226 | |
227 case 'n': /* %n means xor each of next two args with 140. */ | |
228 argp[0] ^= 0140; | |
229 argp[1] ^= 0140; | |
230 break; | |
231 | |
232 case 'm': /* %m means xor each of next two args with 177. */ | |
233 argp[0] ^= 0177; | |
234 argp[1] ^= 0177; | |
235 break; | |
236 | |
237 case 'B': /* %B means express arg as BCD char code. */ | |
238 argp[0] += 6 * (tem / 10); | |
239 break; | |
240 | |
241 case 'D': /* %D means weird Delta Data transformation. */ | |
242 argp[0] -= 2 * (tem % 16); | |
243 break; | |
244 } | |
245 } | |
246 else | |
247 /* Ordinary character in the argument string. */ | |
248 ordinary: | |
249 *op++ = c; | |
250 } | |
251 *op = 0; | |
252 while (doup-- > 0) | |
253 strcat (op, up); | |
254 while (doleft-- > 0) | |
255 strcat (op, left); | |
256 return outstring; | |
257 } |