* alloc.c: Check that resized vectors' lengths fit in fixnums.
[emacs.git] / src / indent.c
blob57a4548ef3c1d5bb2d642716f49af5e96b518a90
1 /* Indentation functions.
2 Copyright (C) 1985-1988, 1993-1995, 1998, 2000-2011
3 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software: you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation, either version 3 of the License, or
10 (at your option) any later version.
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
20 #include <config.h>
21 #include <stdio.h>
22 #include <setjmp.h>
24 #include "lisp.h"
25 #include "buffer.h"
26 #include "character.h"
27 #include "category.h"
28 #include "composite.h"
29 #include "indent.h"
30 #include "keyboard.h"
31 #include "frame.h"
32 #include "window.h"
33 #include "termchar.h"
34 #include "termopts.h"
35 #include "disptab.h"
36 #include "intervals.h"
37 #include "dispextern.h"
38 #include "region-cache.h"
40 #define CR 015
42 /* These three values memorize the current column to avoid recalculation. */
44 /* Last value returned by current_column.
45 Some things in set last_known_column_point to -1
46 to mark the memorized value as invalid. */
48 static EMACS_INT last_known_column;
50 /* Value of point when current_column was called. */
52 EMACS_INT last_known_column_point;
54 /* Value of MODIFF when current_column was called. */
56 static int last_known_column_modified;
58 static EMACS_INT current_column_1 (void);
59 static EMACS_INT position_indentation (int);
61 /* Cache of beginning of line found by the last call of
62 current_column. */
64 static EMACS_INT current_column_bol_cache;
66 /* Get the display table to use for the current buffer. */
68 struct Lisp_Char_Table *
69 buffer_display_table (void)
71 Lisp_Object thisbuf;
73 thisbuf = BVAR (current_buffer, display_table);
74 if (DISP_TABLE_P (thisbuf))
75 return XCHAR_TABLE (thisbuf);
76 if (DISP_TABLE_P (Vstandard_display_table))
77 return XCHAR_TABLE (Vstandard_display_table);
78 return 0;
81 /* Width run cache considerations. */
83 /* Return the width of character C under display table DP. */
85 static int
86 character_width (int c, struct Lisp_Char_Table *dp)
88 Lisp_Object elt;
90 /* These width computations were determined by examining the cases
91 in display_text_line. */
93 /* Everything can be handled by the display table, if it's
94 present and the element is right. */
95 if (dp && (elt = DISP_CHAR_VECTOR (dp, c), VECTORP (elt)))
96 return ASIZE (elt);
98 /* Some characters are special. */
99 if (c == '\n' || c == '\t' || c == '\015')
100 return 0;
102 /* Printing characters have width 1. */
103 else if (c >= 040 && c < 0177)
104 return 1;
106 /* Everybody else (control characters, metacharacters) has other
107 widths. We could return their actual widths here, but they
108 depend on things like ctl_arrow and crud like that, and they're
109 not very common at all. So we'll just claim we don't know their
110 widths. */
111 else
112 return 0;
115 /* Return true if the display table DISPTAB specifies the same widths
116 for characters as WIDTHTAB. We use this to decide when to
117 invalidate the buffer's width_run_cache. */
120 disptab_matches_widthtab (struct Lisp_Char_Table *disptab, struct Lisp_Vector *widthtab)
122 int i;
124 if (widthtab->header.size != 256)
125 abort ();
127 for (i = 0; i < 256; i++)
128 if (character_width (i, disptab)
129 != XFASTINT (widthtab->contents[i]))
130 return 0;
132 return 1;
135 /* Recompute BUF's width table, using the display table DISPTAB. */
137 void
138 recompute_width_table (struct buffer *buf, struct Lisp_Char_Table *disptab)
140 int i;
141 struct Lisp_Vector *widthtab;
143 if (!VECTORP (BVAR (buf, width_table)))
144 BVAR (buf, width_table) = Fmake_vector (make_number (256), make_number (0));
145 widthtab = XVECTOR (BVAR (buf, width_table));
146 if (widthtab->header.size != 256)
147 abort ();
149 for (i = 0; i < 256; i++)
150 XSETFASTINT (widthtab->contents[i], character_width (i, disptab));
153 /* Allocate or free the width run cache, as requested by the current
154 state of current_buffer's cache_long_line_scans variable. */
156 static void
157 width_run_cache_on_off (void)
159 if (NILP (BVAR (current_buffer, cache_long_line_scans))
160 /* And, for the moment, this feature doesn't work on multibyte
161 characters. */
162 || !NILP (BVAR (current_buffer, enable_multibyte_characters)))
164 /* It should be off. */
165 if (current_buffer->width_run_cache)
167 free_region_cache (current_buffer->width_run_cache);
168 current_buffer->width_run_cache = 0;
169 BVAR (current_buffer, width_table) = Qnil;
172 else
174 /* It should be on. */
175 if (current_buffer->width_run_cache == 0)
177 current_buffer->width_run_cache = new_region_cache ();
178 recompute_width_table (current_buffer, buffer_display_table ());
184 /* Skip some invisible characters starting from POS.
185 This includes characters invisible because of text properties
186 and characters invisible because of overlays.
188 If position POS is followed by invisible characters,
189 skip some of them and return the position after them.
190 Otherwise return POS itself.
192 Set *NEXT_BOUNDARY_P to the next position at which
193 it will be necessary to call this function again.
195 Don't scan past TO, and don't set *NEXT_BOUNDARY_P
196 to a value greater than TO.
198 If WINDOW is non-nil, and this buffer is displayed in WINDOW,
199 take account of overlays that apply only in WINDOW.
201 We don't necessarily skip all the invisible characters after POS
202 because that could take a long time. We skip a reasonable number
203 which can be skipped quickly. If there might be more invisible
204 characters immediately following, then *NEXT_BOUNDARY_P
205 will equal the return value. */
207 EMACS_INT
208 skip_invisible (EMACS_INT pos, EMACS_INT *next_boundary_p, EMACS_INT to, Lisp_Object window)
210 Lisp_Object prop, position, overlay_limit, proplimit;
211 Lisp_Object buffer, tmp;
212 EMACS_INT end;
213 int inv_p;
215 XSETFASTINT (position, pos);
216 XSETBUFFER (buffer, current_buffer);
218 /* Give faster response for overlay lookup near POS. */
219 recenter_overlay_lists (current_buffer, pos);
221 /* We must not advance farther than the next overlay change.
222 The overlay change might change the invisible property;
223 or there might be overlay strings to be displayed there. */
224 overlay_limit = Fnext_overlay_change (position);
225 /* As for text properties, this gives a lower bound
226 for where the invisible text property could change. */
227 proplimit = Fnext_property_change (position, buffer, Qt);
228 if (XFASTINT (overlay_limit) < XFASTINT (proplimit))
229 proplimit = overlay_limit;
230 /* PROPLIMIT is now a lower bound for the next change
231 in invisible status. If that is plenty far away,
232 use that lower bound. */
233 if (XFASTINT (proplimit) > pos + 100 || XFASTINT (proplimit) >= to)
234 *next_boundary_p = XFASTINT (proplimit);
235 /* Otherwise, scan for the next `invisible' property change. */
236 else
238 /* Don't scan terribly far. */
239 XSETFASTINT (proplimit, min (pos + 100, to));
240 /* No matter what, don't go past next overlay change. */
241 if (XFASTINT (overlay_limit) < XFASTINT (proplimit))
242 proplimit = overlay_limit;
243 tmp = Fnext_single_property_change (position, Qinvisible,
244 buffer, proplimit);
245 end = XFASTINT (tmp);
246 #if 0
247 /* Don't put the boundary in the middle of multibyte form if
248 there is no actual property change. */
249 if (end == pos + 100
250 && !NILP (current_buffer->enable_multibyte_characters)
251 && end < ZV)
252 while (pos < end && !CHAR_HEAD_P (POS_ADDR (end)))
253 end--;
254 #endif
255 *next_boundary_p = end;
257 /* if the `invisible' property is set, we can skip to
258 the next property change */
259 prop = Fget_char_property (position, Qinvisible,
260 (!NILP (window)
261 && EQ (XWINDOW (window)->buffer, buffer))
262 ? window : buffer);
263 inv_p = TEXT_PROP_MEANS_INVISIBLE (prop);
264 /* When counting columns (window == nil), don't skip over ellipsis text. */
265 if (NILP (window) ? inv_p == 1 : inv_p)
266 return *next_boundary_p;
267 return pos;
270 /* Set variables WIDTH and BYTES for a multibyte sequence starting at P.
272 DP is a display table or NULL.
274 This macro is used in scan_for_column and in
275 compute_motion. */
277 #define MULTIBYTE_BYTES_WIDTH(p, dp, bytes, width) \
278 do { \
279 int ch; \
281 ch = STRING_CHAR_AND_LENGTH (p, bytes); \
282 if (BYTES_BY_CHAR_HEAD (*p) != bytes) \
283 width = bytes * 4; \
284 else \
286 if (dp != 0 && VECTORP (DISP_CHAR_VECTOR (dp, ch))) \
287 width = ASIZE (DISP_CHAR_VECTOR (dp, ch)); \
288 else \
289 width = CHAR_WIDTH (ch); \
291 } while (0)
294 DEFUN ("current-column", Fcurrent_column, Scurrent_column, 0, 0, 0,
295 doc: /* Return the horizontal position of point. Beginning of line is column 0.
296 This is calculated by adding together the widths of all the displayed
297 representations of the character between the start of the previous line
298 and point (eg. control characters will have a width of 2 or 4, tabs
299 will have a variable width).
300 Ignores finite width of frame, which means that this function may return
301 values greater than (frame-width).
302 Whether the line is visible (if `selective-display' is t) has no effect;
303 however, ^M is treated as end of line when `selective-display' is t.
304 Text that has an invisible property is considered as having width 0, unless
305 `buffer-invisibility-spec' specifies that it is replaced by an ellipsis. */)
306 (void)
308 Lisp_Object temp;
309 XSETFASTINT (temp, current_column ());
310 return temp;
313 /* Cancel any recorded value of the horizontal position. */
315 void
316 invalidate_current_column (void)
318 last_known_column_point = 0;
321 EMACS_INT
322 current_column (void)
324 register EMACS_INT col;
325 register unsigned char *ptr, *stop;
326 register int tab_seen;
327 EMACS_INT post_tab;
328 register int c;
329 register EMACS_INT tab_width = XINT (BVAR (current_buffer, tab_width));
330 int ctl_arrow = !NILP (BVAR (current_buffer, ctl_arrow));
331 register struct Lisp_Char_Table *dp = buffer_display_table ();
333 if (PT == last_known_column_point
334 && MODIFF == last_known_column_modified)
335 return last_known_column;
337 /* If the buffer has overlays, text properties,
338 or multibyte characters, use a more general algorithm. */
339 if (BUF_INTERVALS (current_buffer)
340 || current_buffer->overlays_before
341 || current_buffer->overlays_after
342 || Z != Z_BYTE)
343 return current_column_1 ();
345 /* Scan backwards from point to the previous newline,
346 counting width. Tab characters are the only complicated case. */
348 /* Make a pointer for decrementing through the chars before point. */
349 ptr = BYTE_POS_ADDR (PT_BYTE - 1) + 1;
350 /* Make a pointer to where consecutive chars leave off,
351 going backwards from point. */
352 if (PT == BEGV)
353 stop = ptr;
354 else if (PT <= GPT || BEGV > GPT)
355 stop = BEGV_ADDR;
356 else
357 stop = GAP_END_ADDR;
359 if (tab_width <= 0 || tab_width > 1000)
360 tab_width = 8;
362 col = 0, tab_seen = 0, post_tab = 0;
364 while (1)
366 EMACS_INT i, n;
367 Lisp_Object charvec;
369 if (ptr == stop)
371 /* We stopped either for the beginning of the buffer
372 or for the gap. */
373 if (ptr == BEGV_ADDR)
374 break;
376 /* It was the gap. Jump back over it. */
377 stop = BEGV_ADDR;
378 ptr = GPT_ADDR;
380 /* Check whether that brings us to beginning of buffer. */
381 if (BEGV >= GPT)
382 break;
385 c = *--ptr;
387 if (dp && VECTORP (DISP_CHAR_VECTOR (dp, c)))
389 charvec = DISP_CHAR_VECTOR (dp, c);
390 n = ASIZE (charvec);
392 else
394 charvec = Qnil;
395 n = 1;
398 for (i = n - 1; i >= 0; --i)
400 if (VECTORP (charvec))
402 /* This should be handled the same as
403 next_element_from_display_vector does it. */
404 Lisp_Object entry = AREF (charvec, i);
406 if (GLYPH_CODE_P (entry)
407 && GLYPH_CODE_CHAR_VALID_P (entry))
408 c = GLYPH_CODE_CHAR (entry);
409 else
410 c = ' ';
413 if (c >= 040 && c < 0177)
414 col++;
415 else if (c == '\n'
416 || (c == '\r'
417 && EQ (BVAR (current_buffer, selective_display), Qt)))
419 ptr++;
420 goto start_of_line_found;
422 else if (c == '\t')
424 if (tab_seen)
425 col = ((col + tab_width) / tab_width) * tab_width;
427 post_tab += col;
428 col = 0;
429 tab_seen = 1;
431 else if (VECTORP (charvec))
432 /* With a display table entry, C is displayed as is, and
433 not displayed as \NNN or as ^N. If C is a single-byte
434 character, it takes one column. If C is multi-byte in
435 an unibyte buffer, it's translated to unibyte, so it
436 also takes one column. */
437 ++col;
438 else
439 col += (ctl_arrow && c < 0200) ? 2 : 4;
443 start_of_line_found:
445 if (tab_seen)
447 col = ((col + tab_width) / tab_width) * tab_width;
448 col += post_tab;
451 if (ptr == BEGV_ADDR)
452 current_column_bol_cache = BEGV;
453 else
454 current_column_bol_cache = BYTE_TO_CHAR (PTR_BYTE_POS (ptr));
456 last_known_column = col;
457 last_known_column_point = PT;
458 last_known_column_modified = MODIFF;
460 return col;
464 /* Check the presence of a display property and compute its width.
465 If a property was found and its width was found as well, return
466 its width (>= 0) and set the position of the end of the property
467 in ENDPOS.
468 Otherwise just return -1. */
469 static int
470 check_display_width (EMACS_INT pos, EMACS_INT col, EMACS_INT *endpos)
472 Lisp_Object val, overlay;
474 if (CONSP (val = get_char_property_and_overlay
475 (make_number (pos), Qdisplay, Qnil, &overlay))
476 && EQ (Qspace, XCAR (val)))
477 { /* FIXME: Use calc_pixel_width_or_height, as in term.c. */
478 Lisp_Object plist = XCDR (val), prop;
479 int width = -1;
481 if ((prop = Fplist_get (plist, QCwidth), NATNUMP (prop)))
482 width = XINT (prop);
483 else if (FLOATP (prop))
484 width = (int)(XFLOAT_DATA (prop) + 0.5);
485 else if ((prop = Fplist_get (plist, QCalign_to), NATNUMP (prop)))
486 width = XINT (prop) - col;
487 else if (FLOATP (prop))
488 width = (int)(XFLOAT_DATA (prop) + 0.5) - col;
490 if (width >= 0)
492 EMACS_INT start;
493 if (OVERLAYP (overlay))
494 *endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
495 else
496 get_property_and_range (pos, Qdisplay, &val, &start, endpos, Qnil);
497 return width;
500 return -1;
503 /* Scanning from the beginning of the current line, stop at the buffer
504 position ENDPOS or at the column GOALCOL or at the end of line, whichever
505 comes first.
506 Return the resulting buffer position and column in ENDPOS and GOALCOL.
507 PREVCOL gets set to the column of the previous position (it's always
508 strictly smaller than the goal column). */
509 static void
510 scan_for_column (EMACS_INT *endpos, EMACS_INT *goalcol, EMACS_INT *prevcol)
512 register EMACS_INT tab_width = XINT (BVAR (current_buffer, tab_width));
513 register int ctl_arrow = !NILP (BVAR (current_buffer, ctl_arrow));
514 register struct Lisp_Char_Table *dp = buffer_display_table ();
515 int multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters));
516 struct composition_it cmp_it;
517 Lisp_Object window;
518 struct window *w;
520 /* Start the scan at the beginning of this line with column number 0. */
521 register EMACS_INT col = 0, prev_col = 0;
522 EMACS_INT goal = goalcol ? *goalcol : MOST_POSITIVE_FIXNUM;
523 EMACS_INT end = endpos ? *endpos : PT;
524 EMACS_INT scan, scan_byte;
525 EMACS_INT next_boundary;
527 EMACS_INT opoint = PT, opoint_byte = PT_BYTE;
528 scan_newline (PT, PT_BYTE, BEGV, BEGV_BYTE, -1, 1);
529 current_column_bol_cache = PT;
530 scan = PT, scan_byte = PT_BYTE;
531 SET_PT_BOTH (opoint, opoint_byte);
532 next_boundary = scan;
535 window = Fget_buffer_window (Fcurrent_buffer (), Qnil);
536 w = ! NILP (window) ? XWINDOW (window) : NULL;
538 if (tab_width <= 0 || tab_width > 1000) tab_width = 8;
539 memset (&cmp_it, 0, sizeof cmp_it);
540 cmp_it.id = -1;
541 composition_compute_stop_pos (&cmp_it, scan, scan_byte, end, Qnil);
543 /* Scan forward to the target position. */
544 while (scan < end)
546 int c;
548 /* Occasionally we may need to skip invisible text. */
549 while (scan == next_boundary)
551 EMACS_INT old_scan = scan;
552 /* This updates NEXT_BOUNDARY to the next place
553 where we might need to skip more invisible text. */
554 scan = skip_invisible (scan, &next_boundary, end, Qnil);
555 if (scan != old_scan)
556 scan_byte = CHAR_TO_BYTE (scan);
557 if (scan >= end)
558 goto endloop;
561 /* Test reaching the goal column. We do this after skipping
562 invisible characters, so that we put point before the
563 character on which the cursor will appear. */
564 if (col >= goal)
565 break;
566 prev_col = col;
568 { /* Check display property. */
569 EMACS_INT endp;
570 int width = check_display_width (scan, col, &endp);
571 if (width >= 0)
573 col += width;
574 if (endp > scan) /* Avoid infinite loops with 0-width overlays. */
576 scan = endp; scan_byte = charpos_to_bytepos (scan);
577 continue;
582 /* Check composition sequence. */
583 if (cmp_it.id >= 0
584 || (scan == cmp_it.stop_pos
585 && composition_reseat_it (&cmp_it, scan, scan_byte, end,
586 w, NULL, Qnil)))
587 composition_update_it (&cmp_it, scan, scan_byte, Qnil);
588 if (cmp_it.id >= 0)
590 scan += cmp_it.nchars;
591 scan_byte += cmp_it.nbytes;
592 if (scan <= end)
593 col += cmp_it.width;
594 if (cmp_it.to == cmp_it.nglyphs)
596 cmp_it.id = -1;
597 composition_compute_stop_pos (&cmp_it, scan, scan_byte, end,
598 Qnil);
600 else
601 cmp_it.from = cmp_it.to;
602 continue;
605 c = FETCH_BYTE (scan_byte);
607 /* See if there is a display table and it relates
608 to this character. */
610 if (dp != 0
611 && ! (multibyte && LEADING_CODE_P (c))
612 && VECTORP (DISP_CHAR_VECTOR (dp, c)))
614 Lisp_Object charvec;
615 EMACS_INT i, n;
617 /* This character is displayed using a vector of glyphs.
618 Update the column/position based on those glyphs. */
620 charvec = DISP_CHAR_VECTOR (dp, c);
621 n = ASIZE (charvec);
623 for (i = 0; i < n; i++)
625 /* This should be handled the same as
626 next_element_from_display_vector does it. */
627 Lisp_Object entry = AREF (charvec, i);
629 if (GLYPH_CODE_P (entry)
630 && GLYPH_CODE_CHAR_VALID_P (entry))
631 c = GLYPH_CODE_CHAR (entry);
632 else
633 c = ' ';
635 if (c == '\n')
636 goto endloop;
637 if (c == '\r' && EQ (BVAR (current_buffer, selective_display), Qt))
638 goto endloop;
639 if (c == '\t')
641 col += tab_width;
642 col = col / tab_width * tab_width;
644 else
645 ++col;
648 else
650 /* The display table doesn't affect this character;
651 it displays as itself. */
653 if (c == '\n')
654 goto endloop;
655 if (c == '\r' && EQ (BVAR (current_buffer, selective_display), Qt))
656 goto endloop;
657 if (c == '\t')
659 col += tab_width;
660 col = col / tab_width * tab_width;
662 else if (multibyte && LEADING_CODE_P (c))
664 /* Start of multi-byte form. */
665 unsigned char *ptr;
666 int bytes, width;
668 ptr = BYTE_POS_ADDR (scan_byte);
669 MULTIBYTE_BYTES_WIDTH (ptr, dp, bytes, width);
670 /* Subtract one to compensate for the increment
671 that is going to happen below. */
672 scan_byte += bytes - 1;
673 col += width;
675 else if (ctl_arrow && (c < 040 || c == 0177))
676 col += 2;
677 else if (c < 040 || c >= 0177)
678 col += 4;
679 else
680 col++;
682 scan++;
683 scan_byte++;
686 endloop:
688 last_known_column = col;
689 last_known_column_point = PT;
690 last_known_column_modified = MODIFF;
692 if (goalcol)
693 *goalcol = col;
694 if (endpos)
695 *endpos = scan;
696 if (prevcol)
697 *prevcol = prev_col;
700 /* Return the column number of position POS
701 by scanning forward from the beginning of the line.
702 This function handles characters that are invisible
703 due to text properties or overlays. */
705 static EMACS_INT
706 current_column_1 (void)
708 EMACS_INT col = MOST_POSITIVE_FIXNUM;
709 EMACS_INT opoint = PT;
711 scan_for_column (&opoint, &col, NULL);
712 return col;
716 #if 0 /* Not used. */
718 /* Return the width in columns of the part of STRING from BEG to END.
719 If BEG is nil, that stands for the beginning of STRING.
720 If END is nil, that stands for the end of STRING. */
722 static double
723 string_display_width (string, beg, end)
724 Lisp_Object string, beg, end;
726 register int col;
727 register unsigned char *ptr, *stop;
728 register int tab_seen;
729 int post_tab;
730 register int c;
731 register int tab_width = XINT (current_buffer->tab_width);
732 int ctl_arrow = !NILP (current_buffer->ctl_arrow);
733 register struct Lisp_Char_Table *dp = buffer_display_table ();
734 int b, e;
736 if (NILP (end))
737 e = SCHARS (string);
738 else
740 CHECK_NUMBER (end);
741 e = XINT (end);
744 if (NILP (beg))
745 b = 0;
746 else
748 CHECK_NUMBER (beg);
749 b = XINT (beg);
752 /* Make a pointer for decrementing through the chars before point. */
753 ptr = SDATA (string) + e;
754 /* Make a pointer to where consecutive chars leave off,
755 going backwards from point. */
756 stop = SDATA (string) + b;
758 if (tab_width <= 0 || tab_width > 1000) tab_width = 8;
760 col = 0, tab_seen = 0, post_tab = 0;
762 while (1)
764 if (ptr == stop)
765 break;
767 c = *--ptr;
768 if (dp != 0 && VECTORP (DISP_CHAR_VECTOR (dp, c)))
769 col += ASIZE (DISP_CHAR_VECTOR (dp, c));
770 else if (c >= 040 && c < 0177)
771 col++;
772 else if (c == '\n')
773 break;
774 else if (c == '\t')
776 if (tab_seen)
777 col = ((col + tab_width) / tab_width) * tab_width;
779 post_tab += col;
780 col = 0;
781 tab_seen = 1;
783 else
784 col += (ctl_arrow && c < 0200) ? 2 : 4;
787 if (tab_seen)
789 col = ((col + tab_width) / tab_width) * tab_width;
790 col += post_tab;
793 return col;
796 #endif /* 0 */
799 DEFUN ("indent-to", Findent_to, Sindent_to, 1, 2, "NIndent to column: ",
800 doc: /* Indent from point with tabs and spaces until COLUMN is reached.
801 Optional second argument MINIMUM says always do at least MINIMUM spaces
802 even if that goes past COLUMN; by default, MINIMUM is zero.
804 The return value is COLUMN. */)
805 (Lisp_Object column, Lisp_Object minimum)
807 EMACS_INT mincol;
808 register EMACS_INT fromcol;
809 register EMACS_INT tab_width = XINT (BVAR (current_buffer, tab_width));
811 CHECK_NUMBER (column);
812 if (NILP (minimum))
813 XSETFASTINT (minimum, 0);
814 CHECK_NUMBER (minimum);
816 fromcol = current_column ();
817 mincol = fromcol + XINT (minimum);
818 if (mincol < XINT (column)) mincol = XINT (column);
820 if (fromcol == mincol)
821 return make_number (mincol);
823 if (tab_width <= 0 || tab_width > 1000) tab_width = 8;
825 if (indent_tabs_mode)
827 Lisp_Object n;
828 XSETFASTINT (n, mincol / tab_width - fromcol / tab_width);
829 if (XFASTINT (n) != 0)
831 Finsert_char (make_number ('\t'), n, Qt);
833 fromcol = (mincol / tab_width) * tab_width;
837 XSETFASTINT (column, mincol - fromcol);
838 Finsert_char (make_number (' '), column, Qt);
840 last_known_column = mincol;
841 last_known_column_point = PT;
842 last_known_column_modified = MODIFF;
844 XSETINT (column, mincol);
845 return column;
849 DEFUN ("current-indentation", Fcurrent_indentation, Scurrent_indentation,
850 0, 0, 0,
851 doc: /* Return the indentation of the current line.
852 This is the horizontal position of the character
853 following any initial whitespace. */)
854 (void)
856 Lisp_Object val;
857 EMACS_INT opoint = PT, opoint_byte = PT_BYTE;
859 scan_newline (PT, PT_BYTE, BEGV, BEGV_BYTE, -1, 1);
861 XSETFASTINT (val, position_indentation (PT_BYTE));
862 SET_PT_BOTH (opoint, opoint_byte);
863 return val;
866 static EMACS_INT
867 position_indentation (register int pos_byte)
869 register EMACS_INT column = 0;
870 register EMACS_INT tab_width = XINT (BVAR (current_buffer, tab_width));
871 register unsigned char *p;
872 register unsigned char *stop;
873 unsigned char *start;
874 EMACS_INT next_boundary_byte = pos_byte;
875 EMACS_INT ceiling = next_boundary_byte;
877 if (tab_width <= 0 || tab_width > 1000) tab_width = 8;
879 p = BYTE_POS_ADDR (pos_byte);
880 /* STOP records the value of P at which we will need
881 to think about the gap, or about invisible text,
882 or about the end of the buffer. */
883 stop = p;
884 /* START records the starting value of P. */
885 start = p;
886 while (1)
888 while (p == stop)
890 EMACS_INT stop_pos_byte;
892 /* If we have updated P, set POS_BYTE to match.
893 The first time we enter the loop, POS_BYTE is already right. */
894 if (p != start)
895 pos_byte = PTR_BYTE_POS (p);
896 /* Consider the various reasons STOP might have been set here. */
897 if (pos_byte == ZV_BYTE)
898 return column;
899 if (pos_byte == next_boundary_byte)
901 EMACS_INT next_boundary;
902 EMACS_INT pos = BYTE_TO_CHAR (pos_byte);
903 pos = skip_invisible (pos, &next_boundary, ZV, Qnil);
904 pos_byte = CHAR_TO_BYTE (pos);
905 next_boundary_byte = CHAR_TO_BYTE (next_boundary);
907 if (pos_byte >= ceiling)
908 ceiling = BUFFER_CEILING_OF (pos_byte) + 1;
909 /* Compute the next place we need to stop and think,
910 and set STOP accordingly. */
911 stop_pos_byte = min (ceiling, next_boundary_byte);
912 /* The -1 and +1 arrange to point at the first byte of gap
913 (if STOP_POS_BYTE is the position of the gap)
914 rather than at the data after the gap. */
916 stop = BYTE_POS_ADDR (stop_pos_byte - 1) + 1;
917 p = BYTE_POS_ADDR (pos_byte);
919 switch (*p++)
921 case 0240:
922 if (! NILP (BVAR (current_buffer, enable_multibyte_characters)))
923 return column;
924 case ' ':
925 column++;
926 break;
927 case '\t':
928 column += tab_width - column % tab_width;
929 break;
930 default:
931 if (ASCII_BYTE_P (p[-1])
932 || NILP (BVAR (current_buffer, enable_multibyte_characters)))
933 return column;
935 int c;
936 pos_byte = PTR_BYTE_POS (p - 1);
937 c = FETCH_MULTIBYTE_CHAR (pos_byte);
938 if (CHAR_HAS_CATEGORY (c, ' '))
940 column++;
941 INC_POS (pos_byte);
942 p = BYTE_POS_ADDR (pos_byte);
944 else
945 return column;
951 /* Test whether the line beginning at POS is indented beyond COLUMN.
952 Blank lines are treated as if they had the same indentation as the
953 preceding line. */
956 indented_beyond_p (EMACS_INT pos, EMACS_INT pos_byte, EMACS_INT column)
958 EMACS_INT val;
959 EMACS_INT opoint = PT, opoint_byte = PT_BYTE;
961 SET_PT_BOTH (pos, pos_byte);
962 while (PT > BEGV && FETCH_BYTE (PT_BYTE) == '\n')
963 scan_newline (PT - 1, PT_BYTE - 1, BEGV, BEGV_BYTE, -1, 0);
965 val = position_indentation (PT_BYTE);
966 SET_PT_BOTH (opoint, opoint_byte);
967 return val >= column;
970 DEFUN ("move-to-column", Fmove_to_column, Smove_to_column, 1, 2, "p",
971 doc: /* Move point to column COLUMN in the current line.
972 Interactively, COLUMN is the value of prefix numeric argument.
973 The column of a character is calculated by adding together the widths
974 as displayed of the previous characters in the line.
975 This function ignores line-continuation;
976 there is no upper limit on the column number a character can have
977 and horizontal scrolling has no effect.
979 If specified column is within a character, point goes after that character.
980 If it's past end of line, point goes to end of line.
982 Optional second argument FORCE non-nil means if COLUMN is in the
983 middle of a tab character, change it to spaces.
984 In addition, if FORCE is t, and the line is too short to reach
985 COLUMN, add spaces/tabs to get there.
987 The return value is the current column. */)
988 (Lisp_Object column, Lisp_Object force)
990 EMACS_INT pos;
991 EMACS_INT col, prev_col;
992 EMACS_INT goal;
994 CHECK_NATNUM (column);
995 goal = XINT (column);
997 col = goal;
998 pos = ZV;
999 scan_for_column (&pos, &col, &prev_col);
1001 SET_PT (pos);
1003 /* If a tab char made us overshoot, change it to spaces
1004 and scan through it again. */
1005 if (!NILP (force) && col > goal)
1007 int c;
1008 EMACS_INT pos_byte = PT_BYTE;
1010 DEC_POS (pos_byte);
1011 c = FETCH_CHAR (pos_byte);
1012 if (c == '\t' && prev_col < goal)
1014 EMACS_INT goal_pt, goal_pt_byte;
1016 /* Insert spaces in front of the tab to reach GOAL. Do this
1017 first so that a marker at the end of the tab gets
1018 adjusted. */
1019 SET_PT_BOTH (PT - 1, PT_BYTE - 1);
1020 Finsert_char (make_number (' '), make_number (goal - prev_col), Qt);
1022 /* Now delete the tab, and indent to COL. */
1023 del_range (PT, PT + 1);
1024 goal_pt = PT;
1025 goal_pt_byte = PT_BYTE;
1026 Findent_to (make_number (col), Qnil);
1027 SET_PT_BOTH (goal_pt, goal_pt_byte);
1029 /* Set the last_known... vars consistently. */
1030 col = goal;
1034 /* If line ends prematurely, add space to the end. */
1035 if (col < goal && EQ (force, Qt))
1036 Findent_to (make_number (col = goal), Qnil);
1038 last_known_column = col;
1039 last_known_column_point = PT;
1040 last_known_column_modified = MODIFF;
1042 return make_number (col);
1045 /* compute_motion: compute buffer posn given screen posn and vice versa */
1047 static struct position val_compute_motion;
1049 /* Scan the current buffer forward from offset FROM, pretending that
1050 this is at line FROMVPOS, column FROMHPOS, until reaching buffer
1051 offset TO or line TOVPOS, column TOHPOS (whichever comes first),
1052 and return the ending buffer position and screen location. If we
1053 can't hit the requested column exactly (because of a tab or other
1054 multi-column character), overshoot.
1056 DID_MOTION is 1 if FROMHPOS has already accounted for overlay strings
1057 at FROM. This is the case if FROMVPOS and FROMVPOS came from an
1058 earlier call to compute_motion. The other common case is that FROMHPOS
1059 is zero and FROM is a position that "belongs" at column zero, but might
1060 be shifted by overlay strings; in this case DID_MOTION should be 0.
1062 WIDTH is the number of columns available to display text;
1063 compute_motion uses this to handle continuation lines and such.
1064 If WIDTH is -1, use width of window's text area adjusted for
1065 continuation glyph when needed.
1067 HSCROLL is the number of columns not being displayed at the left
1068 margin; this is usually taken from a window's hscroll member.
1069 TAB_OFFSET is the number of columns of the first tab that aren't
1070 being displayed, perhaps because of a continuation line or
1071 something.
1073 compute_motion returns a pointer to a struct position. The bufpos
1074 member gives the buffer position at the end of the scan, and hpos
1075 and vpos give its cartesian location. prevhpos is the column at
1076 which the character before bufpos started, and contin is non-zero
1077 if we reached the current line by continuing the previous.
1079 Note that FROMHPOS and TOHPOS should be expressed in real screen
1080 columns, taking HSCROLL and the truncation glyph at the left margin
1081 into account. That is, beginning-of-line moves you to the hpos
1082 -HSCROLL + (HSCROLL > 0).
1084 For example, to find the buffer position of column COL of line LINE
1085 of a certain window, pass the window's starting location as FROM
1086 and the window's upper-left coordinates as FROMVPOS and FROMHPOS.
1087 Pass the buffer's ZV as TO, to limit the scan to the end of the
1088 visible section of the buffer, and pass LINE and COL as TOVPOS and
1089 TOHPOS.
1091 When displaying in window w, a typical formula for WIDTH is:
1093 window_width - 1
1094 - (has_vertical_scroll_bars
1095 ? WINDOW_CONFIG_SCROLL_BAR_COLS (window)
1096 : (window_width + window_left != frame_cols))
1098 where
1099 window_width is XFASTINT (w->total_cols),
1100 window_left is XFASTINT (w->left_col),
1101 has_vertical_scroll_bars is
1102 WINDOW_HAS_VERTICAL_SCROLL_BAR (window)
1103 and frame_cols = FRAME_COLS (XFRAME (window->frame))
1105 Or you can let window_body_cols do this all for you, and write:
1106 window_body_cols (w) - 1
1108 The `-1' accounts for the continuation-line backslashes; the rest
1109 accounts for window borders if the window is split horizontally, and
1110 the scroll bars if they are turned on. */
1112 struct position *
1113 compute_motion (EMACS_INT from, EMACS_INT fromvpos, EMACS_INT fromhpos, int did_motion, EMACS_INT to, EMACS_INT tovpos, EMACS_INT tohpos, EMACS_INT width, EMACS_INT hscroll, EMACS_INT tab_offset, struct window *win)
1115 register EMACS_INT hpos = fromhpos;
1116 register EMACS_INT vpos = fromvpos;
1118 register EMACS_INT pos;
1119 EMACS_INT pos_byte;
1120 register int c = 0;
1121 register EMACS_INT tab_width = XFASTINT (BVAR (current_buffer, tab_width));
1122 register int ctl_arrow = !NILP (BVAR (current_buffer, ctl_arrow));
1123 register struct Lisp_Char_Table *dp = window_display_table (win);
1124 EMACS_INT selective
1125 = (INTEGERP (BVAR (current_buffer, selective_display))
1126 ? XINT (BVAR (current_buffer, selective_display))
1127 : !NILP (BVAR (current_buffer, selective_display)) ? -1 : 0);
1128 int selective_rlen
1129 = (selective && dp && VECTORP (DISP_INVIS_VECTOR (dp))
1130 ? ASIZE (DISP_INVIS_VECTOR (dp)) : 0);
1131 /* The next location where the `invisible' property changes, or an
1132 overlay starts or ends. */
1133 EMACS_INT next_boundary = from;
1135 /* For computing runs of characters with similar widths.
1136 Invariant: width_run_width is zero, or all the characters
1137 from width_run_start to width_run_end have a fixed width of
1138 width_run_width. */
1139 EMACS_INT width_run_start = from;
1140 EMACS_INT width_run_end = from;
1141 EMACS_INT width_run_width = 0;
1142 Lisp_Object *width_table;
1143 Lisp_Object buffer;
1145 /* The next buffer pos where we should consult the width run cache. */
1146 EMACS_INT next_width_run = from;
1147 Lisp_Object window;
1149 int multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters));
1150 /* If previous char scanned was a wide character,
1151 this is the column where it ended. Otherwise, this is 0. */
1152 EMACS_INT wide_column_end_hpos = 0;
1153 EMACS_INT prev_pos; /* Previous buffer position. */
1154 EMACS_INT prev_pos_byte; /* Previous buffer position. */
1155 EMACS_INT prev_hpos = 0;
1156 EMACS_INT prev_vpos = 0;
1157 EMACS_INT contin_hpos; /* HPOS of last column of continued line. */
1158 EMACS_INT prev_tab_offset; /* Previous tab offset. */
1159 EMACS_INT continuation_glyph_width;
1161 struct composition_it cmp_it;
1163 XSETBUFFER (buffer, current_buffer);
1164 XSETWINDOW (window, win);
1166 width_run_cache_on_off ();
1167 if (dp == buffer_display_table ())
1168 width_table = (VECTORP (BVAR (current_buffer, width_table))
1169 ? XVECTOR (BVAR (current_buffer, width_table))->contents
1170 : 0);
1171 else
1172 /* If the window has its own display table, we can't use the width
1173 run cache, because that's based on the buffer's display table. */
1174 width_table = 0;
1176 if (tab_width <= 0 || tab_width > 1000)
1177 tab_width = 8;
1179 /* Negative width means use all available text columns. */
1180 if (width < 0)
1182 width = window_body_cols (win);
1183 /* We must make room for continuation marks if we don't have fringes. */
1184 #ifdef HAVE_WINDOW_SYSTEM
1185 if (!FRAME_WINDOW_P (XFRAME (win->frame)))
1186 #endif
1187 width -= 1;
1190 continuation_glyph_width = 1;
1191 #ifdef HAVE_WINDOW_SYSTEM
1192 if (FRAME_WINDOW_P (XFRAME (win->frame)))
1193 continuation_glyph_width = 0; /* In the fringe. */
1194 #endif
1196 immediate_quit = 1;
1197 QUIT;
1199 pos = prev_pos = from;
1200 pos_byte = prev_pos_byte = CHAR_TO_BYTE (from);
1201 contin_hpos = 0;
1202 prev_tab_offset = tab_offset;
1203 memset (&cmp_it, 0, sizeof cmp_it);
1204 cmp_it.id = -1;
1205 composition_compute_stop_pos (&cmp_it, pos, pos_byte, to, Qnil);
1207 while (1)
1209 while (pos == next_boundary)
1211 EMACS_INT pos_here = pos;
1212 EMACS_INT newpos;
1214 /* Don't skip invisible if we are already at the margin. */
1215 if (vpos > tovpos || (vpos == tovpos && hpos >= tohpos))
1217 if (contin_hpos && prev_hpos == 0
1218 && hpos > tohpos
1219 && (contin_hpos == width || wide_column_end_hpos > width))
1220 { /* Line breaks because we can't put the character at the
1221 previous line any more. It is not the multi-column
1222 character continued in middle. Go back to previous
1223 buffer position, screen position, and set tab offset
1224 to previous value. It's the beginning of the
1225 line. */
1226 pos = prev_pos;
1227 pos_byte = prev_pos_byte;
1228 hpos = prev_hpos;
1229 vpos = prev_vpos;
1230 tab_offset = prev_tab_offset;
1232 break;
1235 /* If the caller says that the screen position came from an earlier
1236 call to compute_motion, then we've already accounted for the
1237 overlay strings at point. This is only true the first time
1238 through, so clear the flag after testing it. */
1239 if (!did_motion)
1240 /* We need to skip past the overlay strings. Currently those
1241 strings must not contain TAB;
1242 if we want to relax that restriction, something will have
1243 to be changed here. */
1245 unsigned char *ovstr;
1246 EMACS_INT ovlen = overlay_strings (pos, win, &ovstr);
1247 hpos += ((multibyte && ovlen > 0)
1248 ? strwidth ((char *) ovstr, ovlen) : ovlen);
1250 did_motion = 0;
1252 if (pos >= to)
1253 break;
1255 /* Advance POS past invisible characters
1256 (but not necessarily all that there are here),
1257 and store in next_boundary the next position where
1258 we need to call skip_invisible. */
1259 newpos = skip_invisible (pos, &next_boundary, to, window);
1261 if (newpos >= to)
1263 pos = min (to, newpos);
1264 pos_byte = CHAR_TO_BYTE (pos);
1265 goto after_loop;
1268 if (newpos != pos_here)
1270 pos = newpos;
1271 pos_byte = CHAR_TO_BYTE (pos);
1275 /* Handle right margin. */
1276 /* Note on a wide-column character.
1278 Characters are classified into the following three categories
1279 according to the width (columns occupied on screen).
1281 (1) single-column character: ex. `a'
1282 (2) multi-column character: ex. `^A', TAB, `\033'
1283 (3) wide-column character: ex. Japanese character, Chinese character
1284 (In the following example, `W_' stands for them.)
1286 Multi-column characters can be divided around the right margin,
1287 but wide-column characters cannot.
1289 NOTE:
1291 (*) The cursor is placed on the next character after the point.
1293 ----------
1294 abcdefghi\
1295 j ^---- next after the point
1296 ^--- next char. after the point.
1297 ----------
1298 In case of sigle-column character
1300 ----------
1301 abcdefgh\\
1302 033 ^---- next after the point, next char. after the point.
1303 ----------
1304 In case of multi-column character
1306 ----------
1307 abcdefgh\\
1308 W_ ^---- next after the point
1309 ^---- next char. after the point.
1310 ----------
1311 In case of wide-column character
1313 The problem here is continuation at a wide-column character.
1314 In this case, the line may shorter less than WIDTH.
1315 And we find the continuation AFTER it occurs.
1319 if (hpos > width)
1321 int total_width = width + continuation_glyph_width;
1322 int truncate = 0;
1324 if (!NILP (Vtruncate_partial_width_windows)
1325 && (total_width < FRAME_COLS (XFRAME (WINDOW_FRAME (win)))))
1327 if (INTEGERP (Vtruncate_partial_width_windows))
1328 truncate
1329 = total_width < XFASTINT (Vtruncate_partial_width_windows);
1330 else
1331 truncate = 1;
1334 if (hscroll || truncate
1335 || !NILP (BVAR (current_buffer, truncate_lines)))
1337 /* Truncating: skip to newline, unless we are already past
1338 TO (we need to go back below). */
1339 if (pos <= to)
1341 pos = find_before_next_newline (pos, to, 1);
1342 pos_byte = CHAR_TO_BYTE (pos);
1343 hpos = width;
1344 /* If we just skipped next_boundary,
1345 loop around in the main while
1346 and handle it. */
1347 if (pos >= next_boundary)
1348 next_boundary = pos + 1;
1349 prev_hpos = width;
1350 prev_vpos = vpos;
1351 prev_tab_offset = tab_offset;
1354 else
1356 /* Continuing. */
1357 /* Remember the previous value. */
1358 prev_tab_offset = tab_offset;
1360 if (wide_column_end_hpos > width)
1362 hpos -= prev_hpos;
1363 tab_offset += prev_hpos;
1365 else
1367 tab_offset += width;
1368 hpos -= width;
1370 vpos++;
1371 contin_hpos = prev_hpos;
1372 prev_hpos = 0;
1373 prev_vpos = vpos;
1377 /* Stop if past the target buffer position or screen position. */
1378 if (pos > to)
1380 /* Go back to the previous position. */
1381 pos = prev_pos;
1382 pos_byte = prev_pos_byte;
1383 hpos = prev_hpos;
1384 vpos = prev_vpos;
1385 tab_offset = prev_tab_offset;
1387 /* NOTE on contin_hpos, hpos, and prev_hpos.
1389 ----------
1390 abcdefgh\\
1391 W_ ^---- contin_hpos
1392 | ^----- hpos
1393 \---- prev_hpos
1394 ----------
1397 if (contin_hpos && prev_hpos == 0
1398 && contin_hpos < width && !wide_column_end_hpos)
1400 /* Line breaking occurs in the middle of multi-column
1401 character. Go back to previous line. */
1402 hpos = contin_hpos;
1403 vpos = vpos - 1;
1405 break;
1408 if (vpos > tovpos || (vpos == tovpos && hpos >= tohpos))
1410 if (contin_hpos && prev_hpos == 0
1411 && hpos > tohpos
1412 && (contin_hpos == width || wide_column_end_hpos > width))
1413 { /* Line breaks because we can't put the character at the
1414 previous line any more. It is not the multi-column
1415 character continued in middle. Go back to previous
1416 buffer position, screen position, and set tab offset
1417 to previous value. It's the beginning of the
1418 line. */
1419 pos = prev_pos;
1420 pos_byte = prev_pos_byte;
1421 hpos = prev_hpos;
1422 vpos = prev_vpos;
1423 tab_offset = prev_tab_offset;
1425 break;
1427 if (pos == ZV) /* We cannot go beyond ZV. Stop here. */
1428 break;
1430 prev_hpos = hpos;
1431 prev_vpos = vpos;
1432 prev_pos = pos;
1433 prev_pos_byte = pos_byte;
1434 wide_column_end_hpos = 0;
1436 /* Consult the width run cache to see if we can avoid inspecting
1437 the text character-by-character. */
1438 if (current_buffer->width_run_cache && pos >= next_width_run)
1440 EMACS_INT run_end;
1441 int common_width
1442 = region_cache_forward (current_buffer,
1443 current_buffer->width_run_cache,
1444 pos, &run_end);
1446 /* A width of zero means the character's width varies (like
1447 a tab), is meaningless (like a newline), or we just don't
1448 want to skip over it for some other reason. */
1449 if (common_width != 0)
1451 EMACS_INT run_end_hpos;
1453 /* Don't go past the final buffer posn the user
1454 requested. */
1455 if (run_end > to)
1456 run_end = to;
1458 run_end_hpos = hpos + (run_end - pos) * common_width;
1460 /* Don't go past the final horizontal position the user
1461 requested. */
1462 if (vpos == tovpos && run_end_hpos > tohpos)
1464 run_end = pos + (tohpos - hpos) / common_width;
1465 run_end_hpos = hpos + (run_end - pos) * common_width;
1468 /* Don't go past the margin. */
1469 if (run_end_hpos >= width)
1471 run_end = pos + (width - hpos) / common_width;
1472 run_end_hpos = hpos + (run_end - pos) * common_width;
1475 hpos = run_end_hpos;
1476 if (run_end > pos)
1477 prev_hpos = hpos - common_width;
1478 if (pos != run_end)
1480 pos = run_end;
1481 pos_byte = CHAR_TO_BYTE (pos);
1485 next_width_run = run_end + 1;
1488 /* We have to scan the text character-by-character. */
1489 else
1491 EMACS_INT i, n;
1492 Lisp_Object charvec;
1494 /* Check composition sequence. */
1495 if (cmp_it.id >= 0
1496 || (pos == cmp_it.stop_pos
1497 && composition_reseat_it (&cmp_it, pos, pos_byte, to, win,
1498 NULL, Qnil)))
1499 composition_update_it (&cmp_it, pos, pos_byte, Qnil);
1500 if (cmp_it.id >= 0)
1502 pos += cmp_it.nchars;
1503 pos_byte += cmp_it.nbytes;
1504 hpos += cmp_it.width;
1505 if (cmp_it.to == cmp_it.nglyphs)
1507 cmp_it.id = -1;
1508 composition_compute_stop_pos (&cmp_it, pos, pos_byte, to,
1509 Qnil);
1511 else
1512 cmp_it.from = cmp_it.to;
1513 continue;
1516 c = FETCH_BYTE (pos_byte);
1517 pos++, pos_byte++;
1519 /* Perhaps add some info to the width_run_cache. */
1520 if (current_buffer->width_run_cache)
1522 /* Is this character part of the current run? If so, extend
1523 the run. */
1524 if (pos - 1 == width_run_end
1525 && XFASTINT (width_table[c]) == width_run_width)
1526 width_run_end = pos;
1528 /* The previous run is over, since this is a character at a
1529 different position, or a different width. */
1530 else
1532 /* Have we accumulated a run to put in the cache?
1533 (Currently, we only cache runs of width == 1). */
1534 if (width_run_start < width_run_end
1535 && width_run_width == 1)
1536 know_region_cache (current_buffer,
1537 current_buffer->width_run_cache,
1538 width_run_start, width_run_end);
1540 /* Start recording a new width run. */
1541 width_run_width = XFASTINT (width_table[c]);
1542 width_run_start = pos - 1;
1543 width_run_end = pos;
1547 if (dp != 0
1548 && ! (multibyte && LEADING_CODE_P (c))
1549 && VECTORP (DISP_CHAR_VECTOR (dp, c)))
1551 charvec = DISP_CHAR_VECTOR (dp, c);
1552 n = ASIZE (charvec);
1554 else
1556 charvec = Qnil;
1557 n = 1;
1560 for (i = n - 1; i >= 0; --i)
1562 if (VECTORP (charvec))
1564 /* This should be handled the same as
1565 next_element_from_display_vector does it. */
1566 Lisp_Object entry = AREF (charvec, i);
1568 if (GLYPH_CODE_P (entry)
1569 && GLYPH_CODE_CHAR_VALID_P (entry))
1570 c = GLYPH_CODE_CHAR (entry);
1571 else
1572 c = ' ';
1575 if (c >= 040 && c < 0177)
1576 hpos++;
1577 else if (c == '\t')
1579 int tem = ((hpos + tab_offset + hscroll - (hscroll > 0))
1580 % tab_width);
1581 if (tem < 0)
1582 tem += tab_width;
1583 hpos += tab_width - tem;
1585 else if (c == '\n')
1587 if (selective > 0
1588 && indented_beyond_p (pos, pos_byte, selective))
1590 /* If (pos == to), we don't have to take care of
1591 selective display. */
1592 if (pos < to)
1594 /* Skip any number of invisible lines all at once */
1597 pos = find_before_next_newline (pos, to, 1);
1598 if (pos < to)
1599 pos++;
1600 pos_byte = CHAR_TO_BYTE (pos);
1602 while (pos < to
1603 && indented_beyond_p (pos, pos_byte,
1604 selective));
1605 /* Allow for the " ..." that is displayed for them. */
1606 if (selective_rlen)
1608 hpos += selective_rlen;
1609 if (hpos >= width)
1610 hpos = width;
1612 DEC_BOTH (pos, pos_byte);
1613 /* We have skipped the invis text, but not the
1614 newline after. */
1617 else
1619 /* A visible line. */
1620 vpos++;
1621 hpos = 0;
1622 hpos -= hscroll;
1623 /* Count the truncation glyph on column 0 */
1624 if (hscroll > 0)
1625 hpos += continuation_glyph_width;
1626 tab_offset = 0;
1628 contin_hpos = 0;
1630 else if (c == CR && selective < 0)
1632 /* In selective display mode,
1633 everything from a ^M to the end of the line is invisible.
1634 Stop *before* the real newline. */
1635 if (pos < to)
1637 pos = find_before_next_newline (pos, to, 1);
1638 pos_byte = CHAR_TO_BYTE (pos);
1640 /* If we just skipped next_boundary,
1641 loop around in the main while
1642 and handle it. */
1643 if (pos > next_boundary)
1644 next_boundary = pos;
1645 /* Allow for the " ..." that is displayed for them. */
1646 if (selective_rlen)
1648 hpos += selective_rlen;
1649 if (hpos >= width)
1650 hpos = width;
1653 else if (multibyte && LEADING_CODE_P (c))
1655 /* Start of multi-byte form. */
1656 unsigned char *ptr;
1657 int mb_bytes, mb_width;
1659 pos_byte--; /* rewind POS_BYTE */
1660 ptr = BYTE_POS_ADDR (pos_byte);
1661 MULTIBYTE_BYTES_WIDTH (ptr, dp, mb_bytes, mb_width);
1662 pos_byte += mb_bytes;
1663 if (mb_width > 1 && BYTES_BY_CHAR_HEAD (*ptr) == mb_bytes)
1664 wide_column_end_hpos = hpos + mb_width;
1665 hpos += mb_width;
1667 else if (VECTORP (charvec))
1668 ++hpos;
1669 else
1670 hpos += (ctl_arrow && c < 0200) ? 2 : 4;
1675 after_loop:
1677 /* Remember any final width run in the cache. */
1678 if (current_buffer->width_run_cache
1679 && width_run_width == 1
1680 && width_run_start < width_run_end)
1681 know_region_cache (current_buffer, current_buffer->width_run_cache,
1682 width_run_start, width_run_end);
1684 val_compute_motion.bufpos = pos;
1685 val_compute_motion.bytepos = pos_byte;
1686 val_compute_motion.hpos = hpos;
1687 val_compute_motion.vpos = vpos;
1688 if (contin_hpos && prev_hpos == 0)
1689 val_compute_motion.prevhpos = contin_hpos;
1690 else
1691 val_compute_motion.prevhpos = prev_hpos;
1692 /* We alalways handle all of them here; none of them remain to do. */
1693 val_compute_motion.ovstring_chars_done = 0;
1695 /* Nonzero if have just continued a line */
1696 val_compute_motion.contin = (contin_hpos && prev_hpos == 0);
1698 immediate_quit = 0;
1699 return &val_compute_motion;
1703 DEFUN ("compute-motion", Fcompute_motion, Scompute_motion, 7, 7, 0,
1704 doc: /* Scan through the current buffer, calculating screen position.
1705 Scan the current buffer forward from offset FROM,
1706 assuming it is at position FROMPOS--a cons of the form (HPOS . VPOS)--
1707 to position TO or position TOPOS--another cons of the form (HPOS . VPOS)--
1708 and return the ending buffer position and screen location.
1710 If TOPOS is nil, the actual width and height of the window's
1711 text area are used.
1713 There are three additional arguments:
1715 WIDTH is the number of columns available to display text;
1716 this affects handling of continuation lines. A value of nil
1717 corresponds to the actual number of available text columns.
1719 OFFSETS is either nil or a cons cell (HSCROLL . TAB-OFFSET).
1720 HSCROLL is the number of columns not being displayed at the left
1721 margin; this is usually taken from a window's hscroll member.
1722 TAB-OFFSET is the number of columns of the first tab that aren't
1723 being displayed, perhaps because the line was continued within it.
1724 If OFFSETS is nil, HSCROLL and TAB-OFFSET are assumed to be zero.
1726 WINDOW is the window to operate on. It is used to choose the display table;
1727 if it is showing the current buffer, it is used also for
1728 deciding which overlay properties apply.
1729 Note that `compute-motion' always operates on the current buffer.
1731 The value is a list of five elements:
1732 (POS HPOS VPOS PREVHPOS CONTIN)
1733 POS is the buffer position where the scan stopped.
1734 VPOS is the vertical position where the scan stopped.
1735 HPOS is the horizontal position where the scan stopped.
1737 PREVHPOS is the horizontal position one character back from POS.
1738 CONTIN is t if a line was continued after (or within) the previous character.
1740 For example, to find the buffer position of column COL of line LINE
1741 of a certain window, pass the window's starting location as FROM
1742 and the window's upper-left coordinates as FROMPOS.
1743 Pass the buffer's (point-max) as TO, to limit the scan to the end of the
1744 visible section of the buffer, and pass LINE and COL as TOPOS. */)
1745 (Lisp_Object from, Lisp_Object frompos, Lisp_Object to, Lisp_Object topos, Lisp_Object width, Lisp_Object offsets, Lisp_Object window)
1747 struct window *w;
1748 Lisp_Object bufpos, hpos, vpos, prevhpos;
1749 struct position *pos;
1750 int hscroll, tab_offset;
1752 CHECK_NUMBER_COERCE_MARKER (from);
1753 CHECK_CONS (frompos);
1754 CHECK_NUMBER_CAR (frompos);
1755 CHECK_NUMBER_CDR (frompos);
1756 CHECK_NUMBER_COERCE_MARKER (to);
1757 if (!NILP (topos))
1759 CHECK_CONS (topos);
1760 CHECK_NUMBER_CAR (topos);
1761 CHECK_NUMBER_CDR (topos);
1763 if (!NILP (width))
1764 CHECK_NUMBER (width);
1766 if (!NILP (offsets))
1768 CHECK_CONS (offsets);
1769 CHECK_NUMBER_CAR (offsets);
1770 CHECK_NUMBER_CDR (offsets);
1771 hscroll = XINT (XCAR (offsets));
1772 tab_offset = XINT (XCDR (offsets));
1774 else
1775 hscroll = tab_offset = 0;
1777 if (NILP (window))
1778 window = Fselected_window ();
1779 else
1780 CHECK_LIVE_WINDOW (window);
1781 w = XWINDOW (window);
1783 if (XINT (from) < BEGV || XINT (from) > ZV)
1784 args_out_of_range_3 (from, make_number (BEGV), make_number (ZV));
1785 if (XINT (to) < BEGV || XINT (to) > ZV)
1786 args_out_of_range_3 (to, make_number (BEGV), make_number (ZV));
1788 pos = compute_motion (XINT (from), XINT (XCDR (frompos)),
1789 XINT (XCAR (frompos)), 0,
1790 XINT (to),
1791 (NILP (topos)
1792 ? window_internal_height (w)
1793 : XINT (XCDR (topos))),
1794 (NILP (topos)
1795 ? (window_body_cols (w)
1797 #ifdef HAVE_WINDOW_SYSTEM
1798 FRAME_WINDOW_P (XFRAME (w->frame)) ? 0 :
1799 #endif
1801 : XINT (XCAR (topos))),
1802 (NILP (width) ? -1 : XINT (width)),
1803 hscroll, tab_offset,
1804 XWINDOW (window));
1806 XSETFASTINT (bufpos, pos->bufpos);
1807 XSETINT (hpos, pos->hpos);
1808 XSETINT (vpos, pos->vpos);
1809 XSETINT (prevhpos, pos->prevhpos);
1811 return Fcons (bufpos,
1812 Fcons (hpos,
1813 Fcons (vpos,
1814 Fcons (prevhpos,
1815 Fcons (pos->contin ? Qt : Qnil, Qnil)))));
1819 /* Fvertical_motion and vmotion */
1821 static struct position val_vmotion;
1823 struct position *
1824 vmotion (register EMACS_INT from, register EMACS_INT vtarget, struct window *w)
1826 EMACS_INT hscroll = XINT (w->hscroll);
1827 struct position pos;
1828 /* vpos is cumulative vertical position, changed as from is changed */
1829 register int vpos = 0;
1830 EMACS_INT prevline;
1831 register EMACS_INT first;
1832 EMACS_INT from_byte;
1833 EMACS_INT lmargin = hscroll > 0 ? 1 - hscroll : 0;
1834 EMACS_INT selective
1835 = (INTEGERP (BVAR (current_buffer, selective_display))
1836 ? XINT (BVAR (current_buffer, selective_display))
1837 : !NILP (BVAR (current_buffer, selective_display)) ? -1 : 0);
1838 Lisp_Object window;
1839 EMACS_INT start_hpos = 0;
1840 int did_motion;
1841 /* This is the object we use for fetching character properties. */
1842 Lisp_Object text_prop_object;
1844 XSETWINDOW (window, w);
1846 /* If the window contains this buffer, use it for getting text properties.
1847 Otherwise use the current buffer as arg for doing that. */
1848 if (EQ (w->buffer, Fcurrent_buffer ()))
1849 text_prop_object = window;
1850 else
1851 text_prop_object = Fcurrent_buffer ();
1853 if (vpos >= vtarget)
1855 /* To move upward, go a line at a time until
1856 we have gone at least far enough. */
1858 first = 1;
1860 while ((vpos > vtarget || first) && from > BEGV)
1862 Lisp_Object propval;
1864 prevline = find_next_newline_no_quit (from - 1, -1);
1865 while (prevline > BEGV
1866 && ((selective > 0
1867 && indented_beyond_p (prevline,
1868 CHAR_TO_BYTE (prevline),
1869 selective))
1870 /* Watch out for newlines with `invisible' property.
1871 When moving upward, check the newline before. */
1872 || (propval = Fget_char_property (make_number (prevline - 1),
1873 Qinvisible,
1874 text_prop_object),
1875 TEXT_PROP_MEANS_INVISIBLE (propval))))
1876 prevline = find_next_newline_no_quit (prevline - 1, -1);
1877 pos = *compute_motion (prevline, 0,
1878 lmargin + (prevline == BEG ? start_hpos : 0),
1880 from,
1881 /* Don't care for VPOS... */
1882 1 << (BITS_PER_SHORT - 1),
1883 /* ... nor HPOS. */
1884 1 << (BITS_PER_SHORT - 1),
1885 -1, hscroll,
1886 /* This compensates for start_hpos
1887 so that a tab as first character
1888 still occupies 8 columns. */
1889 (prevline == BEG ? -start_hpos : 0),
1891 vpos -= pos.vpos;
1892 first = 0;
1893 from = prevline;
1896 /* If we made exactly the desired vertical distance,
1897 or if we hit beginning of buffer,
1898 return point found */
1899 if (vpos >= vtarget)
1901 val_vmotion.bufpos = from;
1902 val_vmotion.bytepos = CHAR_TO_BYTE (from);
1903 val_vmotion.vpos = vpos;
1904 val_vmotion.hpos = lmargin;
1905 val_vmotion.contin = 0;
1906 val_vmotion.prevhpos = 0;
1907 val_vmotion.ovstring_chars_done = 0;
1908 val_vmotion.tab_offset = 0; /* For accumulating tab offset. */
1909 return &val_vmotion;
1912 /* Otherwise find the correct spot by moving down */
1914 /* Moving downward is simple, but must calculate from beg of line
1915 to determine hpos of starting point */
1916 from_byte = CHAR_TO_BYTE (from);
1917 if (from > BEGV && FETCH_BYTE (from_byte - 1) != '\n')
1919 Lisp_Object propval;
1921 prevline = find_next_newline_no_quit (from, -1);
1922 while (prevline > BEGV
1923 && ((selective > 0
1924 && indented_beyond_p (prevline,
1925 CHAR_TO_BYTE (prevline),
1926 selective))
1927 /* Watch out for newlines with `invisible' property.
1928 When moving downward, check the newline after. */
1929 || (propval = Fget_char_property (make_number (prevline),
1930 Qinvisible,
1931 text_prop_object),
1932 TEXT_PROP_MEANS_INVISIBLE (propval))))
1933 prevline = find_next_newline_no_quit (prevline - 1, -1);
1934 pos = *compute_motion (prevline, 0,
1935 lmargin + (prevline == BEG
1936 ? start_hpos : 0),
1938 from,
1939 /* Don't care for VPOS... */
1940 1 << (BITS_PER_SHORT - 1),
1941 /* ... nor HPOS. */
1942 1 << (BITS_PER_SHORT - 1),
1943 -1, hscroll,
1944 (prevline == BEG ? -start_hpos : 0),
1946 did_motion = 1;
1948 else
1950 pos.hpos = lmargin + (from == BEG ? start_hpos : 0);
1951 pos.vpos = 0;
1952 pos.tab_offset = 0;
1953 did_motion = 0;
1955 return compute_motion (from, vpos, pos.hpos, did_motion,
1956 ZV, vtarget, - (1 << (BITS_PER_SHORT - 1)),
1957 -1, hscroll,
1958 pos.tab_offset - (from == BEG ? start_hpos : 0),
1962 DEFUN ("vertical-motion", Fvertical_motion, Svertical_motion, 1, 2, 0,
1963 doc: /* Move point to start of the screen line LINES lines down.
1964 If LINES is negative, this means moving up.
1966 This function is an ordinary cursor motion function
1967 which calculates the new position based on how text would be displayed.
1968 The new position may be the start of a line,
1969 or just the start of a continuation line.
1970 The function returns number of screen lines moved over;
1971 that usually equals LINES, but may be closer to zero
1972 if beginning or end of buffer was reached.
1974 The optional second argument WINDOW specifies the window to use for
1975 parameters such as width, horizontal scrolling, and so on.
1976 The default is to use the selected window's parameters.
1978 LINES can optionally take the form (COLS . LINES), in which case
1979 the motion will not stop at the start of a screen line but on
1980 its column COLS (if such exists on that line, that is).
1982 `vertical-motion' always uses the current buffer,
1983 regardless of which buffer is displayed in WINDOW.
1984 This is consistent with other cursor motion functions
1985 and makes it possible to use `vertical-motion' in any buffer,
1986 whether or not it is currently displayed in some window. */)
1987 (Lisp_Object lines, Lisp_Object window)
1989 struct it it;
1990 struct text_pos pt;
1991 struct window *w;
1992 Lisp_Object old_buffer;
1993 struct gcpro gcpro1;
1994 Lisp_Object lcols = Qnil;
1995 double cols IF_LINT (= 0);
1997 /* Allow LINES to be of the form (HPOS . VPOS) aka (COLUMNS . LINES). */
1998 if (CONSP (lines) && (NUMBERP (XCAR (lines))))
2000 lcols = XCAR (lines);
2001 cols = INTEGERP (lcols) ? (double) XINT (lcols) : XFLOAT_DATA (lcols);
2002 lines = XCDR (lines);
2005 CHECK_NUMBER (lines);
2006 if (! NILP (window))
2007 CHECK_WINDOW (window);
2008 else
2009 window = selected_window;
2010 w = XWINDOW (window);
2012 old_buffer = Qnil;
2013 GCPRO1 (old_buffer);
2014 if (XBUFFER (w->buffer) != current_buffer)
2016 /* Set the window's buffer temporarily to the current buffer. */
2017 old_buffer = w->buffer;
2018 XSETBUFFER (w->buffer, current_buffer);
2021 if (noninteractive)
2023 struct position pos;
2024 pos = *vmotion (PT, XINT (lines), w);
2025 SET_PT_BOTH (pos.bufpos, pos.bytepos);
2027 else
2029 EMACS_INT it_start;
2030 int first_x, it_overshoot_expected IF_LINT (= 0);
2032 SET_TEXT_POS (pt, PT, PT_BYTE);
2033 start_display (&it, w, pt);
2034 first_x = it.first_visible_x;
2035 it_start = IT_CHARPOS (it);
2037 /* See comments below for why we calculate this. */
2038 if (XINT (lines) > 0)
2040 if (it.cmp_it.id >= 0)
2041 it_overshoot_expected = 1;
2042 else if (it.method == GET_FROM_STRING)
2044 const char *s = SSDATA (it.string);
2045 const char *e = s + SBYTES (it.string);
2046 while (s < e && *s != '\n')
2047 ++s;
2048 it_overshoot_expected = (s == e) ? -1 : 0;
2050 else
2051 it_overshoot_expected = (it.method == GET_FROM_IMAGE
2052 || it.method == GET_FROM_STRETCH);
2055 /* Scan from the start of the line containing PT. If we don't
2056 do this, we start moving with IT->current_x == 0, while PT is
2057 really at some x > 0. */
2058 reseat_at_previous_visible_line_start (&it);
2059 it.current_x = it.hpos = 0;
2060 if (IT_CHARPOS (it) != PT)
2061 /* We used to temporarily disable selective display here; the
2062 comment said this is "so we don't move too far" (2005-01-19
2063 checkin by kfs). But this does nothing useful that I can
2064 tell, and it causes Bug#2694 . -- cyd */
2065 move_it_to (&it, PT, -1, -1, -1, MOVE_TO_POS);
2067 if (XINT (lines) <= 0)
2069 it.vpos = 0;
2070 /* Do this even if LINES is 0, so that we move back to the
2071 beginning of the current line as we ought. */
2072 if (XINT (lines) == 0 || IT_CHARPOS (it) > 0)
2073 move_it_by_lines (&it, XINT (lines));
2075 else
2077 if (IT_CHARPOS (it) > it_start)
2079 /* IT may move too far if truncate-lines is on and PT
2080 lies beyond the right margin. In that case,
2081 backtrack unless the starting point is on an image,
2082 stretch glyph, composition, or Lisp string. */
2083 if (!it_overshoot_expected
2084 /* Also, backtrack if the Lisp string contains no
2085 newline, but there is a newline right after it.
2086 In this case, IT overshoots if there is an
2087 after-string just before the newline. */
2088 || (it_overshoot_expected < 0
2089 && it.method == GET_FROM_BUFFER
2090 && it.c == '\n'))
2091 move_it_by_lines (&it, -1);
2092 it.vpos = 0;
2093 move_it_by_lines (&it, XINT (lines));
2095 else
2097 /* Otherwise, we are at the first row occupied by PT,
2098 which might span multiple screen lines (e.g., if it's
2099 on a multi-line display string). We want to start
2100 from the last line that it occupies. */
2101 if (it_start < ZV)
2103 while (IT_CHARPOS (it) <= it_start)
2105 it.vpos = 0;
2106 move_it_by_lines (&it, 1);
2108 if (XINT (lines) > 1)
2109 move_it_by_lines (&it, XINT (lines) - 1);
2111 else
2113 it.vpos = 0;
2114 move_it_by_lines (&it, XINT (lines));
2119 /* Move to the goal column, if one was specified. */
2120 if (!NILP (lcols))
2122 /* If the window was originally hscrolled, move forward by
2123 the hscrolled amount first. */
2124 if (first_x > 0)
2126 move_it_in_display_line (&it, ZV, first_x, MOVE_TO_X);
2127 it.current_x = 0;
2129 move_it_in_display_line
2130 (&it, ZV,
2131 (int)(cols * FRAME_COLUMN_WIDTH (XFRAME (w->frame)) + 0.5),
2132 MOVE_TO_X);
2135 SET_PT_BOTH (IT_CHARPOS (it), IT_BYTEPOS (it));
2138 if (BUFFERP (old_buffer))
2139 w->buffer = old_buffer;
2141 RETURN_UNGCPRO (make_number (it.vpos));
2146 /* File's initialization. */
2148 void
2149 syms_of_indent (void)
2151 DEFVAR_BOOL ("indent-tabs-mode", indent_tabs_mode,
2152 doc: /* *Indentation can insert tabs if this is non-nil. */);
2153 indent_tabs_mode = 1;
2155 defsubr (&Scurrent_indentation);
2156 defsubr (&Sindent_to);
2157 defsubr (&Scurrent_column);
2158 defsubr (&Smove_to_column);
2159 defsubr (&Svertical_motion);
2160 defsubr (&Scompute_motion);