Mercurial > hg > xemacs-beta
annotate src/cm.c @ 5576:071b810ceb18
Declare labels as line where appropriate; use #'labels, not #'flet, tests.
lisp/ChangeLog addition:
2011-10-03 Aidan Kehoe <kehoea@parhasard.net>
* simple.el (handle-pre-motion-command-current-command-is-motion):
Implement #'keysyms-equal with #'labels + (declare (inline ...)),
instead of abusing macrolet to the same end.
* specifier.el (let-specifier):
* mule/mule-cmds.el (describe-language-environment):
* mule/mule-cmds.el (set-language-environment-coding-systems):
* mule/mule-x-init.el (x-use-halfwidth-roman-font):
* faces.el (Face-frob-property):
* keymap.el (key-sequence-list-description):
* lisp-mode.el (construct-lisp-mode-menu):
* loadhist.el (unload-feature):
* mouse.el (default-mouse-track-check-for-activation):
Declare various labels inline in dumped files when that reduces
the size of the dumped image. Declaring labels inline is normally
only worthwhile for inner loops and so on, but it's reasonable
exercise of the related code to have these changes in core.
tests/ChangeLog addition:
2011-10-03 Aidan Kehoe <kehoea@parhasard.net>
* automated/case-tests.el (uni-mappings):
* automated/database-tests.el (delete-database-files):
* automated/hash-table-tests.el (iterations):
* automated/lisp-tests.el (test1):
* automated/lisp-tests.el (a):
* automated/lisp-tests.el (cl-floor):
* automated/lisp-tests.el (foo):
* automated/lisp-tests.el (list-nreverse):
* automated/lisp-tests.el (needs-lexical-context):
* automated/mule-tests.el (featurep):
* automated/os-tests.el (original-string):
* automated/os-tests.el (with):
* automated/symbol-tests.el (check-weak-list-unique):
Replace #'flet with #'labels where appropriate in these tests,
following my own advice on style in the docstrings of those
functions.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Mon, 03 Oct 2011 20:16:14 +0100 |
| parents | 308d34e9f07d |
| children | b3824b7f5627 |
| rev | line source |
|---|---|
| 428 | 1 /* Cursor motion subroutines for XEmacs. |
| 2 Copyright (C) 1985, 1994, 1995 Free Software Foundation, Inc. | |
|
5050
6f2158fa75ed
Fix quick-build, use asserts() in place of ABORT()
Ben Wing <ben@xemacs.org>
parents:
2500
diff
changeset
|
3 Copyright (C) 2010 Ben Wing. |
| 428 | 4 loosely based primarily on public domain code written by Chris Torek |
| 5 | |
| 6 This file is part of XEmacs. | |
| 7 | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5050
diff
changeset
|
8 XEmacs is free software: you can redistribute it and/or modify it |
| 428 | 9 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:
5050
diff
changeset
|
10 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:
5050
diff
changeset
|
11 option) any later version. |
| 428 | 12 |
| 13 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
| 14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
| 15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
| 16 for more details. | |
| 17 | |
| 18 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:
5050
diff
changeset
|
19 along with XEmacs. If not, see <http://www.gnu.org/licenses/>. */ |
| 428 | 20 |
| 21 /* Synched up with: FSF 19.30. Substantially different from FSF. */ | |
| 22 | |
| 23 /* #### This file is extremely junky and needs major fixup. */ | |
| 24 | |
| 25 #include <config.h> | |
| 26 #include "lisp.h" | |
| 27 | |
| 800 | 28 #include "device.h" |
| 428 | 29 #include "frame.h" |
| 30 #include "lstream.h" | |
| 31 #include "redisplay.h" | |
| 32 | |
| 872 | 33 #include "console-tty-impl.h" |
| 800 | 34 |
| 428 | 35 #define EXPENSIVE 2000 |
| 36 | |
| 442 | 37 EXTERN_C char *tgoto (const char *cm, int hpos, int vpos); |
| 38 EXTERN_C int tputs (const char *, int, void (*)(int)); | |
| 428 | 39 |
| 40 static void cmgoto_for_real (struct console *c, int row, int col); | |
| 41 | |
| 42 static int cm_cost_counter; /* sums up costs */ | |
| 43 | |
| 44 static void | |
| 2286 | 45 evalcost (int UNUSED (c)) |
| 428 | 46 { |
| 47 cm_cost_counter++; | |
| 48 } | |
| 49 | |
| 50 /* Ugh -- cmputc() can't take a console argument, so we pass it in a global */ | |
| 51 struct console *cmputc_console; | |
| 52 | |
| 53 void | |
| 54 send_string_to_tty_console (struct console *c, unsigned char *str, int len) | |
| 55 { | |
| 56 /* #### Ben sez: don't some terminals need nulls outputted | |
| 57 for proper timing? */ | |
| 58 Lstream *lstr = XLSTREAM (CONSOLE_TTY_DATA (c)->outstream); | |
| 59 | |
| 60 if (CONSOLE_TTY_REAL_CURSOR_X (c) != CONSOLE_TTY_CURSOR_X (c) | |
| 61 || CONSOLE_TTY_REAL_CURSOR_Y (c) != CONSOLE_TTY_CURSOR_Y (c)) | |
| 62 { | |
| 63 int row = CONSOLE_TTY_CURSOR_Y (c); | |
| 64 int col = CONSOLE_TTY_CURSOR_X (c); | |
| 65 cmgoto_for_real (c, row, col); | |
| 66 } | |
| 67 | |
| 68 if (len == 1) | |
| 69 Lstream_putc (lstr, *str); | |
| 70 else if (len > 0) | |
| 71 Lstream_write (lstr, str, len); | |
| 72 } | |
| 73 | |
| 74 void | |
| 75 cmputc (int c) | |
| 76 { | |
| 77 unsigned char ch = (unsigned char) c; | |
| 78 | |
| 79 if (termscript) | |
| 80 fputc (c, termscript); | |
| 81 | |
| 82 send_string_to_tty_console (cmputc_console, &ch, 1); | |
| 83 } | |
| 84 | |
| 85 #if 0 | |
| 86 | |
| 87 /* | |
| 88 * Terminals with magicwrap (xn) don't all behave identically. | |
| 89 * The VT100 leaves the cursor in the last column but will wrap before | |
| 90 * printing the next character. I hear that the Concept terminal does | |
| 91 * the wrap immediately but ignores the next newline it sees. And some | |
| 92 * terminals just have buggy firmware, and think that the cursor is still | |
| 93 * in limbo if we use direct cursor addressing from the phantom column. | |
| 94 * The only guaranteed safe thing to do is to emit a CRLF immediately | |
| 95 * after we reach the last column; this takes us to a known state. | |
| 96 */ | |
| 97 void | |
| 98 cmcheckmagic (void) | |
| 99 { | |
| 100 if (curX == FrameCols) | |
| 101 { | |
|
5050
6f2158fa75ed
Fix quick-build, use asserts() in place of ABORT()
Ben Wing <ben@xemacs.org>
parents:
2500
diff
changeset
|
102 assert (MagicWrap && curY < FrameRows - 1); |
| 428 | 103 if (termscript) |
| 104 putc ('\r', termscript); | |
| 105 putchar ('\r'); | |
| 106 if (termscript) | |
| 107 putc ('\n', termscript); | |
| 108 putchar ('\n'); | |
| 109 curX = 0; | |
| 110 curY++; | |
| 111 } | |
| 112 } | |
| 113 | |
| 114 #endif /* 0 */ | |
| 115 | |
| 116 /* | |
| 117 * (Re)Initialize the cost factors, given the output speed of the | |
| 118 * terminal in DEVICE_TTY_DATA (dev)->ospeed. (Note: this holds B300, | |
| 119 * B9600, etc -- ie stuff out of <sgtty.h>.) | |
| 120 */ | |
| 121 void | |
| 122 cm_cost_init (struct console *c) | |
| 123 { | |
| 124 char *tmp; | |
| 125 | |
| 126 cm_cost_counter = 0; | |
| 127 #define COST(x,e) (x \ | |
| 128 ? (cm_cost_counter = 0, tputs (x, 1, e), cm_cost_counter) \ | |
| 129 : EXPENSIVE) | |
| 130 #define MINCOST(x,e) ((x == 0) \ | |
| 131 ? EXPENSIVE \ | |
| 132 : (tmp = tgoto(x, 0, 0), COST(tmp,e))) | |
| 133 | |
| 134 TTY_COST (c).cm_up = COST (TTY_CM (c).up, evalcost); | |
| 135 TTY_COST (c).cm_down = COST (TTY_CM (c).down, evalcost); | |
| 136 TTY_COST (c).cm_left = COST (TTY_CM (c).left, evalcost); | |
| 137 TTY_COST (c).cm_right = COST (TTY_CM (c).right, evalcost); | |
| 138 TTY_COST (c).cm_home = COST (TTY_CM (c).home, evalcost); | |
| 139 TTY_COST (c).cm_low_left = COST (TTY_CM (c).low_left, evalcost); | |
| 140 TTY_COST (c).cm_car_return = COST (TTY_CM (c).car_return, evalcost); | |
| 141 | |
| 142 /* | |
| 143 * These last three are actually minimum costs. When (if) they are | |
| 144 * candidates for the least-cost motion, the real cost is computed. | |
| 145 * (Note that "0" is the assumed to generate the minimum cost. | |
| 146 * While this is not necessarily true, I have yet to see a terminal | |
| 147 * for which is not; all the terminals that have variable-cost | |
| 148 * cursor motion seem to take straight numeric values. --ACT) | |
| 149 */ | |
| 150 | |
| 151 TTY_COST (c).cm_abs = MINCOST (TTY_CM (c).abs, evalcost); | |
| 152 TTY_COST (c).cm_hor_abs = MINCOST (TTY_CM (c).hor_abs, evalcost); | |
| 153 TTY_COST (c).cm_ver_abs = MINCOST (TTY_CM (c).ver_abs, evalcost); | |
| 154 | |
| 155 #undef MINCOST | |
| 156 #undef COST | |
| 157 } | |
| 158 | |
| 159 /* | |
| 160 * Calculate the cost to move from (srcy, srcx) to (dsty, dstx) using | |
| 161 * up and down, and left and right, and motions. If doit is set | |
| 162 * actually perform the motion. | |
| 163 */ | |
| 164 | |
| 165 #ifdef NOT_YET | |
| 166 static int | |
| 167 calccost (struct frame *f, int srcy, int srcx, int dsty, int dstx, int doit) | |
| 168 { | |
| 169 struct console *c = XCONSOLE (FRAME_CONSOLE (f)); | |
| 170 int totalcost = 0; | |
| 171 int deltay, deltax; | |
| 172 char *motion; | |
| 173 int motion_cost; | |
| 174 | |
| 175 #if 0 | |
| 176 int ntabs, n2tabs, tabx, tab2x, tabcost; | |
| 177 #endif | |
| 178 | |
| 179 cmputc_console = c; | |
| 180 #if 0 | |
| 181 /* If have just wrapped on a terminal with xn, | |
| 182 don't believe the cursor position: give up here | |
| 183 and force use of absolute positioning. */ | |
| 184 if (curX == Wcm.cm_cols) | |
| 185 goto fail; | |
| 186 #endif | |
| 187 | |
| 188 deltay = dsty - srcy; | |
| 189 if (!deltay) | |
| 190 goto calculate_x; | |
| 191 | |
| 192 if (deltay < 0) | |
| 193 { | |
| 194 motion = TTY_CM (c).up; | |
| 195 motion_cost = TTY_COST (c).cm_up; | |
| 196 deltay = -deltay; | |
| 197 } | |
| 198 else | |
| 199 { | |
| 200 motion = TTY_CM (c).down; | |
| 201 motion_cost = TTY_COST (c).cm_down; | |
| 202 } | |
| 203 | |
| 204 if (motion_cost == EXPENSIVE) | |
| 205 { | |
| 206 /* if (doit) */ | |
| 207 /* #### printing OOF is not acceptable */ | |
| 208 return motion_cost; | |
| 209 } | |
| 210 | |
| 211 totalcost = motion_cost * deltay; | |
| 212 | |
| 213 if (doit) | |
| 214 while (--deltay >= 0) | |
| 215 tputs (motion, 1, cmputc); | |
| 216 | |
| 217 calculate_x: | |
| 218 | |
| 219 deltax = dstx - srcx; | |
| 220 if (!deltax) | |
| 221 goto done; | |
| 222 | |
| 223 if (deltax < 0) | |
| 224 { | |
| 225 motion = TTY_CM (c).left; | |
| 226 motion_cost = TTY_COST (c).cm_left; | |
| 227 deltax = -deltax; | |
| 228 } | |
| 229 else | |
| 230 { | |
| 231 motion = TTY_CM (c).right; | |
| 232 motion_cost = TTY_COST (c).cm_right; | |
| 233 } | |
| 234 | |
| 235 if (motion_cost == EXPENSIVE) | |
| 236 { | |
| 237 /* if (doit) */ | |
| 238 /* #### printing OOF is not acceptable */ | |
| 239 return motion_cost; | |
| 240 } | |
| 241 | |
| 242 totalcost += motion_cost * deltax; | |
| 243 | |
| 244 if (doit) | |
| 245 while (--deltax >= 0) | |
| 246 tputs (motion, 1, cmputc); | |
| 247 | |
| 248 done: | |
| 249 return totalcost; | |
| 250 } | |
| 251 #endif /* NOT_YET */ | |
| 252 | |
| 253 #define USEREL 0 | |
| 254 #define USEHOME 1 | |
| 255 #define USELL 2 | |
| 256 #define USECR 3 | |
| 257 | |
| 778 | 258 #ifdef OLD_CURSOR_MOTION_SHIT |
| 428 | 259 void |
| 260 cmgoto (struct frame *f, int row, int col) | |
| 261 { | |
| 262 struct console *c = XCONSOLE (FRAME_CONSOLE (f)); | |
| 263 char *motion; | |
| 264 #if 0 | |
| 265 int frame_x = FRAME_CURSOR_X(f); | |
| 266 int frame_y = FRAME_CURSOR_Y(f); | |
| 267 int relcost, directcost, llcost; | |
| 268 int homecost; | |
| 269 int use; | |
| 270 char *dcm; | |
| 271 #endif | |
| 272 | |
| 273 cmputc_console = c; | |
| 274 | |
| 275 /* First the degenerate case */ | |
| 276 #if 0 | |
| 277 if (row == frame_y && col == frame_x) | |
| 278 return; | |
| 279 #endif | |
| 280 | |
| 281 /* #### something is fucked with the non-absolute cases */ | |
| 282 motion = tgoto (TTY_CM (c).abs, col, row); | |
| 283 tputs (motion, 1, cmputc); | |
| 284 CONSOLE_TTY_DATA (c)->cursor_x = col; | |
| 285 CONSOLE_TTY_DATA (c)->cursor_y = row; | |
| 286 return; | |
| 287 | |
| 288 #if 0 | |
| 289 if (frame_y >= 0 && frame_x >= 0) | |
| 290 { | |
| 291 /* | |
| 292 * Pick least-cost motions | |
| 293 */ | |
| 294 | |
| 295 relcost = calccost (f, frame_y, frame_x, row, col, 0); | |
| 296 use = USEREL; | |
| 297 | |
| 298 homecost = TTY_COST (c).cm_home; | |
| 299 if (homecost < EXPENSIVE) | |
| 300 homecost += calccost (f, 0, 0, row, col, 0); | |
| 301 | |
| 302 if (homecost < relcost) | |
| 303 { | |
| 304 relcost = homecost; | |
| 305 use = USEHOME; | |
| 306 } | |
| 307 | |
| 308 llcost = TTY_COST (c).cm_low_left; | |
| 309 if (llcost < EXPENSIVE) | |
| 310 llcost += calccost (f, frame_y - 1, 0, row, col, 0); | |
| 311 | |
| 312 if (llcost < relcost) | |
| 313 { | |
| 314 relcost = llcost; | |
| 315 use = USELL; | |
| 316 } | |
| 317 | |
| 318 #if 0 | |
| 319 if ((crcost = Wcm.cc_cr) < BIG) { | |
| 320 if (Wcm.cm_autolf) | |
| 321 if (curY + 1 >= Wcm.cm_rows) | |
| 322 crcost = BIG; | |
| 323 else | |
| 324 crcost += calccost (curY + 1, 0, row, col, 0); | |
| 325 else | |
| 326 crcost += calccost (curY, 0, row, col, 0); | |
| 327 } | |
| 328 if (crcost < relcost) | |
| 329 relcost = crcost, use = USECR; | |
| 330 #endif | |
| 331 | |
| 332 directcost = TTY_COST (c).cm_abs; | |
| 333 dcm = TTY_CM (c).abs; | |
| 334 | |
| 335 if (row == frame_y && TTY_COST (c).cm_hor_abs < EXPENSIVE) | |
| 336 { | |
| 337 directcost = TTY_COST (c).cm_hor_abs; | |
| 338 dcm = TTY_CM (c).hor_abs; | |
| 339 } | |
| 340 else if (col == frame_x && TTY_COST (c).cm_ver_abs < EXPENSIVE) | |
| 341 { | |
| 342 directcost = TTY_COST (c).cm_ver_abs; | |
| 343 dcm = TTY_CM (c).ver_abs; | |
| 344 } | |
| 345 } | |
| 346 else | |
| 347 { | |
| 348 directcost = 0; | |
| 349 relcost = 100000; | |
| 350 dcm = TTY_CM (c).abs; | |
| 351 } | |
| 352 | |
| 353 /* | |
| 354 * In the following comparison, the = in <= is because when the costs | |
| 355 * are the same, it looks nicer (I think) to move directly there. | |
| 356 */ | |
| 357 if (directcost <= relcost) | |
| 358 { | |
| 359 /* compute REAL direct cost */ | |
| 360 cm_cost_counter = 0; | |
| 361 motion = (dcm == TTY_CM (c).hor_abs | |
| 362 ? tgoto (dcm, row, col) | |
| 363 : tgoto (dcm, col, row)); | |
| 364 tputs (motion, 1, evalcost); | |
| 365 if (cm_cost_counter <= relcost) | |
| 366 { /* really is cheaper */ | |
| 367 tputs (motion, 1, cmputc); | |
| 368 FRAME_CURSOR_Y (f) = row; | |
| 369 FRAME_CURSOR_X (f) = col; | |
| 370 return; | |
| 371 } | |
| 372 } | |
| 373 | |
| 374 switch (use) | |
| 375 { | |
| 376 case USEHOME: | |
| 377 tputs (TTY_CM (c).home, 1, cmputc); | |
| 378 FRAME_CURSOR_X (f) = 0; | |
| 379 FRAME_CURSOR_Y (f) = 0; | |
| 380 break; | |
| 381 | |
| 382 case USELL: | |
| 383 tputs (TTY_CM (c).low_left, 1, cmputc); | |
| 384 FRAME_CURSOR_Y (f) = FRAME_HEIGHT (f) - 1; | |
| 385 FRAME_CURSOR_X (f) = 0; | |
| 386 break; | |
| 387 | |
| 388 #if 0 | |
| 389 case USECR: | |
| 390 tputs (Wcm.cm_cr, 1, cmputc); | |
| 391 if (Wcm.cm_autolf) | |
| 392 curY++; | |
| 393 curX = 0; | |
| 394 break; | |
| 395 #endif | |
| 396 } | |
| 397 | |
| 398 calccost (f, FRAME_CURSOR_Y (f), FRAME_CURSOR_X (f), row, col, 1); | |
| 399 FRAME_CURSOR_Y (f) = row; | |
| 400 FRAME_CURSOR_X (f) = col; | |
| 401 #endif | |
| 402 } | |
| 403 #endif /* OLD_CURSOR_MOTION_SHIT */ | |
| 404 | |
| 405 /***************************************************************************** | |
| 406 cmgoto | |
| 407 | |
| 408 This function is responsible for getting the cursor from its current | |
| 409 location to the passed location in the most efficient manner | |
| 410 possible. | |
| 411 ****************************************************************************/ | |
| 412 static void | |
| 413 cmgoto_for_real (struct console *c, int row, int col) | |
| 414 { | |
| 415 char *motion; | |
| 416 | |
| 417 cmputc_console = c; | |
| 418 | |
| 419 /* First make sure that we actually have to do any work at all. */ | |
| 420 if (CONSOLE_TTY_REAL_CURSOR_X (c) == col | |
| 421 && CONSOLE_TTY_REAL_CURSOR_Y (c) == row) | |
| 422 return; | |
| 423 | |
| 424 CONSOLE_TTY_REAL_CURSOR_X (c) = col; | |
| 425 CONSOLE_TTY_REAL_CURSOR_Y (c) = row; | |
| 426 | |
| 427 /* #### Need to reimplement cost analysis and potential relative | |
| 428 movement. */ | |
| 429 | |
| 430 /* If all else fails, use absolute movement. */ | |
| 431 motion = tgoto (TTY_CM (c).abs, col, row); | |
| 432 tputs (motion, 1, cmputc); | |
| 433 CONSOLE_TTY_CURSOR_X (c) = col; | |
| 434 CONSOLE_TTY_CURSOR_Y (c) = row; | |
| 435 } | |
| 436 | |
| 437 void | |
| 438 cmgoto (struct frame *f, int row, int col) | |
| 439 { | |
| 440 /* We delay cursor motion until we do something other than cursor motion, | |
| 441 to optimize the case where cmgoto() is called twice in a row. */ | |
| 442 struct console *c = XCONSOLE (FRAME_CONSOLE (f)); | |
| 443 CONSOLE_TTY_CURSOR_X (c) = col; | |
| 444 CONSOLE_TTY_CURSOR_Y (c) = row; | |
| 445 } | |
| 446 | |
| 447 #if 0 | |
| 448 /* Clear out all terminal info. | |
| 449 Used before copying into it the info on the actual terminal. | |
| 450 */ | |
| 451 | |
| 452 void | |
| 453 Wcm_clear (void) | |
| 454 { | |
| 455 xzero (Wcm); | |
| 456 UP = 0; | |
| 457 BC = 0; | |
| 458 } | |
| 459 #endif | |
| 460 | |
| 461 #if 0 | |
| 462 /* | |
| 463 * Initialized stuff | |
| 464 * Return 0 if can do CM. | |
| 465 * Return -1 if cannot. | |
| 466 * Return -2 if size not specified. | |
| 467 */ | |
| 468 | |
| 469 int | |
| 470 Wcm_init (void) | |
| 471 { | |
| 472 #if 0 | |
| 473 if (Wcm.cm_abs && !Wcm.cm_ds) | |
| 474 return 0; | |
| 475 #endif | |
| 476 if (Wcm.cm_abs) | |
| 477 return 0; | |
| 478 /* Require up and left, and, if no absolute, down and right */ | |
| 479 if (!Wcm.cm_up || !Wcm.cm_left) | |
| 480 return - 1; | |
| 481 if (!Wcm.cm_abs && (!Wcm.cm_down || !Wcm.cm_right)) | |
| 482 return - 1; | |
| 483 /* Check that we know the size of the frame.... */ | |
| 484 if (Wcm.cm_rows <= 0 || Wcm.cm_cols <= 0) | |
| 485 return - 2; | |
| 486 return 0; | |
| 487 } | |
| 488 #endif |