home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 7 / FreshFishVol7.bin / bbs / gnu / m4-1.2-src.lha / GNU / src / amiga / m4-1.2 / c-boxes.el < prev    next >
Lisp/Scheme  |  1994-06-23  |  11KB  |  362 lines
  1. ;;; Boxed comments for C mode.
  2. ;;; Copyright (C) 1991, 1992, 1993, 1994 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-comment-box-style 'single)
  43.     (message "C mode: GNU style"))
  44.  
  45.     (setq c-mode-taarna-style t)
  46.     (setq c-indent-level 4)
  47.     (setq c-continued-statement-offset 4)
  48.     (setq c-brace-offset -4)
  49.     (setq c-argdecl-indent 4)
  50.     (setq c-label-offset -4)
  51.     (setq c-tab-always-indent t)
  52.     (setq c-comment-box-style 'taarna)
  53.     (message "C mode: Taarna style")))
  54.  
  55. ;;; Return the minimum value of the left margin of all lines, or -1 if
  56. ;;; all lines are empty.
  57.  
  58. (defun buffer-left-margin ()
  59.   (let ((margin -1))
  60.     (goto-char (point-min))
  61.     (while (not (eobp))
  62.       (skip-chars-forward " \t")
  63.       (if (not (looking-at "\n"))
  64.       (setq margin
  65.         (if (< margin 0)
  66.             (current-column)
  67.           (min margin (current-column)))))
  68.       (forward-line 1))
  69.     margin))
  70.  
  71. ;;; Return the maximum value of the right margin of all lines.  Any
  72. ;;; sentence ending a line has a space guaranteed before the margin.
  73.  
  74. (defun buffer-right-margin ()
  75.   (let ((margin 0) period)
  76.     (goto-char (point-min))
  77.     (while (not (eobp))
  78.       (end-of-line)
  79.       (if (bobp)
  80.       (setq period 0)
  81.     (backward-char 1)
  82.     (setq period (if (looking-at "[.?!]") 1 0))
  83.     (forward-char 1))
  84.       (setq margin (max margin (+ (current-column) period)))
  85.       (forward-char 1))
  86.     margin))
  87.  
  88. ;;; Indent or reindent a C comment box.
  89.  
  90. (defun reindent-c-comment (flag)
  91.   (interactive "P")
  92.   (save-restriction
  93.     (let ((marked-point (point-marker))
  94.       (saved-point (point))
  95.       box-style left-margin right-margin)
  96.  
  97.       ;; First, find the limits of the block of comments following or
  98.       ;; enclosing the cursor, or return an error if the cursor is not
  99.       ;; within such a block of comments, narrow the buffer, and
  100.       ;; untabify it.
  101.  
  102.       ;; - insure the point is into the following comment, if any
  103.  
  104.       (skip-chars-forward " \t\n")
  105.       (if (looking-at "/\\*")
  106.       (forward-char 2))
  107.  
  108.       (let ((here (point)) start end temp)
  109.  
  110.     ;; - identify a minimal comment block
  111.  
  112.     (search-backward "/*")
  113.     (setq temp (point))
  114.     (beginning-of-line)
  115.     (setq start (point))
  116.     (skip-chars-forward " \t")
  117.     (if (< (point) temp)
  118.         (progn
  119.           (goto-char saved-point)
  120.           (error "text before comment's start")))
  121.     (search-forward "*/")
  122.     (setq temp (point))
  123.     (end-of-line)
  124.     (forward-char 1)
  125.     (setq end (point))
  126.     (skip-chars-backward " \t\n")
  127.     (if (> (point) temp)
  128.         (progn
  129.           (goto-char saved-point)
  130.           (error "text after comment's end")))
  131.     (if (< end here)
  132.         (progn
  133.           (goto-char saved-point)
  134.           (error "outside any comment block")))
  135.  
  136.     ;; - try to extend the comment block backwards
  137.  
  138.     (goto-char start)
  139.     (while (and (not (bobp))
  140.             (progn (previous-line 1)
  141.                (beginning-of-line)
  142.                (looking-at "[ \t]*/\\*.*\\*/[ \t]*$")))
  143.       (setq start (point)))
  144.  
  145.     ;; - try to extend the comment block forward
  146.  
  147.     (goto-char end)
  148.     (while (looking-at "[ \t]*/\\*.*\\*/[ \t]*$")
  149.       (forward-line 1)
  150.       (beginning-of-line)
  151.       (setq end (point)))
  152.  
  153.     ;; - narrow the whole block of comments
  154.  
  155.     (narrow-to-region start end))
  156.  
  157.       ;; Second, remove all the comment marks, and move all the text
  158.       ;; rigidly to the left to insure the left margin stays at the
  159.       ;; same place.  At the same time, recognize and save the box
  160.       ;; style in BOX-STYLE.
  161.  
  162.       (let ((previous-margin (buffer-left-margin))
  163.         actual-margin)
  164.  
  165.     ;; - remove all comment marks
  166.  
  167.     (goto-char (point-min))
  168.     (replace-regexp "\\*/[ \t]*/\\*" " ")
  169.     (goto-char (point-min))
  170.     (while (not (eobp))
  171.       (skip-chars-forward " \t")
  172.       (if (looking-at "/\\*")
  173.           (replace-match "  ")
  174.         (if (looking-at "|")
  175.         (replace-match " ")))
  176.       (end-of-line)
  177.       (skip-chars-backward " \t")
  178.       (backward-char 2)
  179.       (if (looking-at "\\*/")
  180.           (replace-match "")
  181.         (forward-char 1)
  182.         (if (looking-at "|")
  183.         (replace-match "")
  184.           (forward-char 1)))
  185.       (forward-line 1))
  186.  
  187.     ;; - remove the first and last dashed lines
  188.  
  189.     (setq box-style 'plain)
  190.     (goto-char (point-min))
  191.     (if (looking-at "^[ \t]*-*[.\+\\]?[ \t]*\n")
  192.         (progn
  193.           (setq box-style 'single)
  194.           (replace-match ""))
  195.       (if (looking-at "^[ \t]*=*[.\+\\]?[ \t]*\n")
  196.           (progn
  197.         (setq box-style 'double)
  198.         (replace-match ""))))
  199.     (goto-char (point-max))
  200.     (previous-line 1)
  201.     (beginning-of-line)
  202.     (if (looking-at "^[ \t]*[`\+\\]?*[-=]+[ \t]*\n")
  203.         (progn
  204.           (if (eq box-style 'plain)
  205.           (setq box-style 'taarna))
  206.           (replace-match "")))
  207.  
  208.     ;; - remove all spurious whitespace
  209.  
  210.     (goto-char (point-min))
  211.     (replace-regexp "[ \t]+$" "")
  212.     (goto-char (point-min))
  213.     (if (looking-at "\n+")
  214.         (replace-match ""))
  215.     (goto-char (point-max))
  216.     (skip-chars-backward "\n")
  217.     (if (looking-at "\n\n+")
  218.         (replace-match "\n"))
  219.     (goto-char (point-min))
  220.     (replace-regexp "\n\n\n+" "\n\n")
  221.  
  222.     ;; - move the text left is adequate
  223.  
  224.     (setq actual-margin (buffer-left-margin))
  225.     (if (not (= previous-margin actual-margin))
  226.         (indent-rigidly (point-min) (point-max)
  227.                 (- previous-margin actual-margin))))
  228.  
  229.       ;; Third, select the new box style from the old box style and
  230.       ;; the argument, choose the margins for this style and refill
  231.       ;; each paragraph.
  232.  
  233.       ;; - modify box-style only if flag is defined
  234.  
  235.       (if flag
  236.       (setq box-style
  237.         (cond ((eq flag '0) 'plain)
  238.               ((eq flag '1) 'single)
  239.               ((eq flag '2) 'double)
  240.               ((eq flag '3) 'taarna)
  241.               (c-mode-taarna-style 'taarna)
  242.               (t 'single))))
  243.  
  244.       ;; - compute the left margin
  245.  
  246.       (setq left-margin (buffer-left-margin))
  247.  
  248.       ;; - temporarily set the fill prefix and column, then refill
  249.  
  250.       (untabify (point-min) (point-max))
  251.       (let ((fill-prefix (make-string left-margin ? ))
  252.         (fill-column (- fill-column
  253.                 (if (memq box-style '(single double)) 4 6))))
  254.     (fill-region (point-min) (point-max)))
  255.  
  256.       ;; - compute the right margin after refill
  257.  
  258.       (setq right-margin (buffer-right-margin))
  259.  
  260.       ;; Fourth, put the narrowed buffer back into a comment box,
  261.       ;; according to the value of box-style.  Values may be:
  262.       ;;    plain: insert between a single pair of comment delimiters
  263.       ;;    single: complete box, overline and underline with dashes
  264.       ;;    double: complete box, overline and underline with equal signs
  265.       ;;    taarna: comment delimiters on each line, underline with dashes
  266.  
  267.       ;; - move the right margin to account for left inserts
  268.  
  269.       (setq right-margin (+ right-margin
  270.                 (if (memq box-style '(single double))
  271.                 2
  272.                   3)))
  273.  
  274.       ;; - construct the box comment, from top to bottom
  275.  
  276.       (goto-char (point-min))
  277.       (cond ((eq box-style 'plain)
  278.  
  279.          ;; - construct a plain style comment
  280.  
  281.          (skip-chars-forward " " (+ (point) left-margi