1 ;;; Boxed comments for C mode.
2 ;;; Copyright (C) 1991-1994, 2008-2011 Free Software Foundation, Inc.
3 ;;; Francois Pinard <pinard@iro.umontreal.ca>, April 1991.
5 ;;; This file is part of GNU M4.
7 ;;; GNU M4 is free software: you can redistribute it and/or modify
8 ;;; it under the terms of the GNU General Public License as published by
9 ;;; the Free Software Foundation, either version 3 of the License, or
10 ;;; (at your option) any later version.
12 ;;; GNU M4 is distributed in the hope that it will be useful,
13 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 ;;; GNU General Public License for more details.
17 ;;; You should have received a copy of the GNU General Public License
18 ;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
20 ;;; I often refill paragraphs inside C comments, while stretching or
21 ;;; shrinking the surrounding box as needed. This is a real pain to
22 ;;; do by hand. Here is the code I made to ease my life on this,
23 ;;; usable from within GNU Emacs. It would not be fair giving all
24 ;;; sources for a product without also giving the means for nicely
27 ;;; The function rebox-c-comment adjust comment boxes without
28 ;;; refilling comment paragraphs, while reindent-c-comment adjust
29 ;;; comment boxes after refilling. Numeric prefixes are used to add,
30 ;;; remove, or change the style of the box surrounding the comment.
31 ;;; Since refilling paragraphs in C mode does make sense only for
32 ;;; comments, this code redefines the M-q command in C mode. I use
33 ;;; this hack by putting, in my .emacs file:
37 ;;; (define-key c-mode-map "\M-q" 'reindent-c-comment)))
38 ;;; (autoload 'rebox-c-comment "c-boxes" nil t)
39 ;;; (autoload 'reindent-c-comment "c-boxes" nil t)
41 ;;; The cursor should be within a comment before any of these
42 ;;; commands, or else it should be between two comments, in which case
43 ;;; the command applies to the next comment. When the command is
44 ;;; given without prefix, the current comment box type is recognized
45 ;;; and preserved. Given 0 as a prefix, the comment box disappears
46 ;;; and the comment stays between a single opening `/*' and a single
47 ;;; closing `*/'. Given 1 or 2 as a prefix, a single or doubled lined
48 ;;; comment box is forced. Given 3 as a prefix, a Taarna style box is
49 ;;; forced, but you do not even want to hear about those. When a
50 ;;; negative prefix is given, the absolute value is used, but the
51 ;;; default style is changed. Any other value (like C-u alone) forces
52 ;;; the default box style.
54 ;;; I observed rounded corners first in some code from Warren Tucker
55 ;;; <wht@n4hgf.mt-park.ga.us>.
57 (defvar c-box-default-style 'single "*Preferred style for box comments.")
58 (defvar c-mode-taarna-style nil "*Non-nil for Taarna team C-style.")
60 ;;; Set or reset the Taarna team's own way for a C style.
64 (if c-mode-taarna-style
67 (setq c-mode-taarna-style nil)
68 (setq c-indent-level 2)
69 (setq c-continued-statement-offset 2)
70 (setq c-brace-offset 0)
71 (setq c-argdecl-indent 5)
72 (setq c-label-offset -2)
73 (setq c-tab-always-indent t)
74 (setq c-box-default-style 'single)
75 (message "C mode: GNU style"))
77 (setq c-mode-taarna-style t)
78 (setq c-indent-level 4)
79 (setq c-continued-statement-offset 4)
80 (setq c-brace-offset -4)
81 (setq c-argdecl-indent 4)
82 (setq c-label-offset -4)
83 (setq c-tab-always-indent t)
84 (setq c-box-default-style 'taarna)
85 (message "C mode: Taarna style")))
87 ;;; Return the minimum value of the left margin of all lines, or -1 if
88 ;;; all lines are empty.
90 (defun buffer-left-margin ()
92 (goto-char (point-min))
94 (skip-chars-forward " \t")
95 (if (not (looking-at "\n"))
99 (min margin (current-column)))))
103 ;;; Return the maximum value of the right margin of all lines. Any
104 ;;; sentence ending a line has a space guaranteed before the margin.
106 (defun buffer-right-margin ()
107 (let ((margin 0) period)
108 (goto-char (point-min))
114 (setq period (if (looking-at "[.?!]") 1 0))
116 (setq margin (max margin (+ (current-column) period)))
120 ;;; Add, delete or adjust a C comment box. If FLAG is nil, the
121 ;;; current boxing style is recognized and preserved. When 0, the box
122 ;;; is removed; when 1, a single lined box is forced; when 2, a double
123 ;;; lined box is forced; when 3, a Taarna style box is forced. If
124 ;;; negative, the absolute value is used, but the default style is
125 ;;; changed. For any other value (like C-u), the default style is
126 ;;; forced. If REFILL is not nil, refill the comment paragraphs prior
129 (defun rebox-c-comment-engine (flag refill)
131 (let ((undo-list buffer-undo-list)
132 (marked-point (point-marker))
133 (saved-point (point))
134 box-style left-margin right-margin)
136 ;; First, find the limits of the block of comments following or
137 ;; enclosing the cursor, or return an error if the cursor is not
138 ;; within such a block of comments, narrow the buffer, and
141 ;; - insure the point is into the following comment, if any
143 (skip-chars-forward " \t\n")
144 (if (looking-at "/\\*")
147 (let ((here (point)) start end temp)
149 ;; - identify a minimal comment block
151 (search-backward "/*")
155 (skip-chars-forward " \t")
158 (goto-char saved-point)
159 (error "text before comment's start")))
160 (search-forward "*/")
163 (if (looking-at "\n")
166 (skip-chars-backward " \t\n")
169 (goto-char saved-point)
170 (error "text after comment's end")))
173 (goto-char saved-point)
174 (error "outside any comment block")))
176 ;; - try to extend the comment block backwards
179 (while (and (not (bobp))
180 (progn (previous-line 1)
182 (looking-at "[ \t]*/\\*.*\\*/[ \t]*$")))
183 (setq start (point)))
185 ;; - try to extend the comment block forward
188 (while (looking-at "[ \t]*/\\*.*\\*/[ \t]*$")
193 ;; - narrow to the whole block of comments
195 (narrow-to-region start end))
197 ;; Second, remove all the comment marks, and move all the text
198 ;; rigidly to the left to insure the left margin stays at the
199 ;; same place. At the same time, recognize and save the box
200 ;; style in BOX-STYLE.
202 (let ((previous-margin (buffer-left-margin))
205 ;; - remove all comment marks
207 (goto-char (point-min))
208 (replace-regexp "^\\([ \t]*\\)/\\*" "\\1 ")
209 (goto-char (point-min))
210 (replace-regexp "^\\([ \t]*\\)|" "\\1 ")
211 (goto-char (point-min))
212 (replace-regexp "\\(\\*/\\||\\)[ \t]*" "")
213 (goto-char (point-min))
214 (replace-regexp "\\*/[ \t]*/\\*" " ")
216 ;; - remove the first and last dashed lines
218 (setq box-style 'plain)
219 (goto-char (point-min))
220 (if (looking-at "^[ \t]*-*[.\+\\]?[ \t]*\n")
222 (setq box-style 'single)
224 (if (looking-at "^[ \t]*=*[.\+\\]?[ \t]*\n")
226 (setq box-style 'double)
227 (replace-match ""))))
228 (goto-char (point-max))
231 (if (looking-at "^[ \t]*[`\+\\]?*[-=]+[ \t]*\n")
233 (if (eq box-style 'plain)
234 (setq box-style 'taarna))
237 ;; - remove all spurious whitespace
239 (goto-char (point-min))
240 (replace-regexp "[ \t]+$" "")
241 (goto-char (point-min))
242 (if (looking-at "\n+")
244 (goto-char (point-max))
245 (skip-chars-backward "\n")
246 (if (looking-at "\n\n+")
247 (replace-match "\n"))
248 (goto-char (point-min))
249 (replace-regexp "\n\n\n+" "\n\n")
251 ;; - move the text left is adequate
253 (setq actual-margin (buffer-left-margin))
254 (if (not (= previous-margin actual-margin))
255 (indent-rigidly (point-min) (point-max)
256 (- previous-margin actual-margin))))
258 ;; Third, select the new box style from the old box style and
259 ;; the argument, choose the margins for this style and refill
262 ;; - modify box-style only if flag is defined
266 (cond ((eq flag 0) 'plain)
267 ((eq flag 1) 'single)
268 ((eq flag 2) 'double)
269 ((eq flag 3) 'taarna)
270 ((eq flag '-) (setq c-box-default-style 'plain) 'plain)
271 ((eq flag -1) (setq c-box-default-style 'single) 'single)
272 ((eq flag -2) (setq c-box-default-style 'double) 'double)
273 ((eq flag -3) (setq c-box-default-style 'taarna) 'taarna)
274 (t c-box-default-style))))
276 ;; - compute the left margin
278 (setq left-margin (buffer-left-margin))
280 ;; - temporarily set the fill prefix and column, then refill
282 (untabify (point-min) (point-max))
285 (let ((fill-prefix (make-string left-margin ? ))
286 (fill-column (- fill-column
287 (if (memq box-style '(single double)) 4 6))))
288 (fill-region (point-min) (point-max))))
290 ;; - compute the right margin after refill
292 (setq right-margin (buffer-right-margin))
294 ;; Fourth, put the narrowed buffer back into a comment box,
295 ;; according to the value of box-style. Values may be:
296 ;; plain: insert between a single pair of comment delimiters
297 ;; single: complete box, overline and underline with dashes
298 ;; double: complete box, overline and underline with equal signs
299 ;; taarna: comment delimiters on each line, underline with dashes
301 ;; - move the right margin to account for left inserts
303 (setq right-margin (+ right-margin
304 (if (memq box-style '(single double))
308 ;; - construct the box comment, from top to bottom
310 (goto-char (point-min))
311 (cond ((eq box-style 'plain)
313 ;; - construct a plain style comment
315 (skip-chars-forward " " (+ (point) left-margin))
316 (insert (make-string (- left-margin (current-column)) ? )
321 (skip-chars-forward " " (+ (point) left-margin))
322 (insert (make-string (- left-margin (current-column)) ? )
328 ((eq box-style 'single)
330 ;; - construct a single line style comment
332 (indent-to left-margin)
334 (insert (make-string (- right-margin (current-column)) ?-)
337 (skip-chars-forward " " (+ (point) left-margin))
338 (insert (make-string (- left-margin (current-column)) ? )
341 (indent-to right-margin)
344 (indent-to left-margin)
346 (insert (make-string (- right-margin (current-column)) ?-)
348 ((eq box-style 'double)
350 ;; - construct a double line style comment
352 (indent-to left-margin)
354 (insert (make-string (- right-margin (current-column)) ?=)
357 (skip-chars-forward " " (+ (point) left-margin))
358 (insert (make-string (- left-margin (current-column)) ? )
361 (indent-to right-margin)
364 (indent-to left-margin)
366 (insert (make-string (- right-margin (current-column)) ?=)
368 ((eq box-style 'taarna)
370 ;; - construct a Taarna style comment
373 (skip-chars-forward " " (+ (point) left-margin))
374 (insert (make-string (- left-margin (current-column)) ? )
377 (indent-to right-margin)
380 (indent-to left-margin)
382 (insert (make-string (- right-margin (current-column)) ?-)
384 (t (error "unknown box style")))
386 ;; Fifth, retabify, restore the point position, then cleanup the
387 ;; undo list of any boundary since we started.
389 ;; - retabify before left margin only (adapted from tabify.el)
391 (goto-char (point-min))
392 (while (re-search-forward "^[ \t][ \t][ \t]*" nil t)
393 (let ((column (current-column))
394 (indent-tabs-mode t))
395 (delete-region (match-beginning 0) (point))
398 ;; - restore the point position
400 (goto-char (marker-position marked-point))
402 ;; - remove all intermediate boundaries from the undo list
404 (if (not (eq buffer-undo-list undo-list))
405 (let ((cursor buffer-undo-list))
406 (while (not (eq (cdr cursor) undo-list))
407 (if (car (cdr cursor))
408 (setq cursor (cdr cursor))
409 (rplacd cursor (cdr (cdr cursor))))))))))
411 ;;; Rebox a C comment without refilling it.
413 (defun rebox-c-comment (flag)
415 (rebox-c-comment-engine flag nil))
417 ;;; Rebox a C comment after refilling.
419 (defun reindent-c-comment (flag)
421 (rebox-c-comment-engine flag t))