home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 4 / FreshFish_May-June1994.bin / bbs / gnu / m4-1.1-src.lha / src / amiga / m4-1.1 / c-boxes.el < prev    next >
Encoding:
Text File  |  1993-05-07  |  10.5 KB  |  364 lines
  1. ;;; Boxed comments for C mode.
  2. ;;; Copyright (C) 1991, 1992, 1993 Free Software Foundation, Inc.
  3. ;;; Francois Pinard <pinard@iro.umontreal.ca>, April 1991.
  4. ;;;
  5. ;;; I use this hack by putting, in my .emacs file:
  6. ;;;
  7. ;;;    (setq c-mode-hook
  8. ;;;          '(lambda ()
  9. ;;;         (define-key c-mode-map "\M-q" 'reindent-c-comment)))
  10. ;;;    (autoload 'reindent-c-comment "c-boxes" nil t)
  11. ;;;
  12. ;;; The cursor should be within a comment before reindent-c-comment to
  13. ;;; be given, or else it should be between two comments, in which case
  14. ;;; the command applies to the next comment.  When the command is
  15. ;;; given without prefix, the current comment box type is recognized
  16. ;;; and preserved.  Given 0 as a prefix, the comment box disappears
  17. ;;; and the comment stays between a single opening `/*' and a single
  18. ;;; closing `*/'.  Given 1 or 2 as a prefix, a single or doubled lined
  19. ;;; comment box is forced.  Given 3 as a prefix, a Taarna style box is
  20. ;;; forced, but you do not even want to hear about those.
  21. ;;;
  22. ;;; I observed rounded corners first in some code from Warren Tucker
  23. ;;; <wht@n4hgf.Mt-Park.GA.US>.
  24.  
  25. (defvar c-mode-taarna-style nil "*Non-nil for Taarna team C-style.")
  26. (defvar c-comment-box-style 'single "*Preferred style for box comments.")
  27.  
  28. ;;; Set or reset the Taarna team C mode style.
  29.  
  30. (defun taarna-mode ()
  31.   (interactive)
  32.   (if c-mode-taarna-style
  33.       (progn
  34.  
  35.     (setq c-mode-taarna-style nil)
  36.     (setq c-indent-level 2)
  37.     (setq c-continued-statement-offset 2)
  38.     (setq c-brace-offset 0)
  39.     (setq c-argdecl-indent 5)
  40.     (setq c-label-offset -2)
  41.     (setq c-tab-always-indent t)
  42.     (setq c-auto-newline nil)
  43.     (setq c-comment-box-style 'single)
  44.     (message "C mode: GNU style"))
  45.  
  46.     (setq c-mode-taarna-style t)
  47.     (setq c-indent-level 4)
  48.     (setq c-continued-statement-offset 4)
  49.     (setq c-brace-offset -4)
  50.     (setq c-argdecl-indent 4)
  51.     (setq c-label-offset -4)
  52.     (setq c-tab-always-indent t)
  53.     (setq c-auto-newline t)
  54.     (setq c-comment-box-style 'taarna)
  55.     (message "C mode: Taarna style")))
  56.  
  57. ;;; Return the minimum value of the left margin of all lines, or -1 if
  58. ;;; all lines are empty.
  59.  
  60. (defun buffer-left-margin ()
  61.   (let ((margin -1))
  62.     (goto-char (point-min))
  63.     (while (not (eobp))
  64.       (skip-chars-forward " \t")
  65.       (if (not (looking-at "\n"))
  66.       (setq margin
  67.         (if (< margin 0)
  68.             (current-column)
  69.           (min margin (current-column)))))
  70.       (forward-line 1))
  71.     margin))
  72.  
  73. ;;; Return the maximum value of the right margin of all lines.  Any
  74. ;;; sentence ending a line has a space guaranteed before the margin.
  75.  
  76. (defun buffer-right-margin ()
  77.   (let ((margin 0) period)
  78.     (goto-char (point-min))
  79.     (while (not (eobp))
  80.       (end-of-line)
  81.       (if (bobp)
  82.       (setq period 0)
  83.     (backward-char 1)
  84.     (setq period (if (looking-at "[.?!]") 1 0))
  85.     (forward-char 1))
  86.       (setq margin (max margin (+ (current-column) period)))
  87.       (forward-char 1))
  88.     margin))
  89.  
  90. ;;; Indent or reindent a C comment box.
  91.  
  92. (defun reindent-c-comment (flag)
  93.   (interactive "P")
  94.   (save-restriction
  95.     (let ((marked-point (point-marker))
  96.       (saved-point (point))
  97.       box-style left-margin right-margin)
  98.  
  99.       ;; First, find the limits of the block of comments following or
  100.       ;; enclosing the cursor, or return an error if the cursor is not
  101.       ;; within such a block of comments, narrow the buffer, and
  102.       ;; untabify it.
  103.  
  104.       ;; - insure the point is into the following comment, if any
  105.  
  106.       (skip-chars-forward " \t\n")
  107.       (if (looking-at "/\\*")
  108.       (forward-char 2))
  109.  
  110.       (let ((here (point)) start end temp)
  111.  
  112.     ;; - identify a minimal comment block
  113.  
  114.     (search-backward "/*")
  115.     (setq temp (point))
  116.     (beginning-of-line)
  117.     (setq start (point))
  118.     (skip-chars-forward " \t")
  119.     (if (< (point) temp)
  120.         (progn
  121.           (goto-char saved-point)
  122.           (error "text before comment's start")))
  123.     (search-forward "*/")
  124.     (setq temp (point))
  125.     (end-of-line)
  126.     (forward-char 1)
  127.     (setq end (point))
  128.     (skip-chars-backward " \t\n")
  129.     (if (> (point) temp)
  130.         (progn
  131.           (goto-char saved-point)
  132.           (error "text after comment's end")))
  133.     (if (< end here)
  134.         (progn
  135.           (goto-char saved-point)
  136.           (error "outside any comment block")))
  137.  
  138.     ;; - try to extend the comment block backwards
  139.  
  140.     (goto-char start)
  141.     (while (and (not (bobp))
  142.             (progn (previous-line 1)
  143.                (beginning-of-line)
  144.                (looking-at "[ \t]*/\\*.*\\*/[ \t]*$")))
  145.       (setq start (point)))
  146.  
  147.     ;; - try to extend the comment block forward
  148.  
  149.     (goto-char end)
  150.     (while (looking-at "[ \t]*/\\*.*\\*/[ \t]*$")
  151.       (forward-line 1)
  152.       (beginning-of-line)
  153.       (setq end (point)))
  154.  
  155.     ;; - narrow the whole block of comments
  156.  
  157.     (narrow-to-region start end))
  158.  
  159.       ;; Second, remove all the comment marks, and move all the text
  160.       ;; rigidly to the left to insure the left margin stays at the
  161.       ;; same place.  At the same time, recognize and save the box
  162.       ;; style in BOX-STYLE.
  163.  
  164.       (let ((previous-margin (buffer-left-margin))
  165.         actual-margin)
  166.  
  167.     ;; - remove all comment marks
  168.  
  169.     (goto-char (point-min))
  170.     (replace-regexp "\\*/[ \t]*/\\*" " ")
  171.     (goto-char (point-min))
  172.     (while (not (eobp))
  173.       (skip-chars-forward " \t")
  174.       (if (looking-at "/\\*")
  175.           (replace-match "  ")
  176.         (if (looking-at "|")
  177.         (replace-match " ")))
  178.       (end-of-line)
  179.       (skip-chars-backward " \t")
  180.       (backward-char 2)
  181.       (if (looking-at "\\*/")
  182.           (replace-match "")
  183.         (forward-char 1)
  184.         (if (looking-at "|")
  185.         (replace-match "")
  186.           (forward-char 1)))
  187.       (forward-line 1))
  188.  
  189.     ;; - remove the first and last dashed lines
  190.  
  191.     (setq box-style 'plain)
  192.     (goto-char (point-min))
  193.     (if (looking-at "^[ \t]*-*[.\+\\]?[ \t]*\n")
  194.         (progn
  195.           (setq box-style 'single)
  196.           (replace-match ""))
  197.       (if (looking-at "^[ \t]*=*[.\+\\]?[ \t]*\n")
  198.           (progn
  199.         (setq box-style 'double)
  200.         (replace-match ""))))
  201.     (goto-char (point-max))
  202.     (previous-line 1)
  203.     (beginning-of-line)
  204.     (if (looking-at "^[ \t]*[`\+\\]?*[-=]+[ \t]*\n")
  205.         (progn
  206.           (if (eq box-style 'plain)
  207.           (setq box-style 'taarna))
  208.           (replace-match "")))
  209.  
  210.     ;; - remove all spurious whitespace
  211.  
  212.     (goto-char (point-min))
  213.     (replace-regexp "[ \t]+$" "")
  214.     (goto-char (point-min))
  215.     (if (looking-at "\n+")
  216.         (replace-match ""))
  217.     (goto-char (point-max))
  218.     (skip-chars-backward "\n")
  219.     (if (looking-at "\n\n+")
  220.         (replace-match "\n"))
  221.     (goto-char (point-min))
  222.     (replace-regexp "\n\n\n+" "\n\n")
  223.  
  224.     ;; - move the text left is adequate
  225.  
  226.     (setq actual-margin (buffer-left-margin))
  227.     (if (not (= previous-margin actual-margin))
  228.         (indent-rigidly (point-min) (point-max)
  229.                 (- previous-margin actual-margin))))
  230.  
  231.       ;; Third, select the new box style from the old box style and
  232.       ;; the argument, choose the margins for this style and refill
  233.       ;; each paragraph.
  234.  
  235.       ;; - modify box-style only if flag is defined
  236.  
  237.       (if flag
  238.       (setq box-style
  239.         (cond ((eq flag '0) 'plain)
  240.               ((eq flag '1) 'single)
  241.               ((eq flag '2) 'double)
  242.               ((eq flag '3) 'taarna)
  243.               (c-mode-taarna-style 'taarna)
  244.               (t 'single))))
  245.  
  246.       ;; - compute the left margin
  247.  
  248.       (setq left-margin (buffer-left-margin))
  249.  
  250.       ;; - temporarily set the fill prefix and column, then refill
  251.  
  252.       (untabify (point-min) (point-max))
  253.       (let ((fill-prefix (make-string left-margin ? ))
  254.         (fill-column (- fill-column
  255.                 (if (memq box-style '(single double)) 4 6))))
  256.     (fill-region (point-min) (point-max)))
  257.  
  258.       ;; - compute the right margin after refill
  259.  
  260.       (setq right-margin (buffer-right-margin))
  261.  
  262.       ;; Fourth, put the narrowed buffer back into a comment box,
  263.       ;; according to the value of box-style.  Values may be:
  264.       ;;    plain: insert between a single pair of comment delimiters
  265.       ;;    single: complete box, overline and underline with dashes
  266.       ;;    double: complete box, overline and underline with equal signs
  267.       ;;    taarna: comment delimiters on each line, underline with dashes
  268.  
  269.       ;; - move the right margin to account for left inserts
  270.  
  271.       (setq right-margin (+ right-margin
  272.                 (if (memq box-style '(single double))
  273.                 2
  274.                   3)))
  275.  
  276.       ;; - construct the box comment, from top to bottom
  277.  
  278.       (goto-char (point-min))
  279.       (cond ((eq box-style 'plain)
  280.  
  281.          ;; - construct a plain style comment
  282.  
  283.          (skip-chars-forward " " (+ (point) left-margin))
  284.          (insert (make-string (- left-margin (current-column)) ? )
  285.              "/* ")
  286.          (end-of-line)
  287.          (forward-char 1)
  288.          (while (not (eobp))
  289.            (skip-chars-forward " " (+ (point) left-margin))
  290.            (insert (make-string (- left-margin (current-column)) ? )
  291.                "   ")
  292.            (end-of-line)
  293.            (forward-char 1))
  294.          (backward-char 1)
  295.          (insert "  */"))
  296.         ((eq box-style 'single)
  297.  
  298.          ;; - construct a single line style comment
  299.  
  300.          (indent-to left-margin)
  301.          (insert "/*")
  302.          (insert (make-string (- right-margin (current-column)) ?-)
  303.              "-.\n")
  304.          (while (not (eobp))
  305.            (skip-chars-forward " " (+ (point) left-margin))
  306.            (insert (make-string (- left-margin (current-column)) ? )
  307.                "| ")
  308.            (end-of-line)
  309.            (indent-to right-margin)
  310.            (insert " |")
  311.            (forward-char 1))
  312.          (indent-to left-margin)
  313.          (insert "`")
  314.          (insert (make-string (- right-margin (current-column)) ?-)
  315.              "*/\n"))
  316.         ((eq box-style 'double)
  317.  
  318.          ;; - construct a double line style comment
  319.  
  320.          (indent-to left-margin)
  321.          (insert "/*")
  322.          (insert (make-string (- right-margin (current-column)) ?=)
  323.              "=\\\n")
  324.          (while (not (eobp))
  325.            (skip-chars-forward " " (+ (point) left-margin))
  326.            (insert (make-string (- left-margin (current-column)) ? )
  327.                "| ")
  328.            (end-of-line)
  329.            (indent-to right-margin)
  330.            (insert " |")
  331.            (forward-char 1))
  332.          (indent-to left-margin)
  333.          (insert "\\")
  334.          (insert (make-string (- right-margin (current-column)) ?=)
  335.              "*/\n"))
  336.         ((eq box-style 'taarna)
  337.  
  338.          ;; - construct a Taarna style comment
  339.  
  340.          (while (not (eobp))
  341.            (skip-chars-forward " " (+ (point) left-margin))
  342.            (insert (make-string (- left-margin (current-column)) ? )
  343.                "/* ")
  344.            (end-of-line)
  345.            (indent-to right-margin)
  346.            (insert " */")
  347.            (forward-char 1))
  348.          (indent-to left-margin)
  349.          (insert "/* ")
  350.          (insert (make-string (- right-margin (current-column)) ?-)
  351.              " */\n"))
  352.         (t (error "unknown box style")))
  353.  
  354.       ;; Fifth, retabify and restore the point position.
  355.  
  356.       ; Retabify before left margin only.  Adapted from tabify.el.
  357.       (goto-char (point-min))
  358.       (while (re-search-forward "^[ \t][ \t][ \t]*" nil t)
  359.     (let ((column (current-column))
  360.           (indent-tabs-mode t))
  361.       (delete-region (match-beginning 0) (point))
  362.       (indent-to column)))
  363.       (goto-char (marker-position marked-point)))))
  364.