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