1;;; Boxed comments for C mode.
2;;; Copyright (C) 1991-1994, 2008-2014, 2016-2017, 2020-2021 Free
3;;; Software Foundation, Inc.
4;;; François Pinard <pinard@iro.umontreal.ca>, April 1991.
5;;;
6;;; This file is part of GNU M4.
7;;;
8;;; GNU M4 is free software: you can redistribute it and/or modify
9;;; it under the terms of the GNU General Public License as published by
10;;; the Free Software Foundation, either version 3 of the License, or
11;;; (at your option) any later version.
12;;;
13;;; GNU M4 is distributed in the hope that it will be useful,
14;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
15;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
16;;; GNU General Public License for more details.
17;;;
18;;; You should have received a copy of the GNU General Public License
19;;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
20
21;;; I often refill paragraphs inside C comments, while stretching or
22;;; shrinking the surrounding box as needed.  This is a real pain to
23;;; do by hand.  Here is the code I made to ease my life on this,
24;;; usable from within GNU Emacs.  It would not be fair giving all
25;;; sources for a product without also giving the means for nicely
26;;; modifying them.
27;;;
28;;; The function rebox-c-comment adjust comment boxes without
29;;; refilling comment paragraphs, while reindent-c-comment adjust
30;;; comment boxes after refilling.  Numeric prefixes are used to add,
31;;; remove, or change the style of the box surrounding the comment.
32;;; Since refilling paragraphs in C mode does make sense only for
33;;; comments, this code redefines the M-q command in C mode.  I use
34;;; this hack by putting, in my .emacs file:
35;;;
36;;;	(setq c-mode-hook
37;;;	      '(lambda ()
38;;;		 (define-key c-mode-map "\M-q" 'reindent-c-comment)))
39;;;	(autoload 'rebox-c-comment "c-boxes" nil t)
40;;;	(autoload 'reindent-c-comment "c-boxes" nil t)
41;;;
42;;; The cursor should be within a comment before any of these
43;;; commands, or else it should be between two comments, in which case
44;;; the command applies to the next comment.  When the command is
45;;; given without prefix, the current comment box type is recognized
46;;; and preserved.  Given 0 as a prefix, the comment box disappears
47;;; and the comment stays between a single opening `/*' and a single
48;;; closing `*/'.  Given 1 or 2 as a prefix, a single or doubled lined
49;;; comment box is forced.  Given 3 as a prefix, a Taarna style box is
50;;; forced, but you do not even want to hear about those.  When a
51;;; negative prefix is given, the absolute value is used, but the
52;;; default style is changed.  Any other value (like C-u alone) forces
53;;; the default box style.
54;;;
55;;; I observed rounded corners first in some code from Warren Tucker
56;;; <wht@n4hgf.mt-park.ga.us>.
57
58(defvar c-box-default-style 'single "*Preferred style for box comments.")
59(defvar c-mode-taarna-style nil "*Non-nil for Taarna team C-style.")
60
61;;; Set or reset the Taarna team's own way for a C style.
62
63(defun taarna-mode ()
64  (interactive)
65  (if c-mode-taarna-style
66      (progn
67
68        (setq c-mode-taarna-style nil)
69        (setq c-indent-level 2)
70        (setq c-continued-statement-offset 2)
71        (setq c-brace-offset 0)
72        (setq c-argdecl-indent 5)
73        (setq c-label-offset -2)
74        (setq c-tab-always-indent t)
75        (setq c-box-default-style 'single)
76        (message "C mode: GNU style"))
77
78    (setq c-mode-taarna-style t)
79    (setq c-indent-level 4)
80    (setq c-continued-statement-offset 4)
81    (setq c-brace-offset -4)
82    (setq c-argdecl-indent 4)
83    (setq c-label-offset -4)
84    (setq c-tab-always-indent t)
85    (setq c-box-default-style 'taarna)
86    (message "C mode: Taarna style")))
87
88;;; Return the minimum value of the left margin of all lines, or -1 if
89;;; all lines are empty.
90
91(defun buffer-left-margin ()
92  (let ((margin -1))
93    (goto-char (point-min))
94    (while (not (eobp))
95      (skip-chars-forward " \t")
96      (if (not (looking-at "\n"))
97          (setq margin
98                (if (< margin 0)
99                    (current-column)
100                  (min margin (current-column)))))
101      (forward-line 1))
102    margin))
103
104;;; Return the maximum value of the right margin of all lines.  Any
105;;; sentence ending a line has a space guaranteed before the margin.
106
107(defun buffer-right-margin ()
108  (let ((margin 0) period)
109    (goto-char (point-min))
110    (while (not (eobp))
111      (end-of-line)
112      (if (bobp)
113          (setq period 0)
114        (backward-char 1)
115        (setq period (if (looking-at "[.?!]") 1 0))
116        (forward-char 1))
117      (setq margin (max margin (+ (current-column) period)))
118      (forward-char 1))
119    margin))
120
121;;; Add, delete or adjust a C comment box.  If FLAG is nil, the
122;;; current boxing style is recognized and preserved.  When 0, the box
123;;; is removed; when 1, a single lined box is forced; when 2, a double
124;;; lined box is forced; when 3, a Taarna style box is forced.  If
125;;; negative, the absolute value is used, but the default style is
126;;; changed.  For any other value (like C-u), the default style is
127;;; forced.  If REFILL is not nil, refill the comment paragraphs prior
128;;; to reboxing.
129
130(defun rebox-c-comment-engine (flag refill)
131  (save-restriction
132    (let ((undo-list buffer-undo-list)
133          (marked-point (point-marker))
134          (saved-point (point))
135          box-style left-margin right-margin)
136
137      ;; First, find the limits of the block of comments following or
138      ;; enclosing the cursor, or return an error if the cursor is not
139      ;; within such a block of comments, narrow the buffer, and
140      ;; untabify it.
141
142      ;; - insure the point is into the following comment, if any
143
144      (skip-chars-forward " \t\n")
145      (if (looking-at "/\\*")
146          (forward-char 2))
147
148      (let ((here (point)) start end temp)
149
150        ;; - identify a minimal comment block
151
152        (search-backward "/*")
153        (setq temp (point))
154        (beginning-of-line)
155        (setq start (point))
156        (skip-chars-forward " \t")
157        (if (< (point) temp)
158            (progn
159              (goto-char saved-point)
160              (error "text before comment's start")))
161        (search-forward "*/")
162        (setq temp (point))
163        (end-of-line)
164        (if (looking-at "\n")
165            (forward-char 1))
166        (setq end (point))
167        (skip-chars-backward " \t\n")
168        (if (> (point) temp)
169            (progn
170              (goto-char saved-point)
171              (error "text after comment's end")))
172        (if (< end here)
173            (progn
174              (goto-char saved-point)
175              (error "outside any comment block")))
176
177        ;; - try to extend the comment block backwards
178
179        (goto-char start)
180        (while (and (not (bobp))
181                    (progn (previous-line 1)
182                           (beginning-of-line)
183                           (looking-at "[ \t]*/\\*.*\\*/[ \t]*$")))
184          (setq start (point)))
185
186        ;; - try to extend the comment block forward
187
188        (goto-char end)
189        (while (looking-at "[ \t]*/\\*.*\\*/[ \t]*$")
190          (forward-line 1)
191          (beginning-of-line)
192          (setq end (point)))
193
194        ;; - narrow to the whole block of comments
195
196        (narrow-to-region start end))
197
198      ;; Second, remove all the comment marks, and move all the text
199      ;; rigidly to the left to insure the left margin stays at the
200      ;; same place.  At the same time, recognize and save the box
201      ;; style in BOX-STYLE.
202
203      (let ((previous-margin (buffer-left-margin))
204            actual-margin)
205
206        ;; - remove all comment marks
207
208        (goto-char (point-min))
209        (replace-regexp "^\\([ \t]*\\)/\\*" "\\1  ")
210        (goto-char (point-min))
211        (replace-regexp "^\\([ \t]*\\)|" "\\1 ")
212        (goto-char (point-min))
213        (replace-regexp "\\(\\*/\\||\\)[ \t]*" "")
214        (goto-char (point-min))
215        (replace-regexp "\\*/[ \t]*/\\*" " ")
216
217        ;; - remove the first and last dashed lines
218
219        (setq box-style 'plain)
220        (goto-char (point-min))
221        (if (looking-at "^[ \t]*-*[.\+\\]?[ \t]*\n")
222            (progn
223              (setq box-style 'single)
224              (replace-match ""))
225          (if (looking-at "^[ \t]*=*[.\+\\]?[ \t]*\n")
226              (progn
227                (setq box-style 'double)
228                (replace-match ""))))
229        (goto-char (point-max))
230        (previous-line 1)
231        (beginning-of-line)
232        (if (looking-at "^[ \t]*[`\+\\]?*[-=]+[ \t]*\n")
233            (progn
234              (if (eq box-style 'plain)
235                  (setq box-style 'taarna))
236              (replace-match "")))
237
238        ;; - remove all spurious whitespace
239
240        (goto-char (point-min))
241        (replace-regexp "[ \t]+$" "")
242        (goto-char (point-min))
243        (if (looking-at "\n+")
244            (replace-match ""))
245        (goto-char (point-max))
246        (skip-chars-backward "\n")
247        (if (looking-at "\n\n+")
248            (replace-match "\n"))
249        (goto-char (point-min))
250        (replace-regexp "\n\n\n+" "\n\n")
251
252        ;; - move the text left is adequate
253
254        (setq actual-margin (buffer-left-margin))
255        (if (not (= previous-margin actual-margin))
256            (indent-rigidly (point-min) (point-max)
257                            (- previous-margin actual-margin))))
258
259      ;; Third, select the new box style from the old box style and
260      ;; the argument, choose the margins for this style and refill
261      ;; each paragraph.
262
263      ;; - modify box-style only if flag is defined
264
265      (if flag
266          (setq box-style
267                (cond ((eq flag 0) 'plain)
268                      ((eq flag 1) 'single)
269                      ((eq flag 2) 'double)
270                      ((eq flag 3) 'taarna)
271                      ((eq flag '-) (setq c-box-default-style 'plain) 'plain)
272                      ((eq flag -1) (setq c-box-default-style 'single) 'single)
273                      ((eq flag -2) (setq c-box-default-style 'double) 'double)
274                      ((eq flag -3) (setq c-box-default-style 'taarna) 'taarna)
275                      (t c-box-default-style))))
276
277      ;; - compute the left margin
278
279      (setq left-margin (buffer-left-margin))
280
281      ;; - temporarily set the fill prefix and column, then refill
282
283      (untabify (point-min) (point-max))
284
285      (if refill
286          (let ((fill-prefix (make-string left-margin ? ))
287                (fill-column (- fill-column
288                                (if (memq box-style '(single double)) 4 6))))
289            (fill-region (point-min) (point-max))))
290
291      ;; - compute the right margin after refill
292
293      (setq right-margin (buffer-right-margin))
294
295      ;; Fourth, put the narrowed buffer back into a comment box,
296      ;; according to the value of box-style.  Values may be:
297      ;;    plain: insert between a single pair of comment delimiters
298      ;;    single: complete box, overline and underline with dashes
299      ;;    double: complete box, overline and underline with equal signs
300      ;;    taarna: comment delimiters on each line, underline with dashes
301
302      ;; - move the right margin to account for left inserts
303
304      (setq right-margin (+ right-margin
305                            (if (memq box-style '(single double))
306                                2
307                              3)))
308
309      ;; - construct the box comment, from top to bottom
310
311      (goto-char (point-min))
312      (cond ((eq box-style 'plain)
313
314             ;; - construct a plain style comment
315
316             (skip-chars-forward " " (+ (point) left-margin))
317             (insert (make-string (- left-margin (current-column)) ? )
318                     "/* ")
319             (end-of-line)
320             (forward-char 1)
321             (while (not (eobp))
322               (skip-chars-forward " " (+ (point) left-margin))
323               (insert (make-string (- left-margin (current-column)) ? )
324                       "   ")
325               (end-of-line)
326               (forward-char 1))
327             (backward-char 1)
328             (insert "  */"))
329            ((eq box-style 'single)
330
331             ;; - construct a single line style comment
332
333             (indent-to left-margin)
334             (insert "/*")
335             (insert (make-string (- right-margin (current-column)) ?-)
336                     "-.\n")
337             (while (not (eobp))
338               (skip-chars-forward " " (+ (point) left-margin))
339               (insert (make-string (- left-margin (current-column)) ? )
340                       "| ")
341               (end-of-line)
342               (indent-to right-margin)
343               (insert " |")
344               (forward-char 1))
345             (indent-to left-margin)
346             (insert "`")
347             (insert (make-string (- right-margin (current-column)) ?-)
348                     "*/\n"))
349            ((eq box-style 'double)
350
351             ;; - construct a double line style comment
352
353             (indent-to left-margin)
354             (insert "/*")
355             (insert (make-string (- right-margin (current-column)) ?=)
356                     "=\\\n")
357             (while (not (eobp))
358               (skip-chars-forward " " (+ (point) left-margin))
359               (insert (make-string (- left-margin (current-column)) ? )
360                       "| ")
361               (end-of-line)
362               (indent-to right-margin)
363               (insert " |")
364               (forward-char 1))
365             (indent-to left-margin)
366             (insert "\\")
367             (insert (make-string (- right-margin (current-column)) ?=)
368                     "*/\n"))
369            ((eq box-style 'taarna)
370
371             ;; - construct a Taarna style comment
372
373             (while (not (eobp))
374               (skip-chars-forward " " (+ (point) left-margin))
375               (insert (make-string (- left-margin (current-column)) ? )
376                       "/* ")
377               (end-of-line)
378               (indent-to right-margin)
379               (insert " */")
380               (forward-char 1))
381             (indent-to left-margin)
382             (insert "/* ")
383             (insert (make-string (- right-margin (current-column)) ?-)
384                     " */\n"))
385            (t (error "unknown box style")))
386
387      ;; Fifth, retabify, restore the point position, then cleanup the
388      ;; undo list of any boundary since we started.
389
390      ;; - retabify before left margin only (adapted from tabify.el)
391
392      (goto-char (point-min))
393      (while (re-search-forward "^[ \t][ \t][ \t]*" nil t)
394        (let ((column (current-column))
395              (indent-tabs-mode t))
396          (delete-region (match-beginning 0) (point))
397          (indent-to column)))
398
399      ;; - restore the point position
400
401      (goto-char (marker-position marked-point))
402
403      ;; - remove all intermediate boundaries from the undo list
404
405      (if (not (eq buffer-undo-list undo-list))
406          (let ((cursor buffer-undo-list))
407            (while (not (eq (cdr cursor) undo-list))
408              (if (car (cdr cursor))
409                  (setq cursor (cdr cursor))
410                (rplacd cursor (cdr (cdr cursor))))))))))
411
412;;; Rebox a C comment without refilling it.
413
414(defun rebox-c-comment (flag)
415  (interactive "P")
416  (rebox-c-comment-engine flag nil))
417
418;;; Rebox a C comment after refilling.
419
420(defun reindent-c-comment (flag)
421  (interactive "P")
422  (rebox-c-comment-engine flag t))
423