cgit.sxemacs.org Git - packages/blob - xemacs-packages/c-support/c-comment-edit.el

   1 ;; c-comment-edit.el --- edit C comments
   2 ;; Copyright (C) 1987, 1988, 1989, 1998 Kyle E. Jones
   3
   4 ;; Author: Kyle Jones <kyle_jones@wonderworks.com>
   5 ;; Maintainer: Kyle Jones <kyle_jones@wonderworks.com>
   6 ;; Keywords: languages
   7
   8 ;; This program is free software; you can redistribute it and/or modify
   9 ;; it under the terms of the GNU General Public License as published by
  10 ;; the Free Software Foundation; either version 1, or (at your option)
  11 ;; any later version.
  12 ;;
  13 ;; This program is distributed in the hope that it will be useful,
  14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 ;; GNU General Public License for more details.
  17 ;;
  18 ;; A copy of the GNU General Public License can be obtained from this
  19 ;; program's author (send electronic mail to kyle_jones@wonderworks.com)
  20 ;; or from the Free Software Foundation, Inc., 675 Mass Ave, Cambridge,
  21 ;; MA 02139, USA.
  22
  23 ;;; Synched up with: Not in FSF.
  24
  25 ;;; Commentary:
  26
  27 ;; Send bug reports to kyle_jones@wonderworks.com
  28
  29 ;; The command c-comment-edit is the entry point for this library.
  30
  31 (provide 'c-comment-edit)
  32
  33 (defvar c-comment-edit-version "1.02"
  34   "Version number for the C Comment Edit package.")
  35
  36 (defvar c-comment-edit-map
  37   (let ((map (make-sparse-keymap)))
  38     (define-key map "\C-c\e" 'c-comment-edit-end)
  39     (define-key map "\C-c\C-c" 'c-comment-edit-end)
  40     (define-key map "\C-c\C-]" 'c-comment-edit-abort)
  41     map )
  42   "Keymap for c-comment-edit buffers")
  43
  44 (defvar c-comment-leader " *"
  45   "*Leader used when rebuilding edited C comments.  The value of this variable
  46 should be a two-character string.  Values of \"  \", \" *\" and \"**\" produce
  47 the comment styles:
  48         /*      /*      /*
  49           ...    * ...  ** ...
  50           ...    * ...  ** ...
  51         */       */     */
  52 respectively.")
  53
  54 (defconst c-comment-leader-regexp "^[   ]*\\(\\*\\*\\|\\*\\)?[ ]?"
  55   "Regexp used to match C comment leaders.")
  56
  57 (defvar c-comment-edit-mode 'text-mode
  58   "*Major mode used by `c-comment-edit' when editing C comments.")
  59
  60 (defvar c-comment-edit-hook nil
  61   "*Function to call whenever `c-comment-edit' is used.
  62 The function is called just before the `c-comment-edit' function allows you to
  63 begin editing the comment.")
  64
  65 (defvar c-comment-edit-buffer-alist nil
  66   "Assoc list of C buffers and their associated comment buffers.
  67 Elements are of the form (C-BUFFER COMMENT-BUFFER COMMENT-START COMMENT-END)
  68 COMMENT-START and COMMENT-END are markers in the C-BUFFER.")
  69 \f
  70 (defmacro save-point (&rest body)
  71   "Save value of point, evaluates FORMS and restore value of point.
  72 If the saved value of point is no longer valid go to (point-max).
  73 The variable `save-point' is lambda-bound to the value of point for
  74 the duration of this call."
  75   (list 'let '((save-point (point)))
  76         (list 'unwind-protect
  77               (cons 'progn body)
  78               '(goto-char (min (point-max) save-point)))))
  79
  80 (defmacro marker (pos &optional buffer)
  81   (list 'set-marker '(make-marker) pos buffer))
  82 \f
  83 ;;;###autoload
  84 (defun c-comment-edit (search-prefix)
  85   "Edit multi-line C comments.
  86 This command allows the easy editing of a multi-line C comment like this:
  87    /*
  88     * ...
  89     * ...
  90     */
  91 The comment may be indented or flush with the left margin.
  92
  93 If point is within a comment, that comment is used.  Otherwise the
  94 comment to be edited is found by searching forward from point.
  95
  96 With one \\[universal-argument] searching starts after moving back one
  97   paragraph.
  98 With two \\[universal-argument]'s searching starts at the beginning of the
  99   current or proceeding C function.
 100 With three \\[universal-argument]'s searching starts at the beginning of the
 101   current page.
 102 With four \\[universal-argument]'s searching starts at the beginning of the
 103   current buffer (clipping restrictions apply).
 104
 105 Once located, the comment is copied into a temporary buffer, the comment
 106 leaders and delimiters are stripped away and the resulting buffer is
 107 selected for editing.  The major mode of this buffer is controlled by
 108 the variable `c-comment-edit-mode'.\\<c-comment-edit-map>
 109
 110 Use \\[c-comment-edit-end] when you have finished editing the comment.  The
 111 comment will be inserted into the original buffer with the appropriate
 112 delimiters and indention, replacing the old version of the comment.  If
 113 you don't want your edited version of the comment to replace the
 114 original, use \\[c-comment-edit-abort]."
 115   (interactive "*P")
 116   (let ((c-buffer (current-buffer))
 117         marker tem c-comment-fill-column c-comment-buffer
 118         c-comment-start c-comment-end
 119         (inhibit-quit t))
 120     ;; honor search-prefix
 121     (cond ((equal search-prefix '(4))
 122            (backward-paragraph))
 123           ((equal search-prefix '(16))
 124            (end-of-defun)
 125            (beginning-of-defun)
 126            (backward-paragraph))
 127           ((equal search-prefix '(64))
 128            (backward-page))
 129           ((equal search-prefix '(256))
 130            (goto-char (point-min))))
 131     (if (and (null search-prefix) (setq tem (within-c-comment-p)))
 132         (setq c-comment-start (marker (car tem))
 133               c-comment-end (marker (cdr tem)))
 134       (let (start end)
 135         (condition-case error-data
 136             (save-point
 137               (search-forward "/*")
 138               (setq start (- (point) 2))
 139               (search-forward "*/")
 140               (setq end (point)))
 141           (search-failed (error "No C comment found.")))
 142         (setq c-comment-start (marker start))
 143         (setq c-comment-end (marker end))))
 144     ;; calculate the correct fill-column for the comment
 145     (setq c-comment-fill-column (- fill-column 3
 146                                    (save-excursion
 147                                      (goto-char c-comment-start)
 148                                      (current-column))))
 149     ;; create the comment buffer
 150     (setq c-comment-buffer
 151           (generate-new-buffer (concat (buffer-name) " *C Comment Edit*")))
 152     ;; link into the c-comment-edit-buffer-alist
 153     (setq c-comment-edit-buffer-alist
 154           (cons (list (current-buffer) c-comment-buffer
 155                       c-comment-start c-comment-end)
 156                 c-comment-edit-buffer-alist))
 157     ;; copy to the comment to the comment-edit buffer
 158     (copy-to-buffer c-comment-buffer (+ c-comment-start 2) (- c-comment-end 2))
 159     ;; mark the position of point, relative to the beginning of the
 160     ;; comment, in the comment buffer.  (iff point is within a comment.)
 161     (or search-prefix (< (point) c-comment-start)
 162         (setq marker (marker (+ (- (point) c-comment-start 2) 1)
 163                              c-comment-buffer)))
 164     ;; select the comment buffer for editing
 165     (switch-to-buffer c-comment-buffer)
 166     ;; remove the comment leaders and delimiters
 167     (goto-char (point-min))
 168     (while (not (eobp))
 169       (and (re-search-forward c-comment-leader-regexp nil t)
 170            (replace-match "" nil t))
 171       (forward-line))
 172     ;; run appropriate major mode
 173     (funcall (or c-comment-edit-mode 'fundamental-mode))
 174     ;; override user's default fill-column here since it will lose if
 175     ;; the comment is indented in the C buffer.
 176     (setq fill-column c-comment-fill-column)
 177     ;; delete one leading whitespace char
 178     (goto-char (point-min))
 179     (if (looking-at "[ \n\t]")
 180         (delete-char 1))
 181     ;; restore cursor if possible
 182     (goto-char (or marker (point-min)))
 183     (if (fboundp 'set-keymap-parents)
 184         (set-keymap-parents c-comment-edit-map (list (current-local-map))))
 185     (use-local-map c-comment-edit-map)
 186     (set-buffer-modified-p nil))
 187   ;; run user hook, if present.
 188   (if c-comment-edit-hook
 189       (funcall c-comment-edit-hook))
 190   ;; final admonition
 191   (message
 192    (substitute-command-keys
 193     "Type \\[c-comment-edit-end] to end edit, \\[c-comment-edit-abort] to abort with no change.")))
 194
 195 (defun c-comment-edit-end ()
 196   "End c-comment-edit.
 197 C comment is replaced by its edited counterpart in the appropriate C buffer.
 198 Indentation will be the same as the original."
 199   (interactive)
 200   (let ((tuple (find-c-comment-buffer)))
 201     (if (null tuple)
 202         (error "Not a c-comment-edit buffer."))
 203     (let ((inhibit-quit t)
 204           (c-comment-c-buffer (car tuple))
 205           (c-comment-buffer (nth 1 tuple))
 206           (c-comment-start (nth 2 tuple))
 207           (c-comment-end (nth 3 tuple)))
 208       (cond
 209        ((buffer-modified-p)
 210         ;; rebuild the comment
 211         (goto-char (point-min))
 212         (insert "/*\n")
 213         (if (string= c-comment-leader "  ")
 214             (while (not (eobp))
 215               (if (not (eolp))
 216                   (insert c-comment-leader " "))
 217               (forward-line))
 218           (while (not (eobp))
 219             (insert c-comment-leader (if (eolp) "" " "))
 220             (forward-line)))
 221         (if (not (char-equal (preceding-char) ?\n))
 222             (insert "\n"))
 223         (insert (if (string= c-comment-leader " *") " */" "*/"))
 224         ;; indent if necessary
 225         (let ((indention
 226                (save-excursion
 227                  (set-buffer c-comment-c-buffer)
 228                  (goto-char c-comment-start)
 229                  (current-column))))
 230           (goto-char (point-min))
 231           (cond ((not (zerop indention))
 232                  ;; first line is already indented
 233                  ;; in the C buffer
 234                  (forward-line)
 235                  (while (not (eobp))
 236                    (indent-to indention)
 237                    (forward-line)))))
 238         ;; replace the old comment with the new
 239         (save-excursion
 240           (set-buffer c-comment-c-buffer)
 241           (save-point
 242             (save-excursion
 243               (delete-region c-comment-start c-comment-end)
 244               (goto-char c-comment-start)
 245               (set-buffer c-comment-buffer)
 246               (append-to-buffer c-comment-c-buffer
 247                                 (point-min) (point-max))))))
 248        (t (message "No change.")))
 249       ;; switch to the C buffer
 250       (if (get-buffer-window c-comment-c-buffer)
 251           (select-window (get-buffer-window c-comment-c-buffer))
 252         (switch-to-buffer c-comment-c-buffer))
 253       ;; delete the window viewing the comment buffer
 254       (and (get-buffer-window c-comment-buffer)
 255            (delete-window (get-buffer-window c-comment-buffer)))
 256       ;; unlink the tuple from c-comment-edit-buffer-alist
 257       (setq c-comment-edit-buffer-alist
 258             (delq tuple c-comment-edit-buffer-alist))
 259       ;; let Emacs reclaim various resources
 260       (save-excursion
 261         (set-buffer c-comment-buffer)
 262         (set-buffer-modified-p nil)
 263         (kill-buffer c-comment-buffer))
 264       (set-marker c-comment-start nil)
 265       (set-marker c-comment-end nil))))
 266
 267 (defun c-comment-edit-abort ()
 268   "Abort a c-comment-edit with no change."
 269   (interactive)
 270   (let* ((tuple (find-c-comment-buffer))
 271          (c-comment-c-buffer (car tuple))
 272          (c-comment-buffer (nth 1 tuple))
 273          (c-comment-start (nth 2 tuple))
 274          (c-comment-end (nth 3 tuple)))
 275     (if (null tuple)
 276         (error "Not a c-comment-edit buffer."))
 277     ;; switch to the C buffer
 278     (if (get-buffer-window c-comment-c-buffer)
 279         (select-window (get-buffer-window c-comment-c-buffer))
 280       (switch-to-buffer c-comment-c-buffer))
 281     (let ((inhibit-quit t))
 282       (save-excursion
 283         (set-buffer c-comment-buffer)
 284         (set-buffer-modified-p nil)
 285         (kill-buffer c-comment-buffer))
 286       ;; unlink the tuple from c-comment-edit-buffer-alist
 287       (setq c-comment-edit-buffer-alist
 288             (delq tuple c-comment-edit-buffer-alist))
 289       (set-marker c-comment-start nil)
 290       (set-marker c-comment-end nil)
 291       (message "Aborted with no change."))))
 292 \f
 293 ;; this loses on /* /* */ but doing it right would be grim.
 294 (defun within-c-comment-p ()
 295   (condition-case error-data
 296       (let (start end)
 297         (save-point
 298           (search-backward "/*")
 299           (setq start (point))
 300           (search-forward "*/")
 301           (setq end (point)))
 302         (if (< (point) end) (cons start end) nil))
 303     (search-failed nil)))
 304
 305 (defun find-c-comment-buffer (&optional buffer)
 306   (or buffer (setq buffer (current-buffer)))
 307   (let ((list c-comment-edit-buffer-alist))
 308     (catch 'return-value
 309       (while list
 310         (if (eq (nth 1 (car list)) buffer)
 311             (throw 'return-value (car list))
 312           (setq list (cdr list)))))))
 313
 314 (defun find-c-comment-c-buffer (&optional buffer)
 315   (or buffer (setq buffer (current-buffer)))
 316   (let ((list c-comment-edit-buffer-alist))
 317     (catch 'return-value
 318       (while list
 319         (if (eq (car (car list)) buffer)
 320             (throw 'return-value (car list))
 321           (setq list (cdr list)))))))
 322
 323 ;; c-comment.el ends here