home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 8 / FreshFishVol8-CD2.bin / bbs / gnu / sharutils-4.1-src.lha / sharutils-4.1 / c-boxes.el < prev    next >
Lisp/Scheme  |  1994-09-16  |  13KB  |  407 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 often refill paragraphs inside C comments, while stretching or
  6. ;;; shrinking the surrounding box as needed.  This is a real pain to
  7. ;;; do by hand.  Here is the code I made to ease my life on this,
  8. ;;; usable from within GNU Emacs.  It would not be fair giving all
  9. ;;; sources for a product without also giving the means for nicely
  10. ;;; modifying them.
  11. ;;;
  12. ;;; The function rebox-c-comment adjust comment boxes without
  13. ;;; refilling comment paragraphs, while reindent-c-comment adjust
  14. ;;; comment boxes after refilling.  Numeric prefixes are used to add,
  15. ;;; remove, or change the style of the box surrounding the comment.
  16. ;;; Since refilling paragraphs in C mode does make sense only for
  17. ;;; comments, this code redefines the M-q command in C mode.  I use
  18. ;;; this hack by putting, in my .emacs file:
  19. ;;;
  20. ;;;    (setq c-mode-hook
  21. ;;;          '(lambda ()
  22. ;;;         (define-key c-mode-map "\M-q" 'reindent-c-comment)))
  23. ;;;    (autoload 'rebox-c-comment "c-boxes" nil t)
  24. ;;;    (autoload 'reindent-c-comment "c-boxes" nil t)
  25. ;;;
  26. ;;; The cursor should be within a comment before any of these
  27. ;;; commands, or else it should be between two comments, in which case
  28. ;;; the command applies to the next comment.  When the command is
  29. ;;; given without prefix, the current comment box type is recognized
  30. ;;; and preserved.  Given 0 as a prefix, the comment box disappears
  31. ;;; and the comment stays between a single opening `/*' and a single
  32. ;;; closing `*/'.  Given 1 or 2 as a prefix, a single or doubled lined
  33. ;;; comment box is forced.  Given 3 as a prefix, a Taarna style box is
  34. ;;; forced, but you do not even want to hear about those.  When a
  35. ;;; negative prefix is given, the absolute value is used, but the
  36. ;;; default style is changed.  Any other value (like C-u alone) forces
  37. ;;; the default box style.
  38. ;;;
  39. ;;; I observed rounded corners first in some code from Warren Tucker
  40. ;;; <wht@n4hgf.mt-park.ga.us>.
  41.  
  42. (defvar c-box-default-style 'single "*Preferred style for box comments.")
  43. (defvar c-mode-taarna-style nil "*Non-nil for Taarna team C-style.")
  44.  
  45. ;;; Set or reset the Taarna team's own way for a C style.
  46.  
  47. (defun taarna-mode ()
  48.   (interactive)
  49.   (if c-mode-taarna-style
  50.       (progn
  51.  
  52.     (setq c-mode-taarna-style nil)
  53.     (setq c-indent-level 2)
  54.     (setq c-continued-statement-offset 2)
  55.     (setq c-brace-offset 0)
  56.     (setq c-argdecl-indent 5)
  57.     (setq c-label-offset -2)
  58.     (setq c-tab-always-indent t)
  59.     (setq c-box-default-style 'single)
  60.     (message "C mode: GNU style"))
  61.  
  62.     (setq c-mode-taarna-style t)
  63.     (setq c-indent-level 4)
  64.     (setq c-continued-statement-offset 4)
  65.     (setq c-brace-offset -4)
  66.     (setq c-argdecl-indent 4)
  67.     (setq c-label-offset -4)
  68.     (setq c-tab-always-indent t)
  69.     (setq c-box-default-style 'taarna)
  70.     (message "C mode: Taarna style")))
  71.  
  72. ;;; Return the minimum value of the left margin of all lines, or -1 if
  73. ;;; all lines are empty.
  74.  
  75. (defun buffer-left-margin ()
  76.   (let ((margin -1))
  77.     (goto-char (point-min))
  78.     (while (not (eobp))
  79.       (skip-chars-forward " \t")
  80.       (if (not (looking-at "\n"))
  81.       (setq margin
  82.         (if (< margin 0)
  83.             (current-column)
  84.           (min margin (current-column)))))
  85.       (forward-line 1))
  86.     margin))
  87.  
  88. ;;; Return the maximum value of the right margin of all lines.  Any
  89. ;;; sentence ending a line has a space guaranteed before the margin.
  90.  
  91. (defun buffer-right-margin ()
  92.   (let ((margin 0) period)
  93.     (goto-char (point-min))
  94.     (while (not (eobp))
  95.       (end-of-line)
  96.       (if (bobp)
  97.       (setq period 0)
  98.     (backward-char 1)
  99.     (setq period (if (looking-at "[.?!]") 1 0))
  100.     (forward-char 1))
  101.       (setq margin (max margin (+ (current-column) period)))
  102.       (forward-char 1))
  103.     margin))
  104.  
  105. ;;; Add, delete or adjust a C comment box.  If FLAG is nil, the
  106. ;;; current boxing style is recognized and preserved.  When 0, the box
  107. ;;; is removed; when 1, a single lined box is forced; when 2, a double
  108. ;;; lined box is forced; when 3, a Taarna style box is forced.  If
  109. ;;; negative, the absolute value is used, but the default style is
  110. ;;; changed.  For any other value (like C-u), the default style is
  111. ;;; forced.  If REFILL is not nil, refill the comment paragraphs prior
  112. ;;; to reboxing.
  113.  
  114. (defun rebox-c-comment-engine (flag refill)
  115.   (save-restriction
  116.     (let ((undo-list buffer-undo-list)
  117.       (marked-point (point-marker))
  118.       (saved-point (point))
  119.       box-style left-margin right-margin)
  120.  
  121.       ;; First, find the limits of the block of comments following or
  122.       ;; enclosing the cursor, or return an error if the cursor is not
  123.       ;; within such a block of comments, narrow the buffer, and
  124.       ;; untabify it.
  125.  
  126.       ;; - insure the point is into the following comment, if any
  127.  
  128.       (skip-chars-forward " \t\n")
  129.       (if (looking-at "/\\*")
  130.       (forward-char 2))
  131.  
  132.       (let ((here (point)) start end temp)
  133.  
  134.     ;; - identify a minimal comment block
  135.  
  136.     (search-backward "/*")
  137.     (setq temp (point))
  138.     (beginning-of-line)
  139.     (setq start (point))
  140.     (skip-chars-forward " \t")
  141.     (if (< (point) temp)
  142.         (progn
  143.           (goto-char saved-point)
  144.           (error "text before comment's start")))
  145.     (search-forward "*/")
  146.     (setq temp (point))
  147.     (end-of-line)
  148.     (if (looking-at "\n")
  149.         (forward-char 1))
  150.     (setq end (point))
  151.     (skip-chars-backward " \t\n")
  152.     (if (> (point) temp)
  153.         (progn
  154.           (goto-char saved-point)
  155.           (error "text after comment's end")))
  156.     (if (< end here)
  157.         (progn
  158.           (goto-char saved-point)
  159.           (error "outside any comment block")))
  160.  
  161.     ;; - try to extend the comment block backwards
  162.  
  163.     (goto-char start)
  164.     (while (and (not (bobp))
  165.             (progn (previous-line 1)
  166.                (beginning-of-line)
  167.                (looking-at "[ \t]*/\\*.*\\*/[ \t]*$")))
  168.       (setq start (point)))
  169.  
  170.     ;; - try to extend the comment block forward
  171.  
  172.     (goto-char end)
  173.     (while (looking-at "[ \t]*/\\*.*\\*/[ \t]*$")
  174.       (forward-line 1)
  175.       (beginning-of-line)
  176.       (setq end (point)))
  177.  
  178.     ;; - narrow to the whole block of comments
  179.  
  180.     (narrow-to-region start end))
  181.  
  182.       ;; Second, remove all the comment marks, and move all the text
  183.       ;; rigidly to the left to insure the left margin stays at the
  184.       ;; same place.  At the same time, recognize and save the box
  185.       ;; style in BOX-STYLE.
  186.  
  187.       (let ((previous-margin (buffer-left-margin))
  188.         actual-margin)
  189.  
  190.     ;; - remove all comment marks
  191.  
  192.     (goto-char (point-min))
  193.     (replace-regexp "^\\([ \t]*\\)/\\*" "\\1  ")
  194.     (goto-char (point-min))
  195.     (replace-regexp "^\\([ \t]*\\)|" "\\1 ")
  196.     (goto-char (point-min))
  197.     (replace-regexp "\\(\\*/\\||\\)[ \t]*" "")
  198.     (goto-char (point-min))
  199.     (replace-regexp "\\*/[ \t]*/\\*" " ")
  200.  
  201.     ;; - remove the first and last dashed lines
  202.  
  203.     (setq box-style 'plain)
  204.     (goto-char (point-min))
  205.     (if (looking-at "^[ \t]*-*[.\+\\]?[ \t]*\n")
  206.         (progn
  207.           (setq box-style 'single)
  208.           (replace-match ""))
  209.       (if (looking-at "^[ \t]*=*[.\+\\]?[ \t]*\n")
  210.           (progn
  211.         (setq box-style 'double)
  212.         (replace-match ""))))
  213.     (goto-char (point-max))
  214.     (previous-line 1)
  215.     (beginning-of-line)
  216.     (if (looking-at "^[ \t]*[`\+\\]?*[-=]+[ \t]*\n")
  217.         (progn
  218.           (if (eq box-style 'plain)
  219.           (setq box-style 'taarna))
  220.           (replace-match "")))
  221.  
  222.     ;; - remove all spurious whitespace
  223.  
  224.     (goto-char (point-min))
  225.     (replace-regexp "[ \t]+$" "")
  226.     (goto-char (point-min))
  227.     (if (looking-at "\n+")
  228.         (replace-match ""))
  229.     (goto-char (point-max))
  230.     (skip-chars-backward "\n")
  231.     (if (looking-at "\n\n+")
  232.         (replace-match "\n"))
  233.     (goto-char (point-min))
  234.     (replace-regexp "\n\n\n+" "\n\n")
  235.  
  236.     ;; - move the text left is adequate
  237.  
  238.     (setq actual-margin (buffer-left-margin))
  239.     (if (not (= previous-margin actual-margin))
  240.         (indent-rigidly (point-min) (point-max)
  241.                 (- previous-margin actual-margin))))
  242.  
  243.       ;; Third, select the new box style from the old box style and
  244.       ;; the argument, choose the margins for this style and refill
  245.       ;; each paragraph.
  246.  
  247.       ;; - modify box-style only if flag is defined
  248.  
  249.       (if flag
  250.       (setq box-style
  251.         (cond ((eq flag 0) 'plain)
  252.               ((eq flag 1) 'single)
  253.               ((eq flag 2) 'double)
  254.               ((eq flag 3) 'taarna)
  255.               ((eq flag '-) (setq c-box-default-style 'plain) 'plain)
  256.