annotate lisp/prim/fill.el @ 70:131b0175ea99 r20-0b30

Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents 28a7c63c7e1e
children 360340f9fd5f
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1 ;;; fill.el --- fill commands for XEmacs.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2
2
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
3 ;; Copyright (C) 1985, 86, 92, 94, 95, 1996 Free Software Foundation, Inc.
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5 ;; Keywords: wp
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
7 ;; This file is part of XEmacs.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
8
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
9 ;; XEmacs is free software; you can redistribute it and/or modify it
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
10 ;; under the terms of the GNU General Public License as published by
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
11 ;; the Free Software Foundation; either version 2, or (at your option)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
12 ;; any later version.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
13
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
14 ;; XEmacs is distributed in the hope that it will be useful, but
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
15 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
17 ;; General Public License for more details.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
18
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
19 ;; You should have received a copy of the GNU General Public License
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
20 ;; along with XEmacs; see the file COPYING. If not, write to the Free
2
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
21 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
22 ;; 02111-1307, USA.
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
23
2
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
24 ;;; Synched up with: FSF 19.34.
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
25
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
26 ;;; Commentary:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
27
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
28 ;; All the commands for filling text. These are documented in the XEmacs
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
29 ;; Reference Manual.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
30
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
31 ;;; Code:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
32
2
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
33 (defconst fill-individual-varying-indent nil
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
34 "*Controls criterion for a new paragraph in `fill-individual-paragraphs'.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
35 Non-nil means changing indent doesn't end a paragraph.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
36 That mode can handle paragraphs with extra indentation on the first line,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
37 but it requires separator lines between paragraphs.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
38 A value of nil means that any change in indentation starts a new paragraph.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
39
2
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
40 (defconst sentence-end-double-space t
70
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 62
diff changeset
41 "*Non-nil means a single space does not end a sentence.")
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
42
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
43 (defconst colon-double-space nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
44 "*Non-nil means put two spaces after a colon when filling.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
45
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
46 (defvar fill-paragraph-function nil
2
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
47 "Mode-specific function to fill a paragraph, or nil if there is none.
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
48 If the function returns nil, then `fill-paragraph' does its normal work.")
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
49
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
50 (defun set-fill-prefix ()
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
51 "Set the fill prefix to the current line up to point.
2
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
52 Filling expects lines to start with the fill prefix and
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
53 reinserts the fill prefix in each resulting line."
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
54 (interactive)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
55 (setq fill-prefix (buffer-substring
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
56 (save-excursion (move-to-left-margin) (point))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
57 (point)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
58 (if (equal fill-prefix "")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
59 (setq fill-prefix nil))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
60 (if fill-prefix
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
61 (message "fill-prefix: \"%s\"" fill-prefix)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
62 (message "fill-prefix cancelled")))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
63
2
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
64 (defconst adaptive-fill-mode t
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
65 "*Non-nil means determine a paragraph's fill prefix from its text.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
66
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
67 ;; #### - this is still weak. Yeah, there's filladapt, but this should
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
68 ;; still be better... --Stig
2
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
69 (defconst adaptive-fill-regexp (purecopy "[ \t]*\\([#;>*]+ +\\)?")
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
70 "*Regexp to match text at start of line that constitutes indentation.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
71 If Adaptive Fill mode is enabled, whatever text matches this pattern
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
72 on the second line of a paragraph is used as the standard indentation
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
73 for the paragraph. If the paragraph has just one line, the indentation
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
74 is taken from that line.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
75
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
76 (defvar adaptive-fill-function nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
77 "*Function to call to choose a fill prefix for a paragraph.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
78 This function is used when `adaptive-fill-regexp' does not match.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
79
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
80 (defun current-fill-column ()
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
81 "Return the fill-column to use for this line.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
82 The fill-column to use for a buffer is stored in the variable `fill-column',
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
83 but can be locally modified by the `right-margin' text property, which is
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
84 subtracted from `fill-column'.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
85
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
86 The fill column to use for a line is the first column at which the column
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
87 number equals or exceeds the local fill-column - right-margin difference."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
88 (save-excursion
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
89 (if fill-column
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
90 (let* ((here (progn (beginning-of-line) (point)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
91 (here-col 0)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
92 (eol (progn (end-of-line) (point)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
93 margin fill-col change col)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
94 ;; Look separately at each region of line with a different right-margin.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
95 (while (and (setq margin (get-text-property here 'right-margin)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
96 fill-col (- fill-column (or margin 0))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
97 change (text-property-not-all
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
98 here eol 'right-margin margin))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
99 (progn (goto-char (1- change))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
100 (setq col (current-column))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
101 (< col fill-col)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
102 (setq here change
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
103 here-col col))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
104 (max here-col fill-col)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
105
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
106 (defun canonically-space-region (beg end)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
107 "Remove extra spaces between words in region.
2
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
108 Leave one space between words, two at end of sentences or after colons
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
109 (depending on values of `sentence-end-double-space' and `colon-double-space').
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
110 Remove indentation from each line."
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
111 (interactive "r")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
112 (save-excursion
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
113 (goto-char beg)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
114 ;; XEmacs - (ENE/stig from fa-extras.el): Skip the start of a comment.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
115 (and comment-start-skip
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
116 (looking-at comment-start-skip)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
117 (goto-char (match-end 0)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
118 ;; Nuke tabs; they get screwed up in a fill.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
119 ;; This is quick, but loses when a tab follows the end of a sentence.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
120 ;; Actually, it is difficult to tell that from "Mr.\tSmith".
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
121 ;; Blame the typist.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
122 (subst-char-in-region beg end ?\t ?\ )
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
123 (while (and (< (point) end)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
124 (re-search-forward " *" end t))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
125 (delete-region
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
126 (+ (match-beginning 0)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
127 ;; Determine number of spaces to leave:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
128 (save-excursion
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
129 (skip-chars-backward " ]})\"'")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
130 (cond ((and sentence-end-double-space
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
131 (memq (preceding-char) '(?. ?? ?!))) 2)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
132 ((and colon-double-space
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
133 (= (preceding-char) ?:)) 2)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
134 ((char-equal (preceding-char) ?\n) 0)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
135 (t 1))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
136 (match-end 0)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
137 ;; Make sure sentences ending at end of line get an extra space.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
138 ;; loses on split abbrevs ("Mr.\nSmith")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
139 (goto-char beg)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
140 (while (and (< (point) end)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
141 (re-search-forward "[.?!][])}\"']*$" end t))
2
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
142 ;; We insert before markers in case a caller such as
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
143 ;; do-auto-fill has done a save-excursion with point at the end
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
144 ;; of the line and wants it to stay at the end of the line.
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
145 (insert ? ))))
2
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
146 ;; XEmacs: we don't have this function.
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
147 ;; (insert-before-markers-and-inherit ? ))))
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
148
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
149 ;; XEmacs -- added DONT-SKIP-FIRST. Port of older code changes by Stig.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
150 ;; #### probably this junk is broken -- do-auto-fill doesn't actually use
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
151 ;; it. If so, it should be removed.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
152 (defun fill-context-prefix (from to &optional first-line-regexp
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
153 dont-skip-first)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
154 "Compute a fill prefix from the text between FROM and TO.
2
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
155 This uses the variables `adaptive-fill-prefix' and `adaptive-fill-function'.
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
156 If FIRST-LINE-REGEXP is non-nil, then when taking a prefix from the
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
157 first line, insist it must match FIRST-LINE-REGEXP."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
158 (save-excursion
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
159 (goto-char from)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
160 (if (eolp) (forward-line 1))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
161 ;; Move to the second line unless there is just one.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
162 (let ((firstline (point))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
163 ;; Non-nil if we are on the second line.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
164 at-second
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
165 result)
2
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
166 ;; XEmacs change
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
167 (if (not dont-skip-first)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
168 (forward-line 1))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
169 (if (>= (point) to)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
170 (goto-char firstline)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
171 (setq at-second t))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
172 (move-to-left-margin)
2
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
173 ;; XEmacs change
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
174 (let ((start (point))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
175 (eol (save-excursion (end-of-line) (point))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
176 (setq result
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
177 (if (not (looking-at paragraph-start))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
178 (cond ((and adaptive-fill-regexp (looking-at adaptive-fill-regexp))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
179 (buffer-substring-no-properties start (match-end 0)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
180 (adaptive-fill-function (funcall adaptive-fill-function)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
181 (and result
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
182 (or at-second
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
183 (null first-line-regexp)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
184 (string-match first-line-regexp result))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
185 result)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
186
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
187 ;; XEmacs (stig) - this is pulled out of fill-region-as-paragraph so that it
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
188 ;; can also be called from do-auto-fill
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
189 ;; #### But it's not used there. Chuck pulled it out because it broke things.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
190 (defun maybe-adapt-fill-prefix (&optional from to dont-skip-first)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
191 (if (and adaptive-fill-mode
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
192 (or (null fill-prefix) (string= fill-prefix "")))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
193 (setq fill-prefix (fill-context-prefix from to nil dont-skip-first))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
194
2
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
195 (defun fill-region-as-paragraph (from to &optional justify
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
196 nosqueeze squeeze-after)
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
197 "Fill the region as one paragraph.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
198 It removes any paragraph breaks in the region and extra newlines at the end,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
199 indents and fills lines between the margins given by the
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
200 `current-left-margin' and `current-fill-column' functions.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
201 It leaves point at the beginning of the line following the paragraph.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
202
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
203 Normally performs justification according to the `current-justification'
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
204 function, but with a prefix arg, does full justification instead.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
205
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
206 From a program, optional third arg JUSTIFY can specify any type of
70
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 62
diff changeset
207 ustification. Fourth arg NOSQUEEZE non-nil means not to make spaces
2
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
208 between words canonical before filling. Fifth arg SQUEEZE-AFTER, if non-nil,
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
209 means don't canonicalize spaces before that position.
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
210
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
211 If `sentence-end-double-space' is non-nil, then period followed by one
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
212 space does not end a sentence, so don't break a line there."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
213 (interactive
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
214 (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
215 ;; XEmacs addition:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
216 (barf-if-buffer-read-only nil (region-beginning) (region-end))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
217 (list (region-beginning) (region-end)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
218 (if current-prefix-arg 'full))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
219 ;; Arrange for undoing the fill to restore point.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
220 (if (and buffer-undo-list (not (eq buffer-undo-list t)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
221 (setq buffer-undo-list (cons (point) buffer-undo-list)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
222
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
223 ;; Make sure "to" is the endpoint.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
224 (goto-char (min from to))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
225 (setq to (max from to))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
226 ;; Ignore blank lines at beginning of region.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
227 (skip-chars-forward " \t\n")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
228
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
229 (let ((from-plus-indent (point))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
230 (oneleft nil))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
231
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
232 (beginning-of-line)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
233 (setq from (point))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
234
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
235 ;; Delete all but one soft newline at end of region.
2
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
236 ;; And leave TO before that one.
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
237 (goto-char to)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
238 (while (and (> (point) from) (eq ?\n (char-after (1- (point)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
239 (if (and oneleft
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
240 (not (and use-hard-newlines
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
241 (get-text-property (1- (point)) 'hard))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
242 (delete-backward-char 1)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
243 (backward-char 1)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
244 (setq oneleft t)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
245 (setq to (point))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
246
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
247 ;; If there was no newline, and there is text in the paragraph, then
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
248 ;; create a newline.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
249 (if (and (not oneleft) (> to from-plus-indent))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
250 (newline))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
251 (goto-char from-plus-indent))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
252
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
253 (if (not (> to (point)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
254 nil ; There is no paragraph, only whitespace: exit now.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
255
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
256 (or justify (setq justify (current-justification)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
257
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
258 ;; Don't let Adaptive Fill mode alter the fill prefix permanently.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
259 (let ((fill-prefix fill-prefix))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
260 ;; Figure out how this paragraph is indented, if desired.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
261 ;; XEmacs: move some code here to a separate function.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
262 (maybe-adapt-fill-prefix from to t)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
263
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
264 (save-restriction
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
265 (goto-char from)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
266 (beginning-of-line)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
267 (narrow-to-region (point) to)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
268
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
269 (if (not justify) ; filling disabled: just check indentation
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
270 (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
271 (goto-char from)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
272 (while (not (eobp))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
273 (if (and (not (eolp))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
274 (< (current-indentation) (current-left-margin)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
275 (indent-to-left-margin))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
276 (forward-line 1)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
277
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
278 (if use-hard-newlines
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
279 (remove-text-properties from (point-max) '(hard nil)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
280 ;; Make sure first line is indented (at least) to left margin...
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
281 (if (or (memq justify '(right center))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
282 (< (current-indentation) (current-left-margin)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
283 (indent-to-left-margin))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
284 ;; Delete the fill prefix from every line except the first.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
285 ;; The first line may not even have a fill prefix.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
286 (goto-char from)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
287 (let ((fpre (and fill-prefix (not (equal fill-prefix ""))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
288 (concat "[ \t]*"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
289 (regexp-quote fill-prefix)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
290 "[ \t]*"))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
291 (and fpre
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
292 (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
293 (if (>= (+ (current-left-margin) (length fill-prefix))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
294 (current-fill-column))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
295 (error "fill-prefix too long for specified width"))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
296 (goto-char from)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
297 (forward-line 1)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
298 (while (not (eobp))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
299 (if (looking-at fpre)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
300 (delete-region (point) (match-end 0)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
301 (forward-line 1))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
302 (goto-char from)
2
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
303 (if (looking-at fpre)
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
304 (goto-char (match-end 0)))
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
305 (setq from (point)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
306 ;; Remove indentation from lines other than the first.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
307 (beginning-of-line 2)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
308 (indent-region (point) (point-max) 0)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
309 (goto-char from)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
310
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
311 ;; FROM, and point, are now before the text to fill,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
312 ;; but after any fill prefix on the first line.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
313
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
314 ;; Make sure sentences ending at end of line get an extra space.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
315 ;; loses on split abbrevs ("Mr.\nSmith")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
316 (while (re-search-forward "[.?!][])}\"']*$" nil t)
2
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
317 ;; XEmacs change (no insert-and-inherit)
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
318 (or (eobp) (insert ?\ )))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
319 (goto-char from)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
320 (skip-chars-forward " \t")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
321 ;; Then change all newlines to spaces.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
322 (subst-char-in-region from (point-max) ?\n ?\ )
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
323 (if (and nosqueeze (not (eq justify 'full)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
324 nil
2
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
325 (canonically-space-region (or squeeze-after (point)) (point-max))
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
326 (goto-char (point-max))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
327 (delete-horizontal-space)
2
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
328 ;; XEmacs change (no insert-and-inherit)
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
329 (insert " "))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
330 (goto-char (point-min))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
331
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
332 ;; This is the actual filling loop.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
333 (let ((prefixcol 0) linebeg)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
334 (while (not (eobp))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
335 (setq linebeg (point))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
336 (move-to-column (1+ (current-fill-column)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
337 (if (eobp)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
338 (or nosqueeze (delete-horizontal-space))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
339 ;; Move back to start of word.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
340 (skip-chars-backward "^ \n" linebeg)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
341 ;; Don't break after a period followed by just one space.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
342 ;; Move back to the previous place to break.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
343 ;; The reason is that if a period ends up at the end of a line,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
344 ;; further fills will assume it ends a sentence.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
345 ;; If we now know it does not end a sentence,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
346 ;; avoid putting it at the end of the line.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
347 (if sentence-end-double-space
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
348 (while (and (> (point) (+ linebeg 2))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
349 (eq (preceding-char) ?\ )
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
350 (not (eq (following-char) ?\ ))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
351 (eq (char-after (- (point) 2)) ?\.))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
352 (forward-char -2)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
353 (skip-chars-backward "^ \n" linebeg)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
354 ;; If the left margin and fill prefix by themselves
2
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
355 ;; pass the fill-column. or if they are zero
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
356 ;; but we have no room for even one word,
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
357 ;; keep at least one word anyway.
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
358 ;; This handles ALL BUT the first line of the paragraph.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
359 (if (if (zerop prefixcol)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
360 (save-excursion
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
361 (skip-chars-backward " \t" linebeg)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
362 (bolp))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
363 (>= prefixcol (current-column)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
364 ;; Ok, skip at least one word.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
365 ;; Meanwhile, don't stop at a period followed by one space.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
366 (let ((first t))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
367 (move-to-column prefixcol)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
368 (while (and (not (eobp))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
369 (or first
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
370 (and (not (bobp))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
371 sentence-end-double-space
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
372 (save-excursion (forward-char -1)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
373 (and (looking-at "\\. ")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
374 (not (looking-at "\\. ")))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
375 (skip-chars-forward " \t")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
376 (skip-chars-forward "^ \n\t")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
377 (setq first nil)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
378 ;; Normally, move back over the single space between the words.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
379 (forward-char -1))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
380 ;; If the left margin and fill prefix by themselves
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
381 ;; pass the fill-column, keep at least one word.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
382 ;; This handles the first line of the paragraph.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
383 (if (and (zerop prefixcol)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
384 (let ((fill-point (point)) nchars)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
385 (save-excursion
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
386 (move-to-left-margin)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
387 (setq nchars (- fill-point (point)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
388 (or (< nchars 0)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
389 (and fill-prefix
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
390 (< nchars (length fill-prefix))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
391 (string= (buffer-substring (point) fill-point)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
392 (substring fill-prefix 0 nchars)))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
393 ;; Ok, skip at least one word. But
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
394 ;; don't stop at a period followed by just one space.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
395 (let ((first t))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
396 (while (and (not (eobp))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
397 (or first
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
398 (and (not (bobp))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
399 sentence-end-double-space
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
400 (save-excursion (forward-char -1)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
401 (and (looking-at "\\. ")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
402 (not (looking-at "\\. ")))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
403 (skip-chars-forward " \t")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
404 (skip-chars-forward "^ \t\n")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
405 (setq first nil))))
2
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
406 ;; Check again to see if we got to the end of the paragraph.
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
407 (if (save-excursion (skip-chars-forward " \t") (eobp))
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
408 (or nosqueeze (delete-horizontal-space))
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
409 ;; Replace whitespace here with one newline, then indent to left
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
410 ;; margin.
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
411 (skip-chars-backward " \t")
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
412 (insert ?\n)
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
413 ;; Give newline the properties of the space(s) it replaces
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
414 (set-text-properties (1- (point)) (point)
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
415 (text-properties-at (point)))
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
416 (indent-to-left-margin)
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
417 ;; Insert the fill prefix after indentation.
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
418 ;; Set prefixcol so whitespace in the prefix won't get lost.
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
419 (and fill-prefix (not (equal fill-prefix ""))
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
420 (progn
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
421 (insert fill-prefix)
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
422 (setq prefixcol (current-column))))))
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
423 ;; Justify the line just ended, if desired.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
424 (if justify
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
425 (if (eobp)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
426 (justify-current-line justify t t)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
427 (forward-line -1)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
428 (justify-current-line justify nil t)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
429 (forward-line 1))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
430 ;; Leave point after final newline.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
431 (goto-char (point-max)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
432 (forward-char 1))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
433
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
434 (defun fill-paragraph (arg)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
435 "Fill paragraph at or after point. Prefix arg means justify as well.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
436 If `sentence-end-double-space' is non-nil, then period followed by one
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
437 space does not end a sentence, so don't break a line there.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
438
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
439 If `fill-paragraph-function' is non-nil, we call it (passing our
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
440 argument to it), and if it returns non-nil, we simply return its value."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
441 (interactive (list (if current-prefix-arg 'full)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
442 (or (and fill-paragraph-function
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
443 (let ((function fill-paragraph-function)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
444 fill-paragraph-function)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
445 (funcall function arg)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
446 (let ((before (point)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
447 (save-excursion
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
448 (forward-paragraph)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
449 (or (bolp) (newline 1))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
450 (let ((end (point))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
451 (beg (progn (backward-paragraph) (point))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
452 (goto-char before)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
453 (if use-hard-newlines
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
454 ;; Can't use fill-region-as-paragraph, since this paragraph may
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
455 ;; still contain hard newlines. See fill-region.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
456 (fill-region beg end arg)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
457 (fill-region-as-paragraph beg end arg)))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
458
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
459 (defun fill-region (from to &optional justify nosqueeze to-eop)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
460 "Fill each of the paragraphs in the region.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
461 Prefix arg (non-nil third arg, if called from program) means justify as well.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
462
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
463 Noninteractively, fourth arg NOSQUEEZE non-nil means to leave
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
464 whitespace other than line breaks untouched, and fifth arg TO-EOP
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
465 non-nil means to keep filling to the end of the paragraph (or next
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
466 hard newline, if `use-hard-newlines' is on).
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
467
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
468 If `sentence-end-double-space' is non-nil, then period followed by one
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
469 space does not end a sentence, so don't break a line there."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
470 (interactive
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
471 (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
472 ;; XEmacs addition:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
473 (barf-if-buffer-read-only nil (region-beginning) (region-end))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
474 (list (region-beginning) (region-end)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
475 (if current-prefix-arg 'full))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
476 (let (end beg)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
477 (save-restriction
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
478 (goto-char (max from to))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
479 (if to-eop
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
480 (progn (skip-chars-backward "\n")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
481 (forward-paragraph)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
482 (setq end (point))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
483 (goto-char (setq beg (min from to)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
484 (beginning-of-line)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
485 (narrow-to-region (point) end)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
486 (while (not (eobp))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
487 (let ((initial (point))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
488 end)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
489 ;; If using hard newlines, break at every one for filling
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
490 ;; purposes rather than using paragraph breaks.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
491 (if use-hard-newlines
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
492 (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
493 (while (and (setq end (text-property-any (point) (point-max)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
494 'hard t))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
495 (not (= ?\n (char-after end)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
496 (not (= end (point-max))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
497 (goto-char (1+ end)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
498 (setq end (if end (min (point-max) (1+ end)) (point-max)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
499 (goto-char initial))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
500 (forward-paragraph 1)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
501 (setq end (point))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
502 (forward-paragraph -1))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
503 (if (< (point) beg)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
504 (goto-char beg))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
505 (if (>= (point) initial)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
506 (fill-region-as-paragraph (point) end justify nosqueeze)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
507 (goto-char end)))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
508
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
509 ;; XEmacs addition: from Tim Bradshaw <tfb@edinburgh.ac.uk>
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
510 (defun fill-paragraph-or-region (arg)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
511 "Fill the current region, if it's active; otherwise, fill the paragraph.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
512 See `fill-paragraph' and `fill-region' for more information."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
513 (interactive "*P")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
514 (if (region-active-p)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
515 (fill-region (point) (mark) arg)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
516 (fill-paragraph arg)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
517
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
518
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
519 (defconst default-justification 'left
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
520 "*Method of justifying text not otherwise specified.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
521 Possible values are `left', `right', `full', `center', or `none'.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
522 The requested kind of justification is done whenever lines are filled.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
523 The `justification' text-property can locally override this variable.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
524 This variable automatically becomes buffer-local when set in any fashion.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
525 (make-variable-buffer-local 'default-justification)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
526
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
527 (defun current-justification ()
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
528 "How should we justify this line?
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
529 This returns the value of the text-property `justification',
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
530 or the variable `default-justification' if there is no text-property.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
531 However, it returns nil rather than `none' to mean \"don't justify\"."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
532 (let ((j (or (get-text-property
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
533 ;; Make sure we're looking at paragraph body.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
534 (save-excursion (skip-chars-forward " \t")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
535 (if (and (eobp) (not (bobp)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
536 (1- (point)) (point)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
537 'justification)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
538 default-justification)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
539 (if (eq 'none j)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
540 nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
541 j)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
542
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
543 (defun set-justification (begin end value &optional whole-par)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
544 "Set the region's justification style.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
545 The kind of justification to use is prompted for.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
546 If the mark is not active, this command operates on the current paragraph.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
547 If the mark is active, the region is used. However, if the beginning and end
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
548 of the region are not at paragraph breaks, they are moved to the beginning and
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
549 end of the paragraphs they are in.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
550 If `use-hard-newlines' is true, all hard newlines are taken to be paragraph
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
551 breaks.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
552
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
553 When calling from a program, operates just on region between BEGIN and END,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
554 unless optional fourth arg WHOLE-PAR is non-nil. In that case bounds are
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
555 extended to include entire paragraphs as in the interactive command."
2
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
556 ;; XEmacs change (was mark-active)
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
557 (interactive (list (if (region-active-p) (region-beginning) (point))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
558 (if (region-active-p) (region-end) (point))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
559 (let ((s (completing-read
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
560 "Set justification to: "
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
561 '(("left") ("right") ("full")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
562 ("center") ("none"))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
563 nil t)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
564 (if (equal s "") (error ""))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
565 (intern s))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
566 t))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
567 (save-excursion
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
568 (save-restriction
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
569 (if whole-par
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
570 (let ((paragraph-start (if use-hard-newlines "." paragraph-start))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
571 (paragraph-ignore-fill-prefix (if use-hard-newlines t
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
572 paragraph-ignore-fill-prefix)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
573 (goto-char begin)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
574 (while (and (bolp) (not (eobp))) (forward-char 1))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
575 (backward-paragraph)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
576 (setq begin (point))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
577 (goto-char end)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
578 (skip-chars-backward " \t\n" begin)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
579 (forward-paragraph)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
580 (setq end (point))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
581
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
582 (narrow-to-region (point-min) end)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
583 (unjustify-region begin (point-max))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
584 (put-text-property begin (point-max) 'justification value)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
585 (fill-region begin (point-max) nil t))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
586
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
587 (defun set-justification-none (b e)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
588 "Disable automatic filling for paragraphs in the region.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
589 If the mark is not active, this applies to the current paragraph."
2
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
590 ;; XEmacs change (was mark-active)
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
591 (interactive (list (if (region-active-p) (region-beginning) (point))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
592 (if (region-active-p) (region-end) (point))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
593 (set-justification b e 'none t))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
594
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
595 (defun set-justification-left (b e)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
596 "Make paragraphs in the region left-justified.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
597 This is usually the default, but see the variable `default-justification'.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
598 If the mark is not active, this applies to the current paragraph."
2
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
599 ;; XEmacs change (was mark-active)
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
600 (interactive (list (if (region-active-p) (region-beginning) (point))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
601 (if (region-active-p) (region-end) (point))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
602 (set-justification b e 'left t))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
603
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
604 (defun set-justification-right (b e)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
605 "Make paragraphs in the region right-justified:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
606 Flush at the right margin and ragged on the left.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
607 If the mark is not active, this applies to the current paragraph."
2
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
608 ;; XEmacs change (was mark-active)
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
609 (interactive (list (if (region-active-p) (region-beginning) (point))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
610 (if (region-active-p) (region-end) (point))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
611 (set-justification b e 'right t))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
612
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
613 (defun set-justification-full (b e)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
614 "Make paragraphs in the region fully justified:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
615 This makes lines flush on both margins by inserting spaces between words.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
616 If the mark is not active, this applies to the current paragraph."
2
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
617 ;; XEmacs change (was mark-active)
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
618 (interactive (list (if (region-active-p) (region-beginning) (point))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
619 (if (region-active-p) (region-end) (point))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
620 (set-justification b e 'full t))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
621
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
622 (defun set-justification-center (b e)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
623 "Make paragraphs in the region centered.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
624 If the mark is not active, this applies to the current paragraph."
2
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
625 ;; XEmacs change (was mark-active)
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
626 (interactive (list (if (region-active-p) (region-beginning) (point))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
627 (if (region-active-p) (region-end) (point))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
628 (set-justification b e 'center t))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
629
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
630 ;; A line has up to six parts:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
631 ;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
632 ;; >>> hello.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
633 ;; [Indent-1][FP][ Indent-2 ][text][trailing whitespace][newline]
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
634 ;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
635 ;; "Indent-1" is the left-margin indentation; normally it ends at column
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
636 ;; given by the `current-left-margin' function.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
637 ;; "FP" is the fill-prefix. It can be any string, including whitespace.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
638 ;; "Indent-2" is added to justify a line if the `current-justification' is
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
639 ;; `center' or `right'. In `left' and `full' justification regions, any
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
640 ;; whitespace there is part of the line's text, and should not be changed.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
641 ;; Trailing whitespace is not counted as part of the line length when
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
642 ;; center- or right-justifying.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
643 ;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
644 ;; All parts of the line are optional, although the final newline can
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
645 ;; only be missing on the last line of the buffer.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
646
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
647 (defun justify-current-line (&optional how eop nosqueeze)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
648 "Do some kind of justification on this line.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
649 Normally does full justification: adds spaces to the line to make it end at
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
650 the column given by `current-fill-column'.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
651 Optional first argument HOW specifies alternate type of justification:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
652 it can be `left', `right', `full', `center', or `none'.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
653 If HOW is t, will justify however the `current-justification' function says to.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
654 If HOW is nil or missing, full justification is done by default.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
655 Second arg EOP non-nil means that this is the last line of the paragraph, so
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
656 it will not be stretched by full justification.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
657 Third arg NOSQUEEZE non-nil means to leave interior whitespace unchanged,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
658 otherwise it is made canonical."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
659 (interactive)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
660 (if (eq t how) (setq how (or (current-justification) 'none))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
661 (if (null how) (setq how 'full)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
662 (or (memq how '(none left right center))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
663 (setq how 'full))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
664 (or (memq how '(none left)) ; No action required for these.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
665 (let ((fc (current-fill-column))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
666 (pos (point-marker))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
667 fp-end ; point at end of fill prefix
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
668 beg ; point at beginning of line's text
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
669 end ; point at end of line's text
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
670 indent ; column of `beg'
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
671 endcol ; column of `end'
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
672 ncols) ; new indent point or offset
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
673 (end-of-line)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
674 ;; Check if this is the last line of the paragraph.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
675 (if (and use-hard-newlines (null eop)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
676 (get-text-property (point) 'hard))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
677 (setq eop t))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
678 (skip-chars-backward " \t")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
679 ;; Quick exit if it appears to be properly justified already
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
680 ;; or there is no text.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
681 (if (or (bolp)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
682 (and (memq how '(full right))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
683 (= (current-column) fc)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
684 nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
685 (setq end (point))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
686 (beginning-of-line)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
687 (skip-chars-forward " \t")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
688 ;; Skip over fill-prefix.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
689 (if (and fill-prefix
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
690 (not (string-equal fill-prefix ""))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
691 (equal fill-prefix
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
692 (buffer-substring
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
693 (point) (min (point-max) (+ (length fill-prefix)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
694 (point))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
695 (forward-char (length fill-prefix))
70
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 62
diff changeset
696 (if (and adaptive-fill-mode
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
697 (looking-at adaptive-fill-regexp))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
698 (goto-char (match-end 0))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
699 (setq fp-end (point))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
700 (skip-chars-forward " \t")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
701 ;; This is beginning of the line's text.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
702 (setq indent (current-column))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
703 (setq beg (point))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
704 (goto-char end)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
705 (setq endcol (current-column))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
706
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
707 ;; HOW can't be null or left--we would have exited already
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
708 (cond ((eq 'right how)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
709 (setq ncols (- fc endcol))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
710 (if (< ncols 0)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
711 ;; Need to remove some indentation
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
712 (delete-region
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
713 (progn (goto-char fp-end)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
714 (if (< (current-column) (+ indent ncols))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
715 (move-to-column (+ indent ncols) t))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
716 (point))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
717 (progn (move-to-column indent) (point)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
718 ;; Need to add some
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
719 (goto-char beg)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
720 (indent-to (+ indent ncols))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
721 ;; If point was at beginning of text, keep it there.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
722 (if (= beg pos)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
723 (move-marker pos (point)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
724
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
725 ((eq 'center how)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
726 ;; Figure out how much indentation is needed
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
727 (setq ncols (+ (current-left-margin)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
728 (/ (- fc (current-left-margin) ;avail. space
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
729 (- endcol indent)) ;text width
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
730 2)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
731 (if (< ncols indent)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
732 ;; Have too much indentation - remove some
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
733 (delete-region
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
734 (progn (goto-char fp-end)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
735 (if (< (current-column) ncols)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
736 (move-to-column ncols t))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
737 (point))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
738 (progn (move-to-column indent) (point)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
739 ;; Have too little - add some
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
740 (goto-char beg)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
741 (indent-to ncols)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
742 ;; If point was at beginning of text, keep it there.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
743 (if (= beg pos)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
744 (move-marker pos (point)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
745
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
746 ((eq 'full how)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
747 ;; Insert extra spaces between words to justify line
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
748 (save-restriction
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
749 (narrow-to-region beg end)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
750 (or nosqueeze
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
751 (canonically-space-region beg end))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
752 (goto-char (point-max))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
753 (setq ncols (- fc endcol))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
754 ;; Ncols is number of additional spaces needed
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
755 (if (> ncols 0)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
756 (if (and (not eop)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
757 (search-backward " " nil t))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
758 (while (> ncols 0)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
759 (let ((nmove (+ 3 (random 3))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
760 (while (> nmove 0)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
761 (or (search-backward " " nil t)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
762 (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
763 (goto-char (point-max))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
764 (search-backward " ")))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
765 (skip-chars-backward " ")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
766 (setq nmove (1- nmove))))
2
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
767 ;; XEmacs change
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
768 (insert " ")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
769 (skip-chars-backward " ")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
770 (setq ncols (1- ncols)))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
771 (t (error "Unknown justification value"))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
772 (goto-char pos)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
773 (move-marker pos nil)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
774 nil)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
775
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
776 (defun unjustify-current-line ()
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
777 "Remove justification whitespace from current line.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
778 If the line is centered or right-justified, this function removes any
2
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
779 indentation past the left margin. If the line is full-justified, it removes
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
780 extra spaces between words. It does nothing in other justification modes."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
781 (let ((justify (current-justification)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
782 (cond ((eq 'left justify) nil)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
783 ((eq nil justify) nil)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
784 ((eq 'full justify) ; full justify: remove extra spaces
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
785 (beginning-of-line-text)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
786 (canonically-space-region
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
787 (point) (save-excursion (end-of-line) (point))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
788 ((memq justify '(center right))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
789 (save-excursion
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
790 (move-to-left-margin nil t)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
791 ;; Position ourselves after any fill-prefix.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
792 (if (and fill-prefix
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
793 (not (string-equal fill-prefix ""))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
794 (equal fill-prefix
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
795 (buffer-substring
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
796 (point) (min (point-max) (+ (length fill-prefix)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
797 (point))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
798 (forward-char (length fill-prefix)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
799 (delete-region (point) (progn (skip-chars-forward " \t")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
800 (point))))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
801
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
802 (defun unjustify-region (&optional begin end)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
803 "Remove justification whitespace from region.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
804 For centered or right-justified regions, this function removes any indentation
2
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
805 past the left margin from each line. For full-justified lines, it removes
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
806 extra spaces between words. It does nothing in other justification modes.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
807 Arguments BEGIN and END are optional; default is the whole buffer."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
808 (save-excursion
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
809 (save-restriction
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
810 (if end (narrow-to-region (point-min) end))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
811 (goto-char (or begin (point-min)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
812 (while (not (eobp))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
813 (unjustify-current-line)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
814 (forward-line 1)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
815
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
816
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
817 (defun fill-nonuniform-paragraphs (min max &optional justifyp mailp)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
818 "Fill paragraphs within the region, allowing varying indentation within each.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
819 This command divides the region into \"paragraphs\",
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
820 only at paragraph-separator lines, then fills each paragraph
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
821 using as the fill prefix the smallest indentation of any line
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
822 in the paragraph.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
823
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
824 When calling from a program, pass range to fill as first two arguments.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
825
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
826 Optional third and fourth arguments JUSTIFY and MAIL-FLAG:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
827 JUSTIFY to justify paragraphs (prefix arg),
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
828 MAIL-FLAG for a mail message, i. e. don't fill header lines."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
829 (interactive (list (region-beginning) (region-end)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
830 (if current-prefix-arg 'full)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
831 (let ((fill-individual-varying-indent t))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
832 (fill-individual-paragraphs min max justifyp mailp)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
833
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
834 (defun fill-individual-paragraphs (min max &optional justify mailp)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
835 "Fill paragraphs of uniform indentation within the region.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
836 This command divides the region into \"paragraphs\",
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
837 treating every change in indentation level as a paragraph boundary,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
838 then fills each paragraph using its indentation level as the fill prefix.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
839
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
840 When calling from a program, pass range to fill as first two arguments.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
841
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
842 Optional third and fourth arguments JUSTIFY and MAIL-FLAG:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
843 JUSTIFY to justify paragraphs (prefix arg),
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
844 MAIL-FLAG for a mail message, i. e. don't fill header lines."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
845 (interactive (list (region-beginning) (region-end)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
846 (if current-prefix-arg 'full)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
847 (save-restriction
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
848 (save-excursion
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
849 (goto-char min)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
850 (beginning-of-line)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
851 (narrow-to-region (point) max)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
852 (if mailp
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
853 (while (and (not (eobp))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
854 (or (looking-at "[ \t]*[^ \t\n]+:")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
855 (looking-at "[ \t]*$")))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
856 (if (looking-at "[ \t]*[^ \t\n]+:")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
857 (search-forward "\n\n" nil 'move)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
858 (forward-line 1))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
859 (narrow-to-region (point) max)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
860 ;; Loop over paragraphs.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
861 (while (progn (skip-chars-forward " \t\n") (not (eobp)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
862 (move-to-left-margin)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
863 (let ((start (point))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
864 fill-prefix fill-prefix-regexp)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
865 ;; Find end of paragraph, and compute the smallest fill-prefix
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
866 ;; that fits all the lines in this paragraph.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
867 (while (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
868 ;; Update the fill-prefix on the first line
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
869 ;; and whenever the prefix good so far is too long.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
870 (if (not (and fill-prefix
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
871 (looking-at fill-prefix-regexp)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
872 (setq fill-prefix
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
873 (if (and adaptive-fill-mode adaptive-fill-regexp
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
874 (looking-at adaptive-fill-regexp))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
875 (match-string 0)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
876 (buffer-substring
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
877 (point)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
878 (save-excursion (skip-chars-forward " \t")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
879 (point))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
880 fill-prefix-regexp (regexp-quote fill-prefix)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
881 (forward-line 1)
2
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
882 (if (bolp)
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
883 ;; If forward-line went past a newline
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
884 ;; move further to the left margin.
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
885 (move-to-left-margin))
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
886 ;; Now stop the loop if end of paragraph.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
887 (and (not (eobp))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
888 (if fill-individual-varying-indent
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
889 ;; If this line is a separator line, with or
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
890 ;; without prefix, end the paragraph.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
891 (and
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
892 (not (looking-at paragraph-separate))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
893 (save-excursion
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
894 (not (and (looking-at fill-prefix-regexp)
2
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
895 ;; XEmacs change
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
896 (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
897 (forward-char (length fill-prefix))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
898 (looking-at paragraph-separate))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
899 ;; If this line has more or less indent
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
900 ;; than the fill prefix wants, end the paragraph.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
901 (and (looking-at fill-prefix-regexp)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
902 (save-excursion
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
903 (not
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
904 (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
905 (forward-char (length fill-prefix))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
906 (or (looking-at paragraph-separate)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
907 (looking-at paragraph-start))))))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
908 ;; Fill this paragraph, but don't add a newline at the end.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
909 (let ((had-newline (bolp)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
910 (fill-region-as-paragraph start (point) justify)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
911 (or had-newline (delete-char -1))))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
912
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
913 ;;; fill.el ends here