c-boxes.el

   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))