| [3090] | 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))
|
|---|
