| 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. |
|---|
| 4 | ;;; |
|---|
| 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 |
|---|
| 10 | ;;; modifying them. |
|---|
| 11 | ;;; |
|---|
| 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: |
|---|
| 19 | ;;; |
|---|
| 20 | ;;; (setq c-mode-hook |
|---|
| 21 | ;;; '(lambda () |
|---|
| 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) |
|---|
| 25 | ;;; |
|---|
| 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. |
|---|
| 38 | ;;; |
|---|
| 39 | ;;; I observed rounded corners first in some code from Warren Tucker |
|---|
| 40 | ;;; <wht@n4hgf.mt-park.ga.us>. |
|---|
| 41 | |
|---|
| 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.") |
|---|
| 44 | |
|---|
| 45 | ;;; Set or reset the Taarna team's own way for a C style. |
|---|
| 46 | |
|---|
| 47 | (defun taarna-mode () |
|---|
| 48 | (interactive) |
|---|
| 49 | (if c-mode-taarna-style |
|---|
| 50 | (progn |
|---|
| 51 | |
|---|
| 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")) |
|---|
| 61 | |
|---|
| 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"))) |
|---|
| 71 | |
|---|
| 72 | ;;; Return the minimum value of the left margin of all lines, or -1 if |
|---|
| 73 | ;;; all lines are empty. |
|---|
| 74 | |
|---|
| 75 | (defun buffer-left-margin () |
|---|
| 76 | (let ((margin -1)) |
|---|
| 77 | (goto-char (point-min)) |
|---|
| 78 | (while (not (eobp)) |
|---|
| 79 | (skip-chars-forward " \t") |
|---|
| 80 | (if (not (looking-at "\n")) |
|---|
| 81 | (setq margin |
|---|
| 82 | (if (< margin 0) |
|---|
| 83 | (current-column) |
|---|
| 84 | (min margin (current-column))))) |
|---|
| 85 | (forward-line 1)) |
|---|
| 86 | margin)) |
|---|
| 87 | |
|---|
| 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. |
|---|
| 90 | |
|---|
| 91 | (defun buffer-right-margin () |
|---|
| 92 | (let ((margin 0) period) |
|---|
| 93 | (goto-char (point-min)) |
|---|
| 94 | (while (not (eobp)) |
|---|
| 95 | (end-of-line) |
|---|
| 96 | (if (bobp) |
|---|
| 97 | (setq period 0) |
|---|
| 98 | (backward-char 1) |
|---|
| 99 | (setq period (if (looking-at "[.?!]") 1 0)) |
|---|
| 100 | (forward-char 1)) |
|---|
| 101 | (setq margin (max margin (+ (current-column) period))) |
|---|
| 102 | (forward-char 1)) |
|---|
| 103 | margin)) |
|---|
| 104 | |
|---|
| 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 |
|---|
| 112 | ;;; to reboxing. |
|---|
| 113 | |
|---|
| 114 | (defun rebox-c-comment-engine (flag refill) |
|---|
| 115 | (save-restriction |
|---|
| 116 | (let ((undo-list buffer-undo-list) |
|---|
| 117 | (marked-point (point-marker)) |
|---|
| 118 | (saved-point (point)) |
|---|
| 119 | box-style left-margin right-margin) |
|---|
| 120 | |
|---|
| 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 |
|---|
| 124 | ;; untabify it. |
|---|
| 125 | |
|---|
| 126 | ;; - insure the point is into the following comment, if any |
|---|
| 127 | |
|---|
| 128 | (skip-chars-forward " \t\n") |
|---|
| 129 | (if (looking-at "/\\*") |
|---|
| 130 | (forward-char 2)) |
|---|
| 131 | |
|---|
| 132 | (let ((here (point)) start end temp) |
|---|
| 133 | |
|---|
| 134 | ;; - identify a minimal comment block |
|---|
| 135 | |
|---|
| 136 | (search-backward "/*") |
|---|
| 137 | (setq temp (point)) |
|---|
| 138 | (beginning-of-line) |
|---|
| 139 | (setq start (point)) |
|---|
| 140 | (skip-chars-forward " \t") |
|---|
| 141 | (if (< (point) temp) |
|---|
| 142 | (progn |
|---|
| 143 | (goto-char saved-point) |
|---|
| 144 | (error "text before comment's start"))) |
|---|
| 145 | (search-forward "*/") |
|---|
| 146 | (setq temp (point)) |
|---|
| 147 | (end-of-line) |
|---|
| 148 | (if (looking-at "\n") |
|---|
| 149 | (forward-char 1)) |
|---|
| 150 | (setq end (point)) |
|---|
| 151 | (skip-chars-backward " \t\n") |
|---|
| 152 | (if (> (point) temp) |
|---|
| 153 | (progn |
|---|
| 154 | (goto-char saved-point) |
|---|
| 155 | (error "text after comment's end"))) |
|---|
| 156 | (if (< end here) |
|---|
| 157 | (progn |
|---|
| 158 | (goto-char saved-point) |
|---|
| 159 | (error "outside any comment block"))) |
|---|
| 160 | |
|---|
| 161 | ;; - try to extend the comment block backwards |
|---|
| 162 | |
|---|
| 163 | (goto-char start) |
|---|
| 164 | (while (and (not (bobp)) |
|---|
| 165 | (progn (previous-line 1) |
|---|
| 166 | (beginning-of-line) |
|---|
| 167 | (looking-at "[ \t]*/\\*.*\\*/[ \t]*$"))) |
|---|
| 168 | (setq start (point))) |
|---|
| 169 | |
|---|
| 170 | ;; - try to extend the comment block forward |
|---|
| 171 | |
|---|
| 172 | (goto-char end) |
|---|
| 173 | (while (looking-at "[ \t]*/\\*.*\\*/[ \t]*$") |
|---|
| 174 | (forward-line 1) |
|---|
| 175 | (beginning-of-line) |
|---|
| 176 | (setq end (point))) |
|---|
| 177 | |
|---|
| 178 | ;; - narrow to the whole block of comments |
|---|
| 179 | |
|---|
| 180 | (narrow-to-region start end)) |
|---|
| 181 | |
|---|
| 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. |
|---|
| 186 | |
|---|
| 187 | (let ((previous-margin (buffer-left-margin)) |
|---|
| 188 | actual-margin) |
|---|
| 189 | |
|---|
| 190 | ;; - remove all comment marks |
|---|
| 191 | |
|---|
| 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]*/\\*" " ") |
|---|
| 200 | |
|---|
| 201 | ;; - remove the first and last dashed lines |
|---|
| 202 | |
|---|
| 203 | (setq box-style 'plain) |
|---|
| 204 | (goto-char (point-min)) |
|---|
| 205 | (if (looking-at "^[ \t]*-*[.\+\\]?[ \t]*\n") |
|---|
| 206 | (progn |
|---|
| 207 | (setq box-style 'single) |
|---|
| 208 | (replace-match "")) |
|---|
| 209 | (if (looking-at "^[ \t]*=*[.\+\\]?[ \t]*\n") |
|---|
| 210 | (progn |
|---|
| 211 | (setq box-style 'double) |
|---|
| 212 | (replace-match "")))) |
|---|
| 213 | (goto-char (point-max)) |
|---|
| 214 | (previous-line 1) |
|---|
| 215 | (beginning-of-line) |
|---|
| 216 | (if (looking-at "^[ \t]*[`\+\\]?*[-=]+[ \t]*\n") |
|---|
| 217 | (progn |
|---|
| 218 | (if (eq box-style 'plain) |
|---|
| 219 | (setq box-style 'taarna)) |
|---|
| 220 | (replace-match ""))) |
|---|
| 221 | |
|---|
| 222 | ;; - remove all spurious whitespace |
|---|
| 223 | |
|---|
| 224 | (goto-char (point-min)) |
|---|
| 225 | (replace-regexp "[ \t]+$" "") |
|---|
| 226 | (goto-char (point-min)) |
|---|
| 227 | (if (looking-at "\n+") |
|---|
| 228 | (replace-match "")) |
|---|
| 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") |
|---|
| 235 | |
|---|
| 236 | ;; - move the text left is adequate |
|---|
| 237 | |
|---|
| 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)))) |
|---|
| 242 | |
|---|
| 243 | ;; Third, select the new box style from the old box style and |
|---|
| 244 | ;; the argument, choose the margins for this style and refill |
|---|
| 245 | ;; each paragraph. |
|---|
| 246 | |
|---|
| 247 | ;; - modify box-style only if flag is defined |
|---|
| 248 | |
|---|
| 249 | (if flag |
|---|
| 250 | (setq box-style |
|---|
| 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)))) |
|---|
| 260 | |
|---|
| 261 | ;; - compute the left margin |
|---|
| 262 | |
|---|
| 263 | (setq left-margin (buffer-left-margin)) |
|---|
| 264 | |
|---|
| 265 | ;; - temporarily set the fill prefix and column, then refill |
|---|
| 266 | |
|---|
| 267 | (untabify (point-min) (point-max)) |
|---|
| 268 | |
|---|
| 269 | (if refill |
|---|
| 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)))) |
|---|
| 274 | |
|---|
| 275 | ;; - compute the right margin after refill |
|---|
| 276 | |
|---|
| 277 | (setq right-margin (buffer-right-margin)) |
|---|
| 278 | |
|---|
| 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 |
|---|
| 285 | |
|---|
| 286 | ;; - move the right margin to account for left inserts |
|---|
| 287 | |
|---|
| 288 | (setq right-margin (+ right-margin |
|---|
| 289 | (if (memq box-style '(single double)) |
|---|
| 290 | 2 |
|---|
| 291 | 3))) |
|---|
| 292 | |
|---|
| 293 | ;; - construct the box comment, from top to bottom |
|---|
| 294 | |
|---|
| 295 | (goto-char (point-min)) |
|---|
| 296 | (cond ((eq box-style 'plain) |
|---|
| 297 | |
|---|
| 298 | ;; - construct a plain style comment |
|---|
| 299 | |
|---|
| 300 | (skip-chars-forward " " (+ (point) left-margin)) |
|---|
| 301 | (insert (make-string (- left-margin (current-column)) ? ) |
|---|
| 302 | "/* ") |
|---|
| 303 | (end-of-line) |
|---|
| 304 | (forward-char 1) |
|---|
| 305 | (while (not (eobp)) |
|---|
| 306 | (skip-chars-forward " " (+ (point) left-margin)) |
|---|
| 307 | (insert (make-string (- left-margin (current-column)) ? ) |
|---|
| 308 | " ") |
|---|
| 309 | (end-of-line) |
|---|
| 310 | (forward-char 1)) |
|---|
| 311 | (backward-char 1) |
|---|
| 312 | (insert " */")) |
|---|
| 313 | ((eq box-style 'single) |
|---|
| 314 | |
|---|
| 315 | ;; - construct a single line style comment |
|---|
| 316 | |
|---|
| 317 | (indent-to left-margin) |
|---|
| 318 | (insert "/*") |
|---|
| 319 | (insert (make-string (- right-margin (current-column)) ?-) |
|---|
| 320 | "-.\n") |
|---|
| 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 | (indent-to right-margin) |
|---|
| 327 | (insert " |") |
|---|
| 328 | (forward-char 1)) |
|---|
| 329 | (indent-to left-margin) |
|---|
| 330 | (insert "`") |
|---|
| 331 | (insert (make-string (- right-margin (current-column)) ?-) |
|---|
| 332 | "*/\n")) |
|---|
| 333 | ((eq box-style 'double) |
|---|
| 334 | |
|---|
| 335 | ;; - construct a double line style comment |
|---|
| 336 | |
|---|
| 337 | (indent-to left-margin) |
|---|
| 338 | (insert "/*") |
|---|
| 339 | (insert (make-string (- right-margin (current-column)) ?=) |
|---|
| 340 | "=\\\n") |
|---|
| 341 | (while (not (eobp)) |
|---|
| 342 | (skip-chars-forward " " (+ (point) left-margin)) |
|---|
| 343 | (insert (make-string (- left-margin (current-column)) ? ) |
|---|
| 344 | "| ") |
|---|
| 345 | (end-of-line) |
|---|
| 346 | (indent-to right-margin) |
|---|
| 347 | (insert " |") |
|---|
| 348 | (forward-char 1)) |
|---|
| 349 | (indent-to left-margin) |
|---|
| 350 | (insert "\\") |
|---|
| 351 | (insert (make-string (- right-margin (current-column)) ?=) |
|---|
| 352 | "*/\n")) |
|---|
| 353 | ((eq box-style 'taarna) |
|---|
| 354 | |
|---|
| 355 | ;; - construct a Taarna style comment |
|---|
| 356 | |
|---|
| 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 | (t (error "unknown box style"))) |
|---|
| 370 | |
|---|
| 371 | ;; Fifth, retabify, restore the point position, then cleanup the |
|---|
| 372 | ;; undo list of any boundary since we started. |
|---|
| 373 | |
|---|
| 374 | ;; - retabify before left margin only (adapted from tabify.el) |
|---|
| 375 | |
|---|
| 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)) |
|---|
| 381 | (indent-to column))) |
|---|
| 382 | |
|---|
| 383 | ;; - restore the point position |
|---|
| 384 | |
|---|
| 385 | (goto-char (marker-position marked-point)) |
|---|
| 386 | |
|---|
| 387 | ;; - remove all intermediate boundaries from the undo list |
|---|
| 388 | |
|---|
| 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)))))))))) |
|---|
| 395 | |
|---|
| 396 | ;;; Rebox a C comment without refilling it. |
|---|
| 397 | |
|---|
| 398 | (defun rebox-c-comment (flag) |
|---|
| 399 | (interactive "P") |
|---|
| 400 | (rebox-c-comment-engine flag nil)) |
|---|
| 401 | |
|---|
| 402 | ;;; Rebox a C comment after refilling. |
|---|
| 403 | |
|---|
| 404 | (defun reindent-c-comment (flag) |
|---|
| 405 | (interactive "P") |
|---|
| 406 | (rebox-c-comment-engine flag t)) |
|---|
