Mercurial > hg > xemacs-beta
diff lisp/prim/fill.el @ 110:fe104dbd9147 r20-1b7
Import from CVS: tag r20-1b7
author | cvs |
---|---|
date | Mon, 13 Aug 2007 09:19:45 +0200 |
parents | 360340f9fd5f |
children | 48d667d6f17f |
line wrap: on
line diff
--- a/lisp/prim/fill.el Mon Aug 13 09:18:41 2007 +0200 +++ b/lisp/prim/fill.el Mon Aug 13 09:19:45 2007 +0200 @@ -28,6 +28,9 @@ ;; All the commands for filling text. These are documented in the XEmacs ;; Reference Manual. +;; 97/3/14 Jareth Hein (jhod@po.iijnet.or.jp) added functions for kinsoku (asian text +;; line break processing) + ;;; Code: (defconst fill-individual-varying-indent nil @@ -77,6 +80,38 @@ "*Function to call to choose a fill prefix for a paragraph. This function is used when `adaptive-fill-regexp' does not match.") +;; Added for kinsoku processing. Use this instead of +;; (skip-chars-backward "^ \t\n") +;; (skip-chars-backward "^ \n" linebeg) +(defun fill-move-backward-to-break-point (regexp &optional lim) + (let ((opoint (point))) + ;; 93.8.23 by kawamoto@ics.es.osaka-u.ac.jp + ;; case of first 'word' being longer than fill-column + (if (not (re-search-backward regexp lim 'move)) + nil + ;; we have skipped backward SPC or WAN (word-across-newline). So move point forward again. + (forward-char) + (if (<= opoint (point)) + (forward-char -1))))) + +;; Added for kinsoku processing. Use instead of +;; (re-search-forward "[ \t]" opoint t) +;; (skip-chars-forward "^ \n") +;; (skip-chars-forward "^ \n") +(defun fill-move-forward-to-break-point (regexp &optional lim) + (let ((opoint (point))) + (if (not (re-search-forward regexp lim 'move)) + nil + (forward-char -1) + (if (<= (point) opoint) + (forward-char)))) + (if (featurep 'mule) (kinsoku-process-extend))) + +(defun fill-end-of-sentence-p () + (save-excursion + (skip-chars-backward " ]})\"'") + (memq (preceding-char) '(?. ?? ?!)))) + (defun current-fill-column () "Return the fill-column to use for this line. The fill-column to use for a buffer is stored in the variable `fill-column', @@ -106,9 +141,10 @@ (defun canonically-space-region (beg end) "Remove extra spaces between words in region. Leave one space between words, two at end of sentences or after colons -(depending on values of `sentence-end-double-space' and `colon-double-space'). - Remove indentation from each line." +\(depending on values of `sentence-end-double-space' and `colon-double-space'). +Remove indentation from each line." (interactive "r") + ;;;### 97/3/14 jhod: Do I have to add anything here for kinsoku? (save-excursion (goto-char beg) ;; XEmacs - (ENE/stig from fa-extras.el): Skip the start of a comment. @@ -149,6 +185,7 @@ ;; XEmacs -- added DONT-SKIP-FIRST. Port of older code changes by Stig. ;; #### probably this junk is broken -- do-auto-fill doesn't actually use ;; it. If so, it should be removed. + (defun fill-context-prefix (from to &optional first-line-regexp dont-skip-first) "Compute a fill prefix from the text between FROM and TO. @@ -172,7 +209,9 @@ (move-to-left-margin) ;; XEmacs change (let ((start (point)) - (eol (save-excursion (end-of-line) (point)))) + ; jhod: no longer used? + ;(eol (save-excursion (end-of-line) (point))) + ) (setq result (if (not (looking-at paragraph-start)) (cond ((and adaptive-fill-regexp (looking-at adaptive-fill-regexp)) @@ -319,8 +358,40 @@ (goto-char from) (skip-chars-forward " \t") ;; Then change all newlines to spaces. - (subst-char-in-region from (point-max) ?\n ?\ ) - (if (and nosqueeze (not (eq justify 'full))) + ;;; 97/3/14 jhod: Kinsoku change + ;; Spacing is not necessary for charcters of no word-separater. + ;; The regexp word-across-newline is used for this check. + (if (not (and (featurep 'mule) + (stringp word-across-newline))) + (subst-char-in-region from (point-max) ?\n ?\ ) + ;; + ;; WAN +NL+WAN --> WAN + WAN + ;; not(WAN)+NL+WAN --> not(WAN) + WAN + ;; WAN +NL+not(WAN) --> WAN + not(WAN) + ;; SPC +NL+not(WAN) --> SPC + not(WAN) + ;; not(WAN)+NL+not(WAN) --> not(WAN) + SPC + not(WAN) + ;; + (goto-char from) + (end-of-line) + (while (not (eobp)) + ;; Insert SPC only when point is between nonWAN. Insert + ;; before deleting to preserve marker if possible. + (if (or (prog2 ; check following char. + (forward-char) ; skip newline + (or (eobp) + (looking-at word-across-newline)) + (forward-char -1)) + (prog2 ; check previous char. + (forward-char -1) + (or (eq (following-char) ?\ ) + (looking-at word-across-newline)) + (forward-char))) + nil + (insert ?\ )) + (delete-char 1) ; delete newline + (end-of-line))) + ;; end patch + (if (and nosqueeze (not (eq justify 'full))) nil (canonically-space-region (or squeeze-after (point)) (point-max)) (goto-char (point-max)) @@ -330,14 +401,20 @@ (goto-char (point-min)) ;; This is the actual filling loop. - (let ((prefixcol 0) linebeg) + (let ((prefixcol 0) linebeg + (re-break-point (if (featurep 'mule) + (concat "[ \n\t]\\|" word-across-newline) + "[ \n\t]"))) (while (not (eobp)) (setq linebeg (point)) (move-to-column (1+ (current-fill-column))) (if (eobp) (or nosqueeze (delete-horizontal-space)) ;; Move back to start of word. - (skip-chars-backward "^ \n" linebeg) + ;; 97/3/14 jhod: Kinsoku + ;(skip-chars-backward "^ \n" linebeg) + (fill-move-backward-to-break-point re-break-point linebeg) + ;; end patch ;; Don't break after a period followed by just one space. ;; Move back to the previous place to break. ;; The reason is that if a period ends up at the end of a line, @@ -350,7 +427,12 @@ (not (eq (following-char) ?\ )) (eq (char-after (- (point) 2)) ?\.)) (forward-char -2) - (skip-chars-backward "^ \n" linebeg))) + ;; 97/3/14 jhod: Kinsoku + ;(skip-chars-backward "^ \n" linebeg))) + (fill-move-backward-to-break-point re-break-point linebeg))) + (if (featurep 'mule) (kinsoku-process)) + ;end patch + ;; If the left margin and fill prefix by themselves ;; pass the fill-column. or if they are zero ;; but we have no room for even one word, @@ -373,7 +455,10 @@ (and (looking-at "\\. ") (not (looking-at "\\. "))))))) (skip-chars-forward " \t") - (skip-chars-forward "^ \n\t") + ;; 94/3/14 jhod: Kinsoku + ;(skip-chars-forward "^ \n\t") + (fill-move-forward-to-break-point re-break-point) + ;; end patch (setq first nil))) ;; Normally, move back over the single space between the words. (forward-char -1)) @@ -401,7 +486,10 @@ (and (looking-at "\\. ") (not (looking-at "\\. "))))))) (skip-chars-forward " \t") - (skip-chars-forward "^ \t\n") + ;; 97/3/14 jhod: Kinsoku + ;(skip-chars-forward "^ \t\n") + (fill-move-forward-to-break-point re-break-point) + ;; end patch (setq first nil)))) ;; Check again to see if we got to the end of the paragraph. (if (save-excursion (skip-chars-forward " \t") (eobp)) @@ -409,6 +497,43 @@ ;; Replace whitespace here with one newline, then indent to left ;; margin. (skip-chars-backward " \t") + ;; 97/3/14 jhod: More kinsoku stuff + (if (featurep 'mule) + ;; WAN means chars which match word-across-newline. + ;; (0) | SPC + SPC* <EOB> --> NL + ;; (1) WAN | SPC + SPC* --> WAN + SPC + NL + ;; (2) | SPC + SPC* + WAN --> SPC + NL + WAN + ;; (3) '.' | SPC + nonSPC --> '.' + SPC + NL + nonSPC + ;; (4) '.' | SPC + SPC --> '.' + NL + ;; (5) | SPC* --> NL + (let ((start (point)) ; 92.6.30 by K.Handa + (ch (following-char))) + (if (and (= ch ? ) + (progn ; not case (0) -- 92.6.30 by K.Handa + (skip-chars-forward " \t") + (not (eobp))) + (or + (progn ; case (1) + (goto-char start) + (forward-char -1) + (looking-at word-across-newline)) + (progn ; case (2) + (goto-char start) + (skip-chars-forward " \t") + (and (not (eobp)) + (looking-at word-across-newline) + ;; never leave space after the end of sentence + (not (fill-end-of-sentence-p)))) + (progn ; case (3) + (goto-char (1+ start)) + (and (not (eobp)) + (/= (following-char) ? ) + (fill-end-of-sentence-p))))) + ;; We should keep one SPACE before NEWLINE. (1),(2),(3) + (goto-char (1+ start)) + ;; We should delete all SPACES around break point. (4),(5) + (goto-char start)))) + ;; end of patch (insert ?\n) ;; Give newline the properties of the space(s) it replaces (set-text-properties (1- (point)) (point) @@ -627,6 +752,16 @@ (if (region-active-p) (region-end) (point)))) (set-justification b e 'center t)) +;; 97/3/14 jhod: This functions are added for Kinsoku support +(defun find-space-insertable-point () + "Search backward for a permissable point for inserting justification spaces" + (if (boundp 'space-insertable) + (if (re-search-backward space-insertable nil t) + (progn (forward-char 1) + t) + nil) + (search-backward " " nil t))) + ;; A line has up to six parts: ;; ;; >>> hello. @@ -754,14 +889,15 @@ ;; Ncols is number of additional spaces needed (if (> ncols 0) (if (and (not eop) - (search-backward " " nil t)) + ;; 97/3/14 jhod: Kinsoku + (find-space-insertable-point)) ;(search-backward " " nil t)) (while (> ncols 0) (let ((nmove (+ 3 (random 3)))) (while (> nmove 0) - (or (search-backward " " nil t) + (or (find-space-insertable-point) ;(search-backward " " nil t) (progn (goto-char (point-max)) - (search-backward " "))) + (find-space-insertable-point))) ;(search-backward " "))) (skip-chars-backward " ") (setq nmove (1- nmove)))) ;; XEmacs change