|
0
|
1 ;;!emacs
|
|
|
2 ;;
|
|
|
3 ;; FILE: kfill.el
|
|
|
4 ;; SUMMARY: Fill and justify koutline cells (adapted from Kyle Jones' filladapt).
|
|
|
5 ;; USAGE: GNU Emacs Lisp Library
|
|
|
6 ;; KEYWORDS: outlines, wp
|
|
|
7 ;;
|
|
|
8 ;; AUTHOR: Bob Weiner
|
|
|
9 ;; ORIG-DATE: 23-Jan-94
|
|
24
|
10 ;; LAST-MOD: 15-Jan-97 at 11:54:12 by Bob Weiner
|
|
0
|
11 ;;; ************************************************************************
|
|
|
12 ;;; Public variables
|
|
|
13 ;;; ************************************************************************
|
|
|
14
|
|
|
15 (defvar kfill:function-table
|
|
|
16 (progn
|
|
|
17 (if (featurep 'filladapt)
|
|
|
18 (progn (load "fill") ;; Save basic fill-paragraph function.
|
|
|
19 (load "simple"))) ;; Save basic do-auto-fill function.
|
|
|
20 (list (cons 'fill-paragraph (symbol-function 'fill-paragraph))
|
|
|
21 (cons 'do-auto-fill (symbol-function 'do-auto-fill))))
|
|
|
22 "Table containing the old function definitions that kfill overrides.")
|
|
|
23
|
|
|
24 (defvar kfill:prefix-table
|
|
|
25 '(
|
|
|
26 ;; Lists with hanging indents, e.g.
|
|
|
27 ;; 1. xxxxx or 1) xxxxx etc.
|
|
|
28 ;; xxxxx xxx
|
|
|
29 ;;
|
|
|
30 ;; Be sure pattern does not match to: (last word in parens starts
|
|
|
31 ;; newline)
|
|
|
32 (" *(?\\([0-9][0-9a-z.]*\\|[a-z][0-9a-z.]\\)) +" . kfill:hanging-list)
|
|
|
33 (" *\\([0-9]+[a-z.]+[0-9a-z.]*\\|[0-9]+\\|[a-z]\\)\\([.>] +\\| +\\)"
|
|
|
34 . kfill:hanging-list)
|
|
|
35 ;; Included text in news or mail replies
|
|
|
36 ("[ \t]*\\(>+ *\\)+" . kfill:normal-included-text)
|
|
|
37 ;; Included text generated by SUPERCITE. We can't hope to match all
|
|
|
38 ;; the possible variations, your mileage may vary.
|
|
|
39 ("[ \t]*[A-Za-z0-9][^'`\"< \t\n]*>[ \t]*" . kfill:supercite-included-text)
|
|
|
40 ;; Lisp comments
|
|
|
41 ("[ \t]*\\(;+[ \t]*\\)+" . kfill:lisp-comment)
|
|
|
42 ;; UNIX shell comments
|
|
|
43 ("[ \t]*\\(#+[ \t]*\\)+" . kfill:sh-comment)
|
|
|
44 ;; Postscript comments
|
|
|
45 ("[ \t]*\\(%+[ \t]*\\)+" . kfill:postscript-comment)
|
|
|
46 ;; C++ comments
|
|
|
47 ("[ \t]*//[/ \t]*" . kfill:c++-comment)
|
|
|
48 ("[?!~*+ -]+ " . kfill:hanging-list)
|
|
|
49 ;; This keeps normal paragraphs from interacting unpleasantly with
|
|
|
50 ;; the types given above.
|
|
|
51 ("[^ \t/#%?!~*+-]" . kfill:normal)
|
|
|
52 )
|
|
|
53 "Value is an alist of the form
|
|
|
54
|
|
|
55 ((REGXP . FUNCTION) ...)
|
|
|
56
|
|
|
57 When fill-paragraph or do-auto-fill is called, the REGEXP of each alist
|
|
|
58 element is compared with the beginning of the current line. If a match
|
|
|
59 is found the corresponding FUNCTION is called. FUNCTION is called with
|
|
|
60 one argument, which is non-nil when invoked on the behalf of
|
|
|
61 fill-paragraph, nil for do-auto-fill. It is the job of FUNCTION to set
|
|
|
62 the values of the paragraph-* variables (or set a clipping region, if
|
|
|
63 paragraph-start and paragraph-separate cannot be made discerning enough)
|
|
|
64 so that fill-paragraph and do-auto-fill work correctly in various
|
|
|
65 contexts.")
|
|
|
66
|
|
|
67 ;;; ************************************************************************
|
|
|
68 ;;; Public functions
|
|
|
69 ;;; ************************************************************************
|
|
|
70
|
|
|
71 (defun do-auto-fill ()
|
|
|
72 (save-restriction
|
|
|
73 (if (null fill-prefix)
|
|
|
74 (let ((paragraph-ignore-fill-prefix nil)
|
|
|
75 ;; Need this or Emacs 19 ignores fill-prefix when
|
|
|
76 ;; inside a comment.
|
|
|
77 (comment-multi-line t)
|
|
|
78 fill-prefix)
|
|
|
79 (kfill:adapt nil)
|
|
|
80 (kfill:funcall 'do-auto-fill))
|
|
|
81 (kfill:funcall 'do-auto-fill))))
|
|
|
82
|
|
|
83 (defun fill-paragraph (arg &optional skip-prefix-remove)
|
|
|
84 "Fill paragraph at or after point. Prefix ARG means justify as well."
|
|
|
85 (interactive "*P")
|
|
|
86 ;; Emacs 19 expects a specific symbol here.
|
|
|
87 (if (and arg (not (symbolp arg))) (setq arg 'full))
|
|
|
88 (or skip-prefix-remove (kfill:remove-paragraph-prefix))
|
|
|
89 (save-restriction
|
|
|
90 (catch 'done
|
|
|
91 (if (null fill-prefix)
|
|
|
92 (let ((paragraph-ignore-fill-prefix nil)
|
|
|
93 ;; Need this or Emacs 19 ignores fill-prefix when
|
|
|
94 ;; inside a comment.
|
|
|
95 (comment-multi-line t)
|
|
|
96 (paragraph-start paragraph-start)
|
|
|
97 (paragraph-separate paragraph-separate)
|
|
|
98 fill-prefix)
|
|
|
99 (if (kfill:adapt t)
|
|
|
100 (throw 'done (kfill:funcall 'fill-paragraph arg)))))
|
|
|
101 ;; Kfill:adapt failed or fill-prefix is set, so do a basic
|
|
|
102 ;; paragraph fill as adapted from par-align.el.
|
|
|
103 (kfill:fill-paragraph arg skip-prefix-remove))))
|
|
|
104
|
|
|
105 ;;;
|
|
|
106 ;;; Redefine this function so that it sets 'fill-prefix-prev' also.
|
|
|
107 ;;;
|
|
|
108 (defun set-fill-prefix (&optional turn-off)
|
|
|
109 "Set the fill-prefix to the current line up to point.
|
|
|
110 Also sets fill-prefix-prev to previous value of fill-prefix.
|
|
|
111 Filling expects lines to start with the fill prefix and reinserts the fill
|
|
|
112 prefix in each resulting line."
|
|
|
113 (interactive)
|
|
|
114 (setq fill-prefix-prev fill-prefix
|
|
|
115 fill-prefix (if turn-off
|
|
|
116 nil
|
|
|
117 (buffer-substring
|
|
|
118 (save-excursion (beginning-of-line) (point))
|
|
|
119 (point))))
|
|
|
120 (if (equal fill-prefix-prev "")
|
|
|
121 (setq fill-prefix-prev nil))
|
|
|
122 (if (equal fill-prefix "")
|
|
|
123 (setq fill-prefix nil))
|
|
|
124 (if fill-prefix
|
|
|
125 (message "fill-prefix: \"%s\"" fill-prefix)
|
|
|
126 (message "fill-prefix cancelled")))
|
|
|
127
|
|
|
128 ;;; ************************************************************************
|
|
|
129 ;;; Private functions
|
|
|
130 ;;; ************************************************************************
|
|
|
131
|
|
|
132 (defun kfill:adapt (paragraph)
|
|
|
133 (let ((table kfill:prefix-table)
|
|
|
134 case-fold-search
|
|
|
135 success )
|
|
|
136 (save-excursion
|
|
|
137 (beginning-of-line)
|
|
|
138 (while table
|
|
|
139 (if (not (looking-at (car (car table))))
|
|
|
140 (setq table (cdr table))
|
|
|
141 (funcall (cdr (car table)) paragraph)
|
|
|
142 (setq success t table nil))))
|
|
|
143 success ))
|
|
|
144
|
|
|
145 (defun kfill:c++-comment (paragraph)
|
|
|
146 (setq fill-prefix (buffer-substring (match-beginning 0) (match-end 0)))
|
|
|
147 (if paragraph
|
|
|
148 (setq paragraph-separate "^[^ \t/]")))
|
|
|
149
|
|
|
150 (defun kfill:fill-paragraph (justify-flag &optional leave-prefix)
|
|
|
151 (save-excursion
|
|
|
152 (end-of-line)
|
|
|
153 ;; Backward to para begin
|
|
|
154 (re-search-backward (concat "\\`\\|" paragraph-separate))
|
|
|
155 (forward-line 1)
|
|
|
156 (let ((region-start (point)))
|
|
|
157 (forward-line -1)
|
|
|
158 (let ((from (point)))
|
|
|
159 (forward-paragraph)
|
|
|
160 ;; Forward to real paragraph end
|
|
|
161 (re-search-forward (concat "\\'\\|" paragraph-separate))
|
|
|
162 (or (= (point) (point-max)) (beginning-of-line))
|
|
|
163 (or leave-prefix
|
|
|
164 (kfill:replace-string
|
|
|
165 (or fill-prefix fill-prefix-prev)
|
|
|
166 "" nil region-start (point)))
|
|
|
167 (fill-region-as-paragraph from (point) justify-flag)))))
|
|
|
168
|
|
|
169 (defun kfill:funcall (function &rest args)
|
|
|
170 (apply (cdr (assq function kfill:function-table)) args))
|
|
|
171
|
|
|
172 (defun kfill:hanging-list (paragraph)
|
|
|
173 (let (prefix match beg end)
|
|
|
174 (setq prefix (make-string (- (match-end 0) (match-beginning 0)) ?\ ))
|
|
|
175 (if paragraph
|
|
|
176 (progn
|
|
|
177 (setq match (buffer-substring (match-beginning 0) (match-end 0)))
|
|
|
178 (if (string-match "^ +$" match)
|
|
|
179 (save-excursion
|
|
|
180 (while (and (not (bobp)) (looking-at prefix))
|
|
|
181 (forward-line -1))
|
|
|
182
|
|
|
183 (cond ((kfill:hanging-p)
|
|
|
184 (setq beg (point)))
|
|
|
185 (t (setq beg (progn (forward-line 1) (point))))))
|
|
|
186 (setq beg (point)))
|
|
|
187 (save-excursion
|
|
|
188 (forward-line)
|
|
|
189 (while (and (looking-at prefix)
|
|
|
190 (not (equal (char-after (match-end 0)) ?\ )))
|
|
|
191 (forward-line))
|
|
|
192 (setq end (point)))
|
|
|
193 (narrow-to-region beg end)))
|
|
|
194 (setq fill-prefix prefix)))
|
|
|
195
|
|
|
196 (defun kfill:hanging-p ()
|
|
|
197 "Return non-nil iff point is in front of a hanging list."
|
|
|
198 (eval kfill:hanging-expression))
|
|
|
199
|
|
|
200 (defun kfill:lisp-comment (paragraph)
|
|
|
201 (setq fill-prefix (buffer-substring (match-beginning 0) (match-end 0)))
|
|
|
202 (if paragraph
|
|
|
203 (setq paragraph-separate
|
|
|
204 (concat "^" fill-prefix " *;\\|^"
|
|
|
205 (kfill:negate-string fill-prefix)))))
|
|
|
206
|
|
|
207 (defun kfill:negate-string (string)
|
|
|
208 (let ((len (length string))
|
|
|
209 (i 0) string-list)
|
|
|
210 (setq string-list (cons "\\(" nil))
|
|
|
211 (while (< i len)
|
|
|
212 (setq string-list
|
|
|
213 (cons (if (= i (1- len)) "" "\\|")
|
|
|
214 (cons "]"
|
|
|
215 (cons (substring string i (1+ i))
|
|
|
216 (cons "[^"
|
|
|
217 (cons (regexp-quote (substring string 0 i))
|
|
|
218 string-list)))))
|
|
|
219 i (1+ i)))
|
|
|
220 (setq string-list (cons "\\)" string-list))
|
|
|
221 (apply 'concat (nreverse string-list))))
|
|
|
222
|
|
|
223 (defun kfill:normal (paragraph)
|
|
|
224 (if paragraph
|
|
|
225 (setq paragraph-separate
|
|
|
226 (concat paragraph-separate "\\|^[ \t/#%?!~*+-]"))))
|
|
|
227
|
|
|
228 (defun kfill:normal-included-text (paragraph)
|
|
|
229 (setq fill-prefix (buffer-substring (match-beginning 0) (match-end 0)))
|
|
|
230 (if paragraph
|
|
|
231 (setq paragraph-separate
|
|
|
232 (concat "^" fill-prefix " *>\\|^"
|
|
|
233 (kfill:negate-string fill-prefix)))))
|
|
|
234
|
|
|
235 (defun kfill:postscript-comment (paragraph)
|
|
|
236 (setq fill-prefix (buffer-substring (match-beginning 0) (match-end 0)))
|
|
|
237 (if paragraph
|
|
|
238 (setq paragraph-separate
|
|
|
239 (concat "^" fill-prefix " *%\\|^"
|
|
|
240 (kfill:negate-string fill-prefix)))))
|
|
|
241
|
|
|
242 (defun kfill:remove-paragraph-prefix (&optional indent-str)
|
|
|
243 "Remove fill prefix from current paragraph."
|
|
|
244 (save-excursion
|
|
|
245 (end-of-line)
|
|
|
246 ;; Backward to para begin
|
|
|
247 (re-search-backward (concat "\\`\\|" paragraph-separate))
|
|
|
248 (forward-line 1)
|
|
|
249 (let ((region-start (point)))
|
|
|
250 (forward-line -1)
|
|
|
251 (forward-paragraph)
|
|
|
252 ;; Forward to real paragraph end
|
|
|
253 (re-search-forward (concat "\\'\\|" paragraph-separate))
|
|
|
254 (or (= (point) (point-max)) (beginning-of-line))
|
|
|
255 (kfill:replace-string (or fill-prefix fill-prefix-prev)
|
|
|
256 (if (eq major-mode 'kotl-mode)
|
|
|
257 (or indent-str
|
|
|
258 (make-string (kcell-view:indent) ? ))
|
|
|
259 "")
|
|
|
260 nil region-start (point)))))
|
|
|
261
|
|
|
262 (defun kfill:replace-string (fill-str-prev fill-str &optional suffix start end)
|
|
|
263 "Replace whitespace separated FILL-STR-PREV with FILL-STR.
|
|
|
264 Optional SUFFIX non-nil means replace at ends of lines, default is beginnings.
|
|
|
265 Optional arguments START and END specify the replace region, default is the
|
|
|
266 current region."
|
|
|
267 (if fill-str-prev
|
|
|
268 (progn (if start
|
|
|
269 (let ((s (min start end)))
|
|
|
270 (setq end (max start end)
|
|
|
271 start s))
|
|
|
272 (setq start (region-beginning)
|
|
|
273 end (region-end)))
|
|
|
274 (if (not fill-str) (setq fill-str ""))
|
|
|
275 (save-excursion
|
|
|
276 (save-restriction
|
|
|
277 (narrow-to-region start end)
|
|
|
278 (goto-char (point-min))
|
|
|
279 (let ((prefix
|
|
|
280 (concat
|
|
|
281 (if suffix nil "^")
|
|
|
282 "[ \t]*"
|
|
|
283 (regexp-quote
|
|
|
284 ;; Get non-whitespace separated fill-str-prev
|
|
|
285 (substring
|
|
|
286 fill-str-prev
|
|
|
287 (or (string-match "[^ \t]" fill-str-prev) 0)
|
|
|
288 (if (string-match
|
|
|
289 "[ \t]*\\(.*[^ \t]\\)[ \t]*$"
|
|
|
290 fill-str-prev)
|
|
|
291 (match-end 1))))
|
|
|
292 "[ \t]*"
|
|
|
293 (if suffix "$"))))
|
|
|
294 (while (re-search-forward prefix nil t)
|
|
|
295 (replace-match fill-str nil t))))))))
|
|
|
296
|
|
|
297 (defun kfill:sh-comment (paragraph)
|
|
|
298 (setq fill-prefix (buffer-substring (match-beginning 0) (match-end 0)))
|
|
|
299 (if paragraph
|
|
|
300 (setq paragraph-separate
|
|
|
301 (concat "^" fill-prefix " *#\\|^"
|
|
|
302 (kfill:negate-string fill-prefix)))))
|
|
|
303
|
|
|
304 (defun kfill:supercite-included-text (paragraph)
|
|
|
305 (setq fill-prefix (buffer-substring (match-beginning 0) (match-end 0)))
|
|
|
306 (if paragraph
|
|
|
307 (setq paragraph-separate
|
|
|
308 (concat "^" (kfill:negate-string fill-prefix)))))
|
|
|
309
|
|
|
310 ;;; ************************************************************************
|
|
|
311 ;;; Private variables
|
|
|
312 ;;; ************************************************************************
|
|
|
313
|
|
|
314 (defconst kfill:hanging-expression
|
|
|
315 (cons 'or
|
|
|
316 (delq nil (mapcar (function
|
|
|
317 (lambda (pattern-type)
|
|
|
318 (if (eq (cdr pattern-type) 'kfill:hanging-list)
|
|
|
319 (list 'looking-at (car pattern-type)))))
|
|
|
320 kfill:prefix-table)))
|
|
|
321 "Conditional expression used to test for hanging indented lists.")
|
|
|
322
|
|
|
323 (defvar fill-prefix-prev nil
|
|
|
324 "Prior string inserted at front of new line during filling, or nil for none.
|
|
|
325 Setting this variable automatically makes it local to the current buffer.")
|
|
|
326 (make-variable-buffer-local 'fill-prefix-prev)
|
|
|
327
|
|
|
328
|
|
|
329 (provide 'kfill)
|
