423 lines
15 KiB
EmacsLisp
423 lines
15 KiB
EmacsLisp
;;; Boxed comments for C mode.
|
|
;;; Copyright (C) 1991-1994, 2008-2014, 2016-2017, 2020-2021 Free
|
|
;;; Software Foundation, Inc.
|
|
;;; François 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 <https://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))
|