diff options
Diffstat (limited to 'custom/c-boxes.el')
| -rw-r--r-- | custom/c-boxes.el | 407 |
1 files changed, 0 insertions, 407 deletions
diff --git a/custom/c-boxes.el b/custom/c-boxes.el deleted file mode 100644 index 273b783ab..000000000 --- a/custom/c-boxes.el +++ /dev/null @@ -1,407 +0,0 @@ -;;; Boxed comments for C mode. -;;; Copyright (C) 1991, 1992, 1993, 1994 Free Software Foundation, Inc. -;;; Francois Pinard <pinard@iro.umontreal.ca>, April 1991. -;;; -;;; 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)) - |