Mercurial > hg > xemacs-beta

comparison lisp/prim/fill.el @ 159:3bb7ccffb0c0 r20-3b6

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-3b6
author cvs
date Mon, 13 Aug 2007 09:41:43 +0200
parents 1856695b1fa9
children eb5470882647
comparison
equal deleted inserted replaced
158:558dfa75ffb3 159:3bb7ccffb0c0
28 ;; All the commands for filling text. These are documented in the XEmacs 28 ;; All the commands for filling text. These are documented in the XEmacs
29 ;; Reference Manual. 29 ;; Reference Manual.
30 30
31 ;; 97/3/14 Jareth Hein (jhod@po.iijnet.or.jp) added functions for kinsoku (asian text 31 ;; 97/3/14 Jareth Hein (jhod@po.iijnet.or.jp) added functions for kinsoku (asian text
32 ;; line break processing) 32 ;; line break processing)
33 ;; 97/06/11 Steve Baur (steve@altair.xemacs.org) converted broken
34 ;; following-char/preceding-char calls to char-after/char-before.
33 35
34 ;;; Code: 36 ;;; Code:
35 37
36 (defconst fill-individual-varying-indent nil 38 (defconst fill-individual-varying-indent nil
37 "*Controls criterion for a new paragraph in `fill-individual-paragraphs'. 39 "*Controls criterion for a new paragraph in `fill-individual-paragraphs'.
108 (if (featurep 'mule) (kinsoku-process-extend))) 110 (if (featurep 'mule) (kinsoku-process-extend)))
109 111
110 (defun fill-end-of-sentence-p () 112 (defun fill-end-of-sentence-p ()
111 (save-excursion 113 (save-excursion
112 (skip-chars-backward " ]})\"'") 114 (skip-chars-backward " ]})\"'")
113 (memq (preceding-char) '(?. ?? ?!)))) 115 (memq (char-before (point)) '(?. ?? ?!))))
114 116
115 (defun current-fill-column () 117 (defun current-fill-column ()
116 "Return the fill-column to use for this line. 118 "Return the fill-column to use for this line.
117 The fill-column to use for a buffer is stored in the variable `fill-column', 119 The fill-column to use for a buffer is stored in the variable `fill-column',
118 but can be locally modified by the `right-margin' text property, which is 120 but can be locally modified by the `right-margin' text property, which is
162 (+ (match-beginning 0) 164 (+ (match-beginning 0)
163 ;; Determine number of spaces to leave: 165 ;; Determine number of spaces to leave:
164 (save-excursion 166 (save-excursion
165 (skip-chars-backward " ]})\"'") 167 (skip-chars-backward " ]})\"'")
166 (cond ((and sentence-end-double-space 168 (cond ((and sentence-end-double-space
167 (memq (preceding-char) '(?. ?? ?!))) 2) 169 (memq (char-before (point)) '(?. ?? ?!))) 2)
168 ((and colon-double-space 170 ((and colon-double-space
169 (= (preceding-char) ?:)) 2) 171 (eq (char-before (point)) ?:)) 2)
170 ((char-equal (preceding-char) ?\n) 0) 172 ((char-equal (char-before (point)) ?\n) 0)
171 (t 1)))) 173 (t 1))))
172 (match-end 0))) 174 (match-end 0)))
173 ;; Make sure sentences ending at end of line get an extra space. 175 ;; Make sure sentences ending at end of line get an extra space.
174 ;; loses on split abbrevs ("Mr.\nSmith") 176 ;; loses on split abbrevs ("Mr.\nSmith")
175 (goto-char beg) 177 (goto-char beg)
381 (or (eobp) 383 (or (eobp)
382 (looking-at word-across-newline)) 384 (looking-at word-across-newline))
383 (forward-char -1)) 385 (forward-char -1))
384 (prog2 ; check previous char. 386 (prog2 ; check previous char.
385 (forward-char -1) 387 (forward-char -1)
386 (or (eq (following-char) ?\ ) 388 (or (eq (char-after (point)) ?\ )
387 (looking-at word-across-newline)) 389 (looking-at word-across-newline))
388 (forward-char))) 390 (forward-char)))
389 nil 391 nil
390 (insert ?\ )) 392 (insert ?\ ))
391 (delete-char 1) ; delete newline 393 (delete-char 1) ; delete newline
423 ;; further fills will assume it ends a sentence. 425 ;; further fills will assume it ends a sentence.
424 ;; If we now know it does not end a sentence, 426 ;; If we now know it does not end a sentence,
425 ;; avoid putting it at the end of the line. 427 ;; avoid putting it at the end of the line.
426 (if sentence-end-double-space 428 (if sentence-end-double-space
427 (while (and (> (point) (+ linebeg 2)) 429 (while (and (> (point) (+ linebeg 2))
428 (eq (preceding-char) ?\ ) 430 (eq (char-before (point)) ?\ )
429 (not (eq (following-char) ?\ )) 431 (not (eq (char-after (point)) ?\ ))
430 (eq (char-after (- (point) 2)) ?\.)) 432 (eq (char-after (- (point) 2)) ?\.))
431 (forward-char -2) 433 (forward-char -2)
432 ;; 97/3/14 jhod: Kinsoku 434 ;; 97/3/14 jhod: Kinsoku
433 ;(skip-chars-backward "^ \n" linebeg))) 435 ;(skip-chars-backward "^ \n" linebeg)))
434 (fill-move-backward-to-break-point re-break-point linebeg))) 436 (fill-move-backward-to-break-point re-break-point linebeg)))
461 ;(skip-chars-forward "^ \n\t") 463 ;(skip-chars-forward "^ \n\t")
462 (fill-move-forward-to-break-point re-break-point) 464 (fill-move-forward-to-break-point re-break-point)
463 ;; end patch 465 ;; end patch
464 (setq first nil))) 466 (setq first nil)))
465 ;; Normally, move back over the single space between the words. 467 ;; Normally, move back over the single space between the words.
466 (if (eq (preceding-char) ?\ ) 468 (if (eq (char-before (point)) ?\ )
467 (forward-char -1))) 469 (forward-char -1)))
468 ;; If the left margin and fill prefix by themselves 470 ;; If the left margin and fill prefix by themselves
469 ;; pass the fill-column, keep at least one word. 471 ;; pass the fill-column, keep at least one word.
470 ;; This handles the first line of the paragraph. 472 ;; This handles the first line of the paragraph.
471 (if (and (zerop prefixcol) 473 (if (and (zerop prefixcol)
508 ;; (2) | SPC + SPC* + WAN --> SPC + NL + WAN 510 ;; (2) | SPC + SPC* + WAN --> SPC + NL + WAN
509 ;; (3) '.' | SPC + nonSPC --> '.' + SPC + NL + nonSPC 511 ;; (3) '.' | SPC + nonSPC --> '.' + SPC + NL + nonSPC
510 ;; (4) '.' | SPC + SPC --> '.' + NL 512 ;; (4) '.' | SPC + SPC --> '.' + NL
511 ;; (5) | SPC* --> NL 513 ;; (5) | SPC* --> NL
512 (let ((start (point)) ; 92.6.30 by K.Handa 514 (let ((start (point)) ; 92.6.30 by K.Handa
513 (ch (following-char))) 515 (ch (char-after (point))))
514 (if (and (= ch ? ) 516 (if (and (= ch ? )
515 (progn ; not case (0) -- 92.6.30 by K.Handa 517 (progn ; not case (0) -- 92.6.30 by K.Handa
516 (skip-chars-forward " \t") 518 (skip-chars-forward " \t")
517 (not (eobp))) 519 (not (eobp)))
518 (or 520 (or
528 ;; never leave space after the end of sentence 530 ;; never leave space after the end of sentence
529 (not (fill-end-of-sentence-p)))) 531 (not (fill-end-of-sentence-p))))
530 (progn ; case (3) 532 (progn ; case (3)
531 (goto-char (1+ start)) 533 (goto-char (1+ start))
532 (and (not (eobp)) 534 (and (not (eobp))
533 (/= (following-char) ? ) 535 (not (eq (char-after (point)) ? ))
534 (fill-end-of-sentence-p))))) 536 (fill-end-of-sentence-p)))))
535 ;; We should keep one SPACE before NEWLINE. (1),(2),(3) 537 ;; We should keep one SPACE before NEWLINE. (1),(2),(3)
536 (goto-char (1+ start)) 538 (goto-char (1+ start))
537 ;; We should delete all SPACES around break point. (4),(5) 539 ;; We should delete all SPACES around break point. (4),(5)
538 (goto-char start)))) 540 (goto-char start))))
618 ;; purposes rather than using paragraph breaks. 620 ;; purposes rather than using paragraph breaks.
619 (if use-hard-newlines 621 (if use-hard-newlines
620 (progn 622 (progn
621 (while (and (setq end (text-property-any (point) (point-max) 623 (while (and (setq end (text-property-any (point) (point-max)
622 'hard t)) 624 'hard t))
623 (not (= ?\n (char-after end))) 625 (not (eq ?\n (char-after end)))
624 (not (= end (point-max)))) 626 (not (= end (point-max))))
625 (goto-char (1+ end))) 627 (goto-char (1+ end)))
626 (setq end (if end (min (point-max) (1+ end)) (point-max))) 628 (setq end (if end (min (point-max) (1+ end)) (point-max)))
627 (goto-char initial)) 629 (goto-char initial))
628 (forward-paragraph 1) 630 (forward-paragraph 1)