diff options
Diffstat (limited to 'c-boxes.el')
| -rw-r--r-- | c-boxes.el | 421 |
1 files changed, 421 insertions, 0 deletions
diff --git a/c-boxes.el b/c-boxes.el new file mode 100644 index 0000000..ea96738 --- /dev/null +++ b/c-boxes.el @@ -0,0 +1,421 @@ +;;; Boxed comments for C mode. +;;; Copyright (C) 1991-1994, 2008-2013 Free Software Foundation, Inc. +;;; Francois Pinard <pinard@iro.umontreal.ca>, April 1991. +;;; +;;; This file is part of GNU M4. +;;; +;;; GNU M4 is free software: you can redistribute it and/or modify +;;; it under the terms of the GNU General Public License as published by +;;; the Free Software Foundation, either version 3 of the License, or +;;; (at your option) any later version. +;;; +;;; GNU M4 is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; I often refill paragraphs inside C comments, while stretching or +;;; shrinking the surrounding box as needed. This is a real pain to +;;; do by hand. Here is the code I made to ease my life on this, +;;; usable from within GNU Emacs. It would not be fair giving all +;;; sources for a product without also giving the means for nicely +;;; modifying them. +;;; +;;; The function rebox-c-comment adjust comment boxes without +;;; refilling comment paragraphs, while reindent-c-comment adjust +;;; comment boxes after refilling. Numeric prefixes are used to add, +;;; remove, or change the style of the box surrounding the comment. +;;; Since refilling paragraphs in C mode does make sense only for +;;; comments, this code redefines the M-q command in C mode. I use +;;; this hack by putting, in my .emacs file: +;;; +;;; (setq c-mode-hook +;;; '(lambda () +;;; (define-key c-mode-map "\M-q" 'reindent-c-comment))) +;;; (autoload 'rebox-c-comment "c-boxes" nil t) +;;; (autoload 'reindent-c-comment "c-boxes" nil t) +;;; +;;; The cursor should be within a comment before any of these +;;; commands, or else it should be between two comments, in which case +;;; the command applies to the next comment. When the command is +;;; given without prefix, the current comment box type is recognized +;;; and preserved. Given 0 as a prefix, the comment box disappears +;;; and the comment stays between a single opening `/*' and a single +;;; closing `*/'. Given 1 or 2 as a prefix, a single or doubled lined +;;; comment box is forced. Given 3 as a prefix, a Taarna style box is +;;; forced, but you do not even want to hear about those. When a +;;; negative prefix is given, the absolute value is used, but the +;;; default style is changed. Any other value (like C-u alone) forces +;;; the default box style. +;;; +;;; I observed rounded corners first in some code from Warren Tucker +;;; <wht@n4hgf.mt-park.ga.us>. + +(defvar c-box-default-style 'single "*Preferred style for box comments.") +(defvar c-mode-taarna-style nil "*Non-nil for Taarna team C-style.") + +;;; Set or reset the Taarna team's own way for a C style. + +(defun taarna-mode () + (interactive) + (if c-mode-taarna-style + (progn + + (setq c-mode-taarna-style nil) + (setq c-indent-level 2) + (setq c-continued-statement-offset 2) + (setq c-brace-offset 0) + (setq c-argdecl-indent 5) + (setq c-label-offset -2) + (setq c-tab-always-indent t) + (setq c-box-default-style 'single) + (message "C mode: GNU style")) + + (setq c-mode-taarna-style t) + (setq c-indent-level 4) + (setq c-continued-statement-offset 4) + (setq c-brace-offset -4) + (setq c-argdecl-indent 4) + (setq c-label-offset -4) + (setq c-tab-always-indent t) + (setq c-box-default-style 'taarna) + (message "C mode: Taarna style"))) + +;;; Return the minimum value of the left margin of all lines, or -1 if +;;; all lines are empty. + +(defun buffer-left-margin () + (let ((margin -1)) + (goto-char (point-min)) + (while (not (eobp)) + (skip-chars-forward " \t") + (if (not (looking-at "\n")) + (setq margin + (if (< margin 0) + (current-column) + (min margin (current-column))))) + (forward-line 1)) + margin)) + +;;; Return the maximum value of the right margin of all lines. Any +;;; sentence ending a line has a space guaranteed before the margin. + +(defun buffer-right-margin () + (let ((margin 0) period) + (goto-char (point-min)) + (while (not (eobp)) + (end-of-line) + (if (bobp) + (setq period 0) + (backward-char 1) + (setq period (if (looking-at "[.?!]") 1 0)) + (forward-char 1)) + (setq margin (max margin (+ (current-column) period))) + (forward-char 1)) + margin)) + +;;; Add, delete or adjust a C comment box. If FLAG is nil, the +;;; current boxing style is recognized and preserved. When 0, the box +;;; is removed; when 1, a single lined box is forced; when 2, a double +;;; lined box is forced; when 3, a Taarna style box is forced. If +;;; negative, the absolute value is used, but the default style is +;;; changed. For any other value (like C-u), the default style is +;;; forced. If REFILL is not nil, refill the comment paragraphs prior +;;; to reboxing. + +(defun rebox-c-comment-engine (flag refill) + (save-restriction + (let ((undo-list buffer-undo-list) + (marked-point (point-marker)) + (saved-point (point)) + box-style left-margin right-margin) + + ;; First, find the limits of the block of comments following or + ;; enclosing the cursor, or return an error if the cursor is not + ;; within such a block of comments, narrow the buffer, and + ;; untabify it. + + ;; - insure the point is into the following comment, if any + + (skip-chars-forward " \t\n") + (if (looking-at "/\\*") + (forward-char 2)) + + (let ((here (point)) start end temp) + + ;; - identify a minimal comment block + + (search-backward "/*") + (setq temp (point)) + (beginning-of-line) + (setq start (point)) + (skip-chars-forward " \t") + (if (< (point) temp) + (progn + (goto-char saved-point) + (error "text before comment's start"))) + (search-forward "*/") + (setq temp (point)) + (end-of-line) + (if (looking-at "\n") + (forward-char 1)) + (setq end (point)) + (skip-chars-backward " \t\n") + (if (> (point) temp) + (progn + (goto-char saved-point) + (error "text after comment's end"))) + (if (< end here) + (progn + (goto-char saved-point) + (error "outside any comment block"))) + + ;; - try to extend the comment block backwards + + (goto-char start) + (while (and (not (bobp)) + (progn (previous-line 1) + (beginning-of-line) + (looking-at "[ \t]*/\\*.*\\*/[ \t]*$"))) + (setq start (point))) + + ;; - try to extend the comment block forward + + (goto-char end) + (while (looking-at "[ \t]*/\\*.*\\*/[ \t]*$") + (forward-line 1) + (beginning-of-line) + (setq end (point))) + + ;; - narrow to the whole block of comments + + (narrow-to-region start end)) + + ;; Second, remove all the comment marks, and move all the text + ;; rigidly to the left to insure the left margin stays at the + ;; same place. At the same time, recognize and save the box + ;; style in BOX-STYLE. + + (let ((previous-margin (buffer-left-margin)) + actual-margin) + + ;; - remove all comment marks + + (goto-char (point-min)) + (replace-regexp "^\\([ \t]*\\)/\\*" "\\1 ") + (goto-char (point-min)) + (replace-regexp "^\\([ \t]*\\)|" "\\1 ") + (goto-char (point-min)) + (replace-regexp "\\(\\*/\\||\\)[ \t]*" "") + (goto-char (point-min)) + (replace-regexp "\\*/[ \t]*/\\*" " ") + + ;; - remove the first and last dashed lines + + (setq box-style 'plain) + (goto-char (point-min)) + (if (looking-at "^[ \t]*-*[.\+\\]?[ \t]*\n") + (progn + (setq box-style 'single) + (replace-match "")) + (if (looking-at "^[ \t]*=*[.\+\\]?[ \t]*\n") + (progn + (setq box-style 'double) + (replace-match "")))) + (goto-char (point-max)) + (previous-line 1) + (beginning-of-line) + (if (looking-at "^[ \t]*[`\+\\]?*[-=]+[ \t]*\n") + (progn + (if (eq box-style 'plain) + (setq box-style 'taarna)) + (replace-match ""))) + + ;; - remove all spurious whitespace + + (goto-char (point-min)) + (replace-regexp "[ \t]+$" "") + (goto-char (point-min)) + (if (looking-at "\n+") + (replace-match "")) + (goto-char (point-max)) + (skip-chars-backward "\n") + (if (looking-at "\n\n+") + (replace-match "\n")) + (goto-char (point-min)) + (replace-regexp "\n\n\n+" "\n\n") + + ;; - move the text left is adequate + + (setq actual-margin (buffer-left-margin)) + (if (not (= previous-margin actual-margin)) + (indent-rigidly (point-min) (point-max) + (- previous-margin actual-margin)))) + + ;; Third, select the new box style from the old box style and + ;; the argument, choose the margins for this style and refill + ;; each paragraph. + + ;; - modify box-style only if flag is defined + + (if flag + (setq box-style + (cond ((eq flag 0) 'plain) + ((eq flag 1) 'single) + ((eq flag 2) 'double) + ((eq flag 3) 'taarna) + ((eq flag '-) (setq c-box-default-style 'plain) 'plain) + ((eq flag -1) (setq c-box-default-style 'single) 'single) + ((eq flag -2) (setq c-box-default-style 'double) 'double) + ((eq flag -3) (setq c-box-default-style 'taarna) 'taarna) + (t c-box-default-style)))) + + ;; - compute the left margin + + (setq left-margin (buffer-left-margin)) + + ;; - temporarily set the fill prefix and column, then refill + + (untabify (point-min) (point-max)) + + (if refill + (let ((fill-prefix (make-string left-margin ? )) + (fill-column (- fill-column + (if (memq box-style '(single double)) 4 6)))) + (fill-region (point-min) (point-max)))) + + ;; - compute the right margin after refill + + (setq right-margin (buffer-right-margin)) + + ;; Fourth, put the narrowed buffer back into a comment box, + ;; according to the value of box-style. Values may be: + ;; plain: insert between a single pair of comment delimiters + ;; single: complete box, overline and underline with dashes + ;; double: complete box, overline and underline with equal signs + ;; taarna: comment delimiters on each line, underline with dashes + + ;; - move the right margin to account for left inserts + + (setq right-margin (+ right-margin + (if (memq box-style '(single double)) + 2 + 3))) + + ;; - construct the box comment, from top to bottom + + (goto-char (point-min)) + (cond ((eq box-style 'plain) + + ;; - construct a plain style comment + + (skip-chars-forward " " (+ (point) left-margin)) + (insert (make-string (- left-margin (current-column)) ? ) + "/* ") + (end-of-line) + (forward-char 1) + (while (not (eobp)) + (skip-chars-forward " " (+ (point) left-margin)) + (insert (make-string (- left-margin (current-column)) ? ) + " ") + (end-of-line) + (forward-char 1)) + (backward-char 1) + (insert " */")) + ((eq box-style 'single) + + ;; - construct a single line style comment + + (indent-to left-margin) + (insert "/*") + (insert (make-string (- right-margin (current-column)) ?-) + "-.\n") + (while (not (eobp)) + (skip-chars-forward " " (+ (point) left-margin)) + (insert (make-string (- left-margin (current-column)) ? ) + "| ") + (end-of-line) + (indent-to right-margin) + (insert " |") + (forward-char 1)) + (indent-to left-margin) + (insert "`") + (insert (make-string (- right-margin (current-column)) ?-) + "*/\n")) + ((eq box-style 'double) + + ;; - construct a double line style comment + + (indent-to left-margin) + (insert "/*") + (insert (make-string (- right-margin (current-column)) ?=) + "=\\\n") + (while (not (eobp)) + (skip-chars-forward " " (+ (point) left-margin)) + (insert (make-string (- left-margin (current-column)) ? ) + "| ") + (end-of-line) + (indent-to right-margin) + (insert " |") + (forward-char 1)) + (indent-to left-margin) + (insert "\\") + (insert (make-string (- right-margin (current-column)) ?=) + "*/\n")) + ((eq box-style 'taarna) + + ;; - construct a Taarna style comment + + (while (not (eobp)) + (skip-chars-forward " " (+ (point) left-margin)) + (insert (make-string (- left-margin (current-column)) ? ) + "/* ") + (end-of-line) + (indent-to right-margin) + (insert " */") + (forward-char 1)) + (indent-to left-margin) + (insert "/* ") + (insert (make-string (- right-margin (current-column)) ?-) + " */\n")) + (t (error "unknown box style"))) + + ;; Fifth, retabify, restore the point position, then cleanup the + ;; undo list of any boundary since we started. + + ;; - retabify before left margin only (adapted from tabify.el) + + (goto-char (point-min)) + (while (re-search-forward "^[ \t][ \t][ \t]*" nil t) + (let ((column (current-column)) + (indent-tabs-mode t)) + (delete-region (match-beginning 0) (point)) + (indent-to column))) + + ;; - restore the point position + + (goto-char (marker-position marked-point)) + + ;; - remove all intermediate boundaries from the undo list + + (if (not (eq buffer-undo-list undo-list)) + (let ((cursor buffer-undo-list)) + (while (not (eq (cdr cursor) undo-list)) + (if (car (cdr cursor)) + (setq cursor (cdr cursor)) + (rplacd cursor (cdr (cdr cursor)))))))))) + +;;; Rebox a C comment without refilling it. + +(defun rebox-c-comment (flag) + (interactive "P") + (rebox-c-comment-engine flag nil)) + +;;; Rebox a C comment after refilling. + +(defun reindent-c-comment (flag) + (interactive "P") + (rebox-c-comment-engine flag t)) |