1 ;;; Boxed comments for C mode.
2 ;;; Copyright (C) 1991, 1992, 1993, 1994 Free Software Foundation, Inc.
3 ;;; Francois Pinard <pinard@iro.umontreal.ca>, April 1991.
5 ;;; I often refill paragraphs inside C comments, while stretching or
6 ;;; shrinking the surrounding box as needed. This is a real pain to
7 ;;; do by hand. Here is the code I made to ease my life on this,
8 ;;; usable from within GNU Emacs. It would not be fair giving all
9 ;;; sources for a product without also giving the means for nicely
12 ;;; The function rebox-c-comment adjust comment boxes without
13 ;;; refilling comment paragraphs, while reindent-c-comment adjust
14 ;;; comment boxes after refilling. Numeric prefixes are used to add,
15 ;;; remove, or change the style of the box surrounding the comment.
16 ;;; Since refilling paragraphs in C mode does make sense only for
17 ;;; comments, this code redefines the M-q command in C mode. I use
18 ;;; this hack by putting, in my .emacs file:
22 ;;; (define-key c-mode-map "\M-q" 'reindent-c-comment)))
23 ;;; (autoload 'rebox-c-comment "c-boxes" nil t)
24 ;;; (autoload 'reindent-c-comment "c-boxes" nil t)
26 ;;; The cursor should be within a comment before any of these
27 ;;; commands, or else it should be between two comments, in which case
28 ;;; the command applies to the next comment. When the command is
29 ;;; given without prefix, the current comment box type is recognized
30 ;;; and preserved. Given 0 as a prefix, the comment box disappears
31 ;;; and the comment stays between a single opening `/*' and a single
32 ;;; closing `*/'. Given 1 or 2 as a prefix, a single or doubled lined
33 ;;; comment box is forced. Given 3 as a prefix, a Taarna style box is
34 ;;; forced, but you do not even want to hear about those. When a
35 ;;; negative prefix is given, the absolute value is used, but the
36 ;;; default style is changed. Any other value (like C-u alone) forces
37 ;;; the default box style.
39 ;;; I observed rounded corners first in some code from Warren Tucker
40 ;;; <wht@n4hgf.mt-park.ga.us>.
42 (defvar c-box-default-style
'single
"*Preferred style for box comments.")
43 (defvar c-mode-taarna-style nil
"*Non-nil for Taarna team C-style.")
45 ;;; Set or reset the Taarna team's own way for a C style.
49 (if c-mode-taarna-style
52 (setq c-mode-taarna-style nil
)
53 (setq c-indent-level
2)
54 (setq c-continued-statement-offset
2)
55 (setq c-brace-offset
0)
56 (setq c-argdecl-indent
5)
57 (setq c-label-offset -
2)
58 (setq c-tab-always-indent t
)
59 (setq c-box-default-style
'single
)
60 (message "C mode: GNU style"))
62 (setq c-mode-taarna-style t
)
63 (setq c-indent-level
4)
64 (setq c-continued-statement-offset
4)
65 (setq c-brace-offset -
4)
66 (setq c-argdecl-indent
4)
67 (setq c-label-offset -
4)
68 (setq c-tab-always-indent t
)
69 (setq c-box-default-style
'taarna
)
70 (message "C mode: Taarna style")))
72 ;;; Return the minimum value of the left margin of all lines, or -1 if
73 ;;; all lines are empty.
75 (defun buffer-left-margin ()
77 (goto-char (point-min))
79 (skip-chars-forward " \t")
80 (if (not (looking-at "\n"))
84 (min margin
(current-column)))))
88 ;;; Return the maximum value of the right margin of all lines. Any
89 ;;; sentence ending a line has a space guaranteed before the margin.
91 (defun buffer-right-margin ()
92 (let ((margin 0) period
)
93 (goto-char (point-min))
99 (setq period
(if (looking-at "[.?!]") 1 0))
101 (setq margin
(max margin
(+ (current-column) period
)))
105 ;;; Add, delete or adjust a C comment box. If FLAG is nil, the
106 ;;; current boxing style is recognized and preserved. When 0, the box
107 ;;; is removed; when 1, a single lined box is forced; when 2, a double
108 ;;; lined box is forced; when 3, a Taarna style box is forced. If
109 ;;; negative, the absolute value is used, but the default style is
110 ;;; changed. For any other value (like C-u), the default style is
111 ;;; forced. If REFILL is not nil, refill the comment paragraphs prior
114 (defun rebox-c-comment-engine (flag refill
)
116 (let ((undo-list buffer-undo-list
)
117 (marked-point (point-marker))
118 (saved-point (point))
119 box-style left-margin right-margin
)
121 ;; First, find the limits of the block of comments following or
122 ;; enclosing the cursor, or return an error if the cursor is not
123 ;; within such a block of comments, narrow the buffer, and
126 ;; - insure the point is into the following comment, if any
128 (skip-chars-forward " \t\n")
129 (if (looking-at "/\\*")
132 (let ((here (point)) start end temp
)
134 ;; - identify a minimal comment block
136 (search-backward "/*")
140 (skip-chars-forward " \t")
143 (goto-char saved-point
)
144 (error "text before comment's start")))
145 (search-forward "*/")
148 (if (looking-at "\n")
151 (skip-chars-backward " \t\n")
154 (goto-char saved-point
)
155 (error "text after comment's end")))
158 (goto-char saved-point
)
159 (error "outside any comment block")))
161 ;; - try to extend the comment block backwards
164 (while (and (not (bobp))
165 (progn (previous-line 1)
167 (looking-at "[ \t]*/\\*.*\\*/[ \t]*$")))
168 (setq start
(point)))
170 ;; - try to extend the comment block forward
173 (while (looking-at "[ \t]*/\\*.*\\*/[ \t]*$")
178 ;; - narrow to the whole block of comments
180 (narrow-to-region start end
))
182 ;; Second, remove all the comment marks, and move all the text
183 ;; rigidly to the left to insure the left margin stays at the
184 ;; same place. At the same time, recognize and save the box
185 ;; style in BOX-STYLE.
187 (let ((previous-margin (buffer-left-margin))
190 ;; - remove all comment marks
192 (goto-char (point-min))
193 (replace-regexp "^\\([ \t]*\\)/\\*" "\\1 ")
194 (goto-char (point-min))
195 (replace-regexp "^\\([ \t]*\\)|" "\\1 ")
196 (goto-char (point-min))
197 (replace-regexp "\\(\\*/\\||\\)[ \t]*" "")
198 (goto-char (point-min))
199 (replace-regexp "\\*/[ \t]*/\\*" " ")
201 ;; - remove the first and last dashed lines
203 (setq box-style
'plain
)
204 (goto-char (point-min))
205 (if (looking-at "^[ \t]*-*[.\+\\]?[ \t]*\n")
207 (setq box-style
'single
)
209 (if (looking-at "^[ \t]*=*[.\+\\]?[ \t]*\n")
211 (setq box-style
'double
)
212 (replace-match ""))))
213 (goto-char (point-max))
216 (if (looking-at "^[ \t]*[`\+\\]?*[-=]+[ \t]*\n")
218 (if (eq box-style
'plain
)
219 (setq box-style
'taarna
))
222 ;; - remove all spurious whitespace
224 (goto-char (point-min))
225 (replace-regexp "[ \t]+$" "")
226 (goto-char (point-min))
227 (if (looking-at "\n+")
229 (goto-char (point-max))
230 (skip-chars-backward "\n")
231 (if (looking-at "\n\n+")
232 (replace-match "\n"))
233 (goto-char (point-min))
234 (replace-regexp "\n\n\n+" "\n\n")
236 ;; - move the text left is adequate
238 (setq actual-margin
(buffer-left-margin))
239 (if (not (= previous-margin actual-margin
))
240 (indent-rigidly (point-min) (point-max)
241 (- previous-margin actual-margin
))))
243 ;; Third, select the new box style from the old box style and
244 ;; the argument, choose the margins for this style and refill
247 ;; - modify box-style only if flag is defined
251 (cond ((eq flag
0) 'plain
)
252 ((eq flag
1) 'single
)
253 ((eq flag
2) 'double
)
254 ((eq flag
3) 'taarna
)
255 ((eq flag
'-
) (setq c-box-default-style
'plain
) 'plain
)
256 ((eq flag -
1) (setq c-box-default-style
'single
) 'single
)
257 ((eq flag -
2) (setq c-box-default-style
'double
) 'double
)
258 ((eq flag -
3) (setq c-box-default-style
'taarna
) 'taarna
)
259 (t c-box-default-style
))))
261 ;; - compute the left margin
263 (setq left-margin
(buffer-left-margin))
265 ;; - temporarily set the fill prefix and column, then refill
267 (untabify (point-min) (point-max))
270 (let ((fill-prefix (make-string left-margin ?
))
271 (fill-column (- fill-column
272 (if (memq box-style
'(single double
)) 4 6))))
273 (fill-region (point-min) (point-max))))
275 ;; - compute the right margin after refill
277 (setq right-margin
(buffer-right-margin))
279 ;; Fourth, put the narrowed buffer back into a comment box,
280 ;; according to the value of box-style. Values may be:
281 ;; plain: insert between a single pair of comment delimiters
282 ;; single: complete box, overline and underline with dashes
283 ;; double: complete box, overline and underline with equal signs
284 ;; taarna: comment delimiters on each line, underline with dashes
286 ;; - move the right margin to account for left inserts
288 (setq right-margin
(+ right-margin
289 (if (memq box-style
'(single double
))
293 ;; - construct the box comment, from top to bottom
295 (goto-char (point-min))
296 (cond ((eq box-style
'plain
)
298 ;; - construct a plain style comment
300 (skip-chars-forward " " (+ (point) left-margin
))
301 (insert (make-string (- left-margin
(current-column)) ?
)
306 (skip-chars-forward " " (+ (point) left-margin
))
307 (insert (make-string (- left-margin
(current-column)) ?
)
313 ((eq box-style
'single
)
315 ;; - construct a single line style comment
317 (indent-to left-margin
)
319 (insert (make-string (- right-margin
(current-column)) ?-
)
322 (skip-chars-forward " " (+ (point) left-margin
))
323 (insert (make-string (- left-margin
(current-column)) ?
)
326 (indent-to right-margin
)
329 (indent-to left-margin
)
331 (insert (make-string (- right-margin
(current-column)) ?-
)
333 ((eq box-style
'double
)
335 ;; - construct a double line style comment
337 (indent-to left-margin
)
339 (insert (make-string (- right-margin
(current-column)) ?
=)
342 (skip-chars-forward " " (+ (point) left-margin
))
343 (insert (make-string (- left-margin
(current-column)) ?
)
346 (indent-to right-margin
)
349 (indent-to left-margin
)
351 (insert (make-string (- right-margin
(current-column)) ?
=)
353 ((eq box-style
'taarna
)
355 ;; - construct a Taarna style comment
358 (skip-chars-forward " " (+ (point) left-margin
))
359 (insert (make-string (- left-margin
(current-column)) ?
)
362 (indent-to right-margin
)
365 (indent-to left-margin
)
367 (insert (make-string (- right-margin
(current-column)) ?-
)
369 (t (error "unknown box style")))
371 ;; Fifth, retabify, restore the point position, then cleanup the
372 ;; undo list of any boundary since we started.
374 ;; - retabify before left margin only (adapted from tabify.el)
376 (goto-char (point-min))
377 (while (re-search-forward "^[ \t][ \t][ \t]*" nil t
)
378 (let ((column (current-column))
379 (indent-tabs-mode t
))
380 (delete-region (match-beginning 0) (point))
383 ;; - restore the point position
385 (goto-char (marker-position marked-point
))
387 ;; - remove all intermediate boundaries from the undo list
389 (if (not (eq buffer-undo-list undo-list
))
390 (let ((cursor buffer-undo-list
))
391 (while (not (eq (cdr cursor
) undo-list
))
392 (if (car (cdr cursor
))
393 (setq cursor
(cdr cursor
))
394 (rplacd cursor
(cdr (cdr cursor
))))))))))
396 ;;; Rebox a C comment without refilling it.
398 (defun rebox-c-comment (flag)
400 (rebox-c-comment-engine flag nil
))
402 ;;; Rebox a C comment after refilling.
404 (defun reindent-c-comment (flag)
406 (rebox-c-comment-engine flag t
))