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