Mercurial > hg > xemacs-beta

comparison src/indent.c @ 0:376386a54a3c r19-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children 0293115a14e9
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
1 /* Indentation functions.
2 Copyright (C) 1995 Board of Trustees, University of Illinois.
3 Copyright (C) 1985, 1986, 1987, 1988, 1992, 1993, 1994, 1995
4 Free Software Foundation, Inc.
5
6 This file is part of XEmacs.
7
8 XEmacs is free software; you can redistribute it and/or modify it
9 under the terms of the GNU General Public License as published by the
10 Free Software Foundation; either version 2, or (at your option) any
11 later version.
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
19 along with XEmacs; see the file COPYING. If not, write to
20 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
21 Boston, MA 02111-1307, USA. */
22
23 /* This file has been Mule-ized. */
24
25 /* Synched up with: 19.30. Diverges significantly from FSF. */
26
27
28 #include <config.h>
29 #include "lisp.h"
30
31 #include "buffer.h"
32 #include "device.h"
33 #include "extents.h"
34 #include "faces.h"
35 #include "frame.h"
36 #include "glyphs.h"
37 #include "insdel.h"
38 #ifdef REGION_CACHE_NEEDS_WORK
39 #include "region-cache.h"
40 #endif
41 #include "window.h"
42
43 /* Indentation can insert tabs if this is non-zero;
44 otherwise always uses spaces */
45 int indent_tabs_mode;
46
47 /* Avoid recalculation by remembering things in these variables. */
48
49 /* Last value returned by current_column.
50
51 Some things set last_known_column_point to -1
52 to mark the memoized value as invalid */
53 static int last_known_column;
54
55 /* Last buffer searched by current_column */
56 static struct buffer *last_known_column_buffer;
57
58 /* Value of point when current_column was called */
59 static Bufpos last_known_column_point;
60
61 /* Value of MODIFF when current_column was called */
62 static int last_known_column_modified;
63
64 static Bufpos
65 last_visible_position (Bufpos pos, struct buffer *buf)
66 {
67 Lisp_Object buffer;
68 Lisp_Object value;
69
70 XSETBUFFER (buffer, buf);
71 value = Fprevious_single_property_change (make_int (pos), Qinvisible,
72 buffer, Qnil);
73 if (NILP (value))
74 return 0; /* no visible position found */
75 else
76 /* #### bug bug bug!!! This will return the position of the beginning
77 of an invisible extent; this extent is very likely to be start-closed,
78 and thus the spaces inserted in `indent-to' will go inside the
79 invisible extent.
80
81 Not sure what the correct solution is here. Rethink indent-to? */
82 return XINT (value);
83 }
84
85 #ifdef REGION_CACHE_NEEDS_WORK
86
87 /* Allocate or free the width run cache, as requested by the current
88 state of current_buffer's cache_long_line_scans variable. */
89 static void
90 width_run_cache_on_off (struct buffer *buf)
91 {
92 if (NILP (buf->cache_long_line_scans))
93 {
94 /* It should be off. */
95 if (buf->width_run_cache)
96 {
97 free_region_cache (buf->width_run_cache);
98 buf->width_run_cache = 0;
99 buf->width_table = Qnil;
100 }
101 }
102 else
103 {
104 /* It should be on. */
105 if (buf->width_run_cache == 0)
106 {
107 buf->width_run_cache = new_region_cache ();
108 recompute_width_table (buf, buffer_display_table ());
109 }
110 }
111 }
112
113 #endif /* REGION_CACHE_NEEDS_WORK */
114
115
116 /* Cancel any recorded value of the horizontal position. */
117
118 void
119 invalidate_current_column (void)
120 {
121 last_known_column_point = -1;
122 }
123
124 int
125 column_at_point (struct buffer *buf, Bufpos init_pos, int cur_col)
126 {
127 int col;
128 int tab_seen;
129 int tab_width = XINT (buf->tab_width);
130 int post_tab;
131 Bufpos pos = init_pos;
132
133 if (tab_width <= 0 || tab_width > 1000) tab_width = 8;
134 col = tab_seen = post_tab = 0;
135
136 while (1)
137 {
138 if (pos <= BUF_BEGV (buf))
139 break;
140
141 pos--;
142 if (BUF_FETCH_CHAR (buf, pos) == '\t')
143 {
144 if (tab_seen)
145 col = ((col + tab_width) / tab_width) * tab_width;
146
147 post_tab += col;
148 col = 0;
149 tab_seen = 1;
150 }
151 else if (BUF_FETCH_CHAR (buf, pos) == '\n' ||
152 (EQ (buf->selective_display, Qt) &&
153 BUF_FETCH_CHAR (buf, pos) == '\r'))
154 break;
155 else
156 {
157 /* #### This needs updating to handle the new redisplay. */
158 /* #### FSFmacs looks at ctl_arrow, display tables.
159 We need to do similar. */
160 #if 0
161 displayed_glyphs = glyphs_from_bufpos (sel_frame, buf,
162 XWINDOW (selected_window),
163 pos, dp, 0, col, 0, 0, 0);
164 col += (displayed_glyphs->columns
165 - (displayed_glyphs->begin_columns
166 + displayed_glyphs->end_columns));
167 #else
168 col++;
169 #endif
170 }
171 }
172
173 if (tab_seen)
174 {
175 col = ((col + tab_width) / tab_width) * tab_width;
176 col += post_tab;
177 }
178
179 if (cur_col)
180 {
181 last_known_column_buffer = buf;
182 last_known_column = col;
183 last_known_column_point = BUF_PT (buf);
184 last_known_column_modified = BUF_MODIFF (buf);
185 }
186
187 return col;
188 }
189
190 int
191 current_column (struct buffer *buf)
192 {
193 if (buf == last_known_column_buffer
194 && BUF_PT (buf) == last_known_column_point
195 && BUF_MODIFF (buf) == last_known_column_modified)
196 return last_known_column;
197
198 return column_at_point (buf, BUF_PT (buf), 1);
199 }
200
201 DEFUN ("current-column", Fcurrent_column, Scurrent_column, 0, 1, 0 /*
202 Return the horizontal position of point. Beginning of line is column 0.
203 This is calculated by adding together the widths of all the displayed
204 representations of the character between the start of the previous line
205 and point. (e.g. control characters will have a width of 2 or 4, tabs
206 will have a variable width.)
207 Ignores finite width of frame, which means that this function may return
208 values greater than (frame-width).
209 Whether the line is visible (if `selective-display' is t) has no effect;
210 however, ^M is treated as end of line when `selective-display' is t.
211 If BUFFER is nil, the current buffer is assumed.
212 */ )
213 (buffer)
214 Lisp_Object buffer;
215 {
216 return (make_int (current_column (decode_buffer (buffer, 0))));
217 }
218
219
220 DEFUN ("indent-to", Findent_to, Sindent_to, 1, 3, "NIndent to column: " /*
221 Indent from point with tabs and spaces until COLUMN is reached.
222 Optional second argument MIN says always do at least MIN spaces
223 even if that goes past COLUMN; by default, MIN is zero.
224 If BUFFER is nil, the current buffer is assumed.
225 */ )
226 (col, minimum, buffer)
227 Lisp_Object col, minimum, buffer;
228 {
229 /* This function can GC */
230 int mincol;
231 int fromcol;
232 struct buffer *buf = decode_buffer (buffer, 0);
233 int tab_width = XINT (buf->tab_width);
234 Bufpos opoint = 0;
235
236 CHECK_INT (col);
237 if (NILP (minimum))
238 minimum = Qzero;
239 else
240 CHECK_INT (minimum);
241
242 XSETBUFFER (buffer, buf);
243
244 fromcol = current_column (buf);
245 mincol = fromcol + XINT (minimum);
246 if (mincol < XINT (col)) mincol = XINT (col);
247
248 if (fromcol == mincol)
249 return make_int (mincol);
250
251 if (tab_width <= 0 || tab_width > 1000) tab_width = 8;
252
253 if (!NILP (Fextent_at (make_int (BUF_PT (buf)), buffer, Qinvisible,
254 Qnil, Qnil)))
255 {
256 Bufpos last_visible = last_visible_position (BUF_PT (buf), buf);
257
258 opoint = BUF_PT (buf);
259 if (last_visible >= BUF_BEGV (buf))
260 BUF_SET_PT (buf, last_visible);
261 else
262 error ("Visible portion of buffer not modifiable");
263 }
264
265 if (indent_tabs_mode)
266 {
267 int n = mincol / tab_width - fromcol / tab_width;
268 if (n != 0)
269 {
270 Finsert_char (make_char ('\t'), make_int (n), Qnil, buffer);
271
272 fromcol = (mincol / tab_width) * tab_width;
273 }
274 }
275
276 Finsert_char (make_char (' '), make_int (mincol - fromcol), Qnil, buffer);
277
278 last_known_column_buffer = buf;
279 last_known_column = mincol;
280 last_known_column_point = BUF_PT (buf);
281 last_known_column_modified = BUF_MODIFF (buf);
282
283 /* Not in FSF: */
284 if (opoint > 0)
285 BUF_SET_PT (buf, opoint);
286
287 return (make_int (mincol));
288 }
289
290 int
291 bi_spaces_at_point (struct buffer *b, Bytind bi_pos)
292 {
293 Bytind bi_end = BI_BUF_ZV (b);
294 int col = 0;
295 Emchar c;
296 int tab_width = XINT (b->tab_width);
297
298 if (tab_width <= 0 || tab_width > 1000)
299 tab_width = 8;
300
301 while (bi_pos < bi_end &&
302 (c = BI_BUF_FETCH_CHAR (b, bi_pos),
303 (c == '\t'
304 ? (col += tab_width - col % tab_width)
305 : (c == ' ' ? ++col : 0))))
306 INC_BYTIND (b, bi_pos);
307
308 return col;
309 }
310
311
312 DEFUN ("current-indentation", Fcurrent_indentation, Scurrent_indentation,
313 0, 1, 0 /*
314 Return the indentation of the current line.
315 This is the horizontal position of the character
316 following any initial whitespace.
317 */ )
318 (buffer)
319 Lisp_Object buffer;
320 {
321 struct buffer *buf = decode_buffer (buffer, 0);
322 Bufpos pos = find_next_newline (buf, BUF_PT (buf), -1);
323
324 XSETBUFFER (buffer, buf);
325
326 if (!NILP (Fextent_at (make_int (pos), buffer, Qinvisible, Qnil, Qnil)))
327 return Qzero;
328
329 return make_int (bi_spaces_at_point (buf, bufpos_to_bytind (buf, pos)));
330 }
331
332
333 DEFUN ("move-to-column", Fmove_to_column, Smove_to_column, 1, 3, 0 /*
334 Move point to column COLUMN in the current line.
335 The column of a character is calculated by adding together the widths
336 as displayed of the previous characters in the line.
337 This function ignores line-continuation;
338 there is no upper limit on the column number a character can have
339 and horizontal scrolling has no effect.
340
341 If specified column is within a character, point goes after that character.
342 If it's past end of line, point goes to end of line.
343
344 A non-nil second (optional) argument FORCE means, if the line
345 is too short to reach column COLUMN then add spaces/tabs to get there,
346 and if COLUMN is in the middle of a tab character, change it to spaces.
347 Returns the actual column that it moved to.
348 */ )
349 (column, force, buffer)
350 Lisp_Object column, force, buffer;
351 {
352 /* This function can GC */
353 Bufpos pos;
354 struct buffer *buf = decode_buffer (buffer, 0);
355 int col = current_column (buf);
356 int goal;
357 Bufpos end;
358 int tab_width = XINT (buf->tab_width);
359
360 int prev_col = 0;
361 Emchar c = 0;
362
363 XSETBUFFER (buffer, buf);
364 if (tab_width <= 0 || tab_width > 1000) tab_width = 8;
365 CHECK_NATNUM (column);
366 goal = XINT (column);
367
368 retry:
369 pos = BUF_PT (buf);
370 end = BUF_ZV (buf);
371
372 /* If we're starting past the desired column,
373 back up to beginning of line and scan from there. */
374 if (col > goal)
375 {
376 pos = find_next_newline (buf, pos, -1);
377 col = 0;
378 }
379
380 while (col < goal && pos < end)
381 {
382 c = BUF_FETCH_CHAR (buf, pos);
383 if (c == '\n')
384 break;
385 if (c == '\r' && EQ (buf->selective_display, Qt))
386 break;
387 if (c == '\t')
388 {
389 prev_col = col;
390 col += tab_width;
391 col = col / tab_width * tab_width;
392 }
393 else
394 {
395 /* #### oh for the days of the complete new redisplay */
396 /* #### FSFmacs looks at ctl_arrow, display tables.
397 We need to do similar. */
398 #if 0
399 displayed_glyphs = glyphs_from_bufpos (selected_frame (),
400 buf,
401 XWINDOW (Fselected_window (Qnil)),
402 pos, dp, 0, col, 0, 0, 0);
403 col += (displayed_glyphs->columns
404 - (displayed_glyphs->begin_columns
405 + displayed_glyphs->end_columns));
406 #else
407 col++;
408 #endif
409 }
410
411 pos++;
412 }
413
414 BUF_SET_PT (buf, pos);
415
416 /* If a tab char made us overshoot, change it to spaces
417 and scan through it again. */
418 if (!NILP (force) && col > goal && c == '\t' && prev_col < goal)
419 {
420 buffer_delete_range (buf, BUF_PT (buf) - 1, BUF_PT (buf), 0);
421 Findent_to (make_int (col - 1), Qzero, buffer);
422 buffer_insert_emacs_char (buf, ' ');
423 goto retry;
424 }
425
426 /* If line ends prematurely, add space to the end. */
427 if (col < goal && !NILP (force))
428 {
429 col = goal;
430 Findent_to (make_int (col), Qzero, buffer);
431 }
432
433 last_known_column_buffer = buf;
434 last_known_column = col;
435 last_known_column_point = BUF_PT (buf);
436 last_known_column_modified = BUF_MODIFF (buf);
437
438 return (make_int (col));
439 }
440
441 #if 0 /* #### OK boys, this function needs to be present, I think.
442 It was there before the 19.12 redisplay rewrite. */
443
444 xxDEFUN ("compute-motion", Fcompute_motion, Scompute_motion, 7, 7, 0 /*
445 "Scan through the current buffer, calculating screen position.
446 Scan the current buffer forward from offset FROM,
447 assuming it is at position FROMPOS--a cons of the form (HPOS . VPOS)--
448 to position TO or position TOPOS--another cons of the form (HPOS . VPOS)--
449 and return the ending buffer position and screen location.
450
451 There are three additional arguments:
452
453 WIDTH is the number of columns available to display text;
454 this affects handling of continuation lines.
455 This is usually the value returned by `window-width', less one (to allow
456 for the continuation glyph).
457
458 OFFSETS is either nil or a cons cell (HSCROLL . TAB-OFFSET).
459 HSCROLL is the number of columns not being displayed at the left
460 margin; this is usually taken from a window's hscroll member.
461 TAB-OFFSET is the number of columns of the first tab that aren't
462 being displayed, perhaps because the line was continued within it.
463 If OFFSETS is nil, HSCROLL and TAB-OFFSET are assumed to be zero.
464
465 WINDOW is the window to operate on. Currently this is used only to
466 find the display table. It does not matter what buffer WINDOW displays;
467 `compute-motion' always operates on the current buffer.
468
469 The value is a list of five elements:
470 (POS HPOS VPOS PREVHPOS CONTIN)
471 POS is the buffer position where the scan stopped.
472 VPOS is the vertical position where the scan stopped.
473 HPOS is the horizontal position where the scan stopped.
474
475 PREVHPOS is the horizontal position one character back from POS.
476 CONTIN is t if a line was continued after (or within) the previous character.
477
478 For example, to find the buffer position of column COL of line LINE
479 of a certain window, pass the window's starting location as FROM
480 and the window's upper-left coordinates as FROMPOS.
481 Pass the buffer's (point-max) as TO, to limit the scan to the end of the
482 visible section of the buffer, and pass LINE and COL as TOPOS.
483 */ )
484 (from, frompos, to, topos, width, offsets, window)
485 Lisp_Object from, frompos, to, topos;
486 Lisp_Object width, offsets, window;
487 {
488 Lisp_Object bufpos, hpos, vpos, prevhpos, contin;
489 struct position *pos;
490 int hscroll, tab_offset;
491 struct window *w = decode_window (window);
492
493 CHECK_INT_COERCE_MARKER (from);
494 CHECK_CONS (frompos);
495 CHECK_INT (XCAR (frompos));
496 CHECK_INT (XCDR (frompos));
497 CHECK_INT_COERCE_MARKER (to);
498 CHECK_CONS (topos);
499 CHECK_INT (XCAR (topos));
500 CHECK_INT (XCDR (topos));
501 CHECK_INT (width);
502 if (!NILP (offsets))
503 {
504 CHECK_CONS (offsets);
505 CHECK_INT (XCAR (offsets));
506 CHECK_INT (XCDR (offsets));
507 hscroll = XINT (XCAR (offsets));
508 tab_offset = XINT (XCDR (offsets));
509 }
510 else
511 hscroll = tab_offset = 0;
512
513 pos = compute_motion (XINT (from), XINT (XCDR (frompos)),
514 XINT (XCAR (frompos)),
515 XINT (to), XINT (XCDR (topos)),
516 XINT (XCAR (topos)),
517 XINT (width), hscroll, tab_offset, w);
518
519 XSETINT (bufpos, pos->bufpos);
520 XSETINT (hpos, pos->hpos);
521 XSETINT (vpos, pos->vpos);
522 XSETINT (prevhpos, pos->prevhpos);
523
524 return list5 (bufpos,
525 hpos,
526 vpos,
527 prevhpos,
528 pos->contin ? Qt : Qnil);
529
530 }
531
532 #endif /* 0 */
533
534 /*****************************************************************************
535 vmotion
536
537 Given a starting position ORIG, move point VTARGET lines in WINDOW.
538 Returns the new value for point. If the arg ret_vpos is not nil, it is
539 taken to be a pointer to an int and the number of lines actually moved is
540 returned in it.
541 ****************************************************************************/
542 Bufpos
543 vmotion (struct window *w, Bufpos orig, int vtarget, int *ret_vpos)
544 {
545 struct buffer *b = XBUFFER (w->buffer);
546 int elt;
547
548 elt = point_in_line_start_cache (w, orig, (vtarget < 0
549 ? -vtarget
550 : vtarget));
551
552 /* #### This assertion must be true before the if statements are hit
553 but may possibly be wrong after the call to
554 point_in_line_start_cache if orig is outside of the visible
555 region of the buffer. Handle this. */
556 assert (elt >= 0);
557
558 /* Moving downward. */
559 if (vtarget > 0)
560 {
561 int cur_line = Dynarr_length (w->line_start_cache) - 1 - elt;
562 Bufpos ret_pt;
563
564 if (cur_line > vtarget)
565 cur_line = vtarget;
566
567 /* The traditional FSF behavior is to return the end of buffer
568 position if we couldn't move far enough because we hit it. */
569 if (cur_line < vtarget)
570 ret_pt = BUF_ZV (b);
571 else
572 ret_pt = Dynarr_atp (w->line_start_cache, cur_line + elt)->start;
573
574 while (ret_pt > BUF_ZV (b) && cur_line > 0)
575 {
576 cur_line--;
577 ret_pt = Dynarr_atp (w->line_start_cache, cur_line + elt)->start;
578 }
579
580 if (ret_vpos) *ret_vpos = cur_line;
581 return (ret_pt);
582 }
583 else if (vtarget < 0)
584 {
585 if (elt < -vtarget)
586 {
587 if (ret_vpos) *ret_vpos = -elt;
588 /* #### This should be BUF_BEGV (b), right? */
589 return (Dynarr_atp (w->line_start_cache, 0)->start);
590 }
591 else
592 {
593 if (ret_vpos) *ret_vpos = vtarget;
594 return (Dynarr_atp (w->line_start_cache, elt + vtarget)->start);
595 }
596 }
597 else
598 {
599 /* No vertical motion requested so we just return the position
600 of the beginning of the current line. */
601 if (ret_vpos) *ret_vpos = 0;
602
603 return (Dynarr_atp (w->line_start_cache, elt)->start);
604 }
605
606 RETURN_NOT_REACHED(0) /* shut up compiler */
607 }
608
609 DEFUN ("vertical-motion", Fvertical_motion, Svertical_motion, 1, 2, 0 /*
610 Move to start of frame line LINES lines down.
611 If LINES is negative, this is moving up.
612
613 The optional second argument WINDOW specifies the window to use for
614 parameters such as width, horizontal scrolling, and so on.
615 the default is the selected window.
616 Note that `vertical-motion' sets WINDOW's buffer's point, not
617 WINDOW's point. (This differs from FSF Emacs, which buggily always
618 sets current buffer's point, regardless of WINDOW.)
619
620 Sets point to position found; this may be start of line
621 or just the start of a continuation line.
622 Returns number of lines moved; may be closer to zero than LINES
623 if beginning or end of buffer was reached.
624 Optional second argument is WINDOW to move in.
625 */ )
626 (lines, window)
627 Lisp_Object lines, window;
628 {
629 if (NILP (window))
630 window = Fselected_window (Qnil);
631 CHECK_WINDOW (window);
632 {
633 Bufpos bufpos;
634 int vpos;
635 struct window *w = XWINDOW (window);
636
637 CHECK_INT (lines);
638
639 bufpos = vmotion (XWINDOW (window), BUF_PT (XBUFFER (w->buffer)),
640 XINT (lines), &vpos);
641
642 /* Note that the buffer's point is set, not the window's point. */
643 BUF_SET_PT (XBUFFER (w->buffer), bufpos);
644
645 return make_int (vpos);
646 }
647 }
648
649
650 void
651 syms_of_indent (void)
652 {
653 defsubr (&Scurrent_indentation);
654 defsubr (&Sindent_to);
655 defsubr (&Scurrent_column);
656 defsubr (&Smove_to_column);
657 #if 0 /* #### */
658 defsubr (&Scompute_motion);
659 #endif
660 defsubr (&Svertical_motion);
661 }
662
663 void
664 vars_of_indent (void)
665 {
666 DEFVAR_BOOL ("indent-tabs-mode", &indent_tabs_mode /*
667 *Indentation can insert tabs if this is non-nil.
668 Setting this variable automatically makes it local to the current buffer.
669 */ );
670 indent_tabs_mode = 1;
671 }