lisp/newcomment.el

   1 ;;; newcomment.el --- (un)comment regions of buffers
   2
   3 ;; Copyright (C) 1999  Stefan Monnier <monnier@cs.yale.edu>
   4
   5 ;; Author: Stefan Monnier <monnier@cs.yale.edu>
   6 ;; Keywords: comment uncomment
   7 ;; Version: $Name:  $
   8 ;; Revision: $Id: newcomment.el,v 1.4 1999/11/29 01:31:47 monnier Exp $
   9
  10 ;; This program is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2 of the License, or
  13 ;; (at your option) any later version.
  14 ;;
  15 ;; This program is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19 ;;
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with this program; if not, write to the Free Software
  22 ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  23
  24 ;;; Commentary:
  25
  26 ;;; History:
  27
  28 ;;; Bugs:
  29
  30 ;; - single-char nestable comment-start can only do the "\\s<+" stuff
  31 ;;   if the corresponding closing marker happens to be right.
  32 ;; - C-u C-u comment-region in TeXinfo generates bogus comments @ccccc@
  33 ;; - removal of comment-continue does not necesarily work because the
  34 ;;   continuation marker could have a leading space that turned into a tab
  35
  36 ;;; Todo:
  37
  38 ;; - extract comment data from the syntax-table
  39 ;; - maybe do the opposite as well (set the syntax-table from other data)
  40 ;; - customizable auto-fill of comments
  41 ;; - uncomment-region with a numeric argument
  42 ;; - uncomment-region with a consp (for blocks) or somehow make the
  43 ;;   deletion of continuation markers less dangerous
  44 ;; - drop block-comment-<foo> unless it's really used
  45 ;; - uncomment-region un a part of a comment
  46
  47 ;;; Problems:
  48
  49 ;; - comment padding:  (= comment-start "[- ") can either mean that
  50 ;;   the syntax of a comment-start is "[-" plus " " of padding
  51 ;;   (as is the case for C) or that the space is strictly required
  52 ;;   as is the case for TeXinfo.
  53
  54 ;;; Code:
  55
  56 (eval-when-compile (require 'cl))
  57
  58 (defcustom comment-use-syntax 'maybe
  59   "Non-nil if syntax-tables can be used instead of regexps.")
  60
  61 (defcustom comment-column 32
  62   "*Column to indent right-margin comments to.
  63 Setting this variable automatically makes it local to the current buffer.
  64 Each mode establishes a different default value for this variable; you
  65 can set the value for a particular mode using that mode's hook."
  66   :type 'integer
  67   :group 'fill-comments)
  68 (make-variable-buffer-local 'comment-column)
  69
  70 (defcustom comment-start nil
  71   "*String to insert to start a new comment, or nil if no comment syntax."
  72   :type '(choice (const :tag "None" nil)
  73                  string)
  74   :group 'fill-comments)
  75
  76 (defcustom comment-start-skip nil
  77   "*Regexp to match the start of a comment plus everything up to its body.
  78 If there are any \\(...\\) pairs, the comment delimiter text is held to begin
  79 at the place matched by the close of the first pair."
  80   :type '(choice (const :tag "None" nil)
  81                  regexp)
  82   :group 'fill-comments)
  83 (defcustom comment-end-skip nil
  84   "*Regexp to match the end of a comment plus everything up to its body."
  85   :type '(choice (const :tag "None" nil)
  86                  regexp)
  87   :group 'fill-comments)
  88
  89 (defcustom comment-end ""
  90   "*String to insert to end a new comment.
  91 Should be an empty string if comments are terminated by end-of-line."
  92   :type 'string
  93   :group 'fill-comments)
  94
  95 (defvar comment-indent-hook nil
  96   "Obsolete variable for function to compute desired indentation for a comment.
  97 This function is called with no args with point at the beginning of
  98 the comment's starting delimiter.")
  99
 100 (defvar comment-indent-function
 101   '(lambda () comment-column)
 102   "Function to compute desired indentation for a comment.
 103 This function is called with no args with point at the beginning of
 104 the comment's starting delimiter.")
 105
 106 (defcustom block-comment-start nil
 107   "*String to insert to start a new comment on a line by itself.
 108 If nil, use `comment-start' instead.
 109 Note that the regular expression `comment-start-skip' should skip this string
 110 as well as the `comment-start' string."
 111   :type '(choice (const :tag "Use comment-start" nil)
 112                  string)
 113   :group 'fill-comments)
 114
 115 (defcustom block-comment-end nil
 116   "*String to insert to end a new comment on a line by itself.
 117 Should be an empty string if comments are terminated by end-of-line.
 118 If nil, use `comment-end' instead."
 119   :type '(choice (const :tag "Use comment-end" nil)
 120                  string)
 121   :group 'fill-comments)
 122
 123 (defcustom comment-nested 'maybe
 124   "Whether the comments can be nested.")
 125 (defcustom comment-continue nil
 126   "Pair of strings to insert for multiline comments.")
 127 (defcustom comment-add '(0 . 2)
 128   "How many more chars should be inserted by default.")
 129
 130 (defcustom comment-style 'multi-line
 131   "*Style to be used for inserting comments."
 132   :group 'comment
 133   :type '(choice (const plain)
 134                  (const aligned)
 135                  (const multi-line)
 136                  (const extra-line)))
 137 (defconst comment-styles
 138   '((plain      . (nil nil nil))
 139     (aligned    . (nil t nil))
 140     (multi-line . (t nil nil))
 141     (extra-line . (t nil t)))
 142   "Possible styles.")
 143
 144 (defvar comment-padding 1
 145   "Number of spaces `comment-region' puts between comment chars and text.
 146 Can also be a string instead.
 147
 148 Extra spacing between the comment characters and the comment text
 149 makes the comment easier to read.  Default is 1.  Nil means 0.")
 150
 151 ;;;;
 152 ;;;; Helpers
 153 ;;;;
 154
 155 (defun comment-string-strip (str before after)
 156   (string-match (concat "\\`" (if before "\\s-*")
 157                         "\\(.*?\\)" (if after "\\s-*")
 158                         "\\'") str)
 159   (match-string 1 str))
 160
 161 (defun comment-string-reverse (s)
 162   (comment-string-strip (concat (reverse (string-to-list s))) nil t))
 163
 164 (defun comment-normalize-vars (&optional noerror)
 165   (if (not comment-start) (or noerror (error "No comment syntax is defined"))
 166     ;; comment-use-syntax
 167     (when (eq comment-use-syntax 'maybe)
 168       (set (make-local-variable 'comment-use-syntax)
 169            (let ((st (syntax-table))
 170                  (cs comment-start)
 171                  (ce (if (string= "" comment-end) "\n" comment-end)))
 172              (with-temp-buffer
 173                (set-syntax-table st)
 174                (insert cs " hello " ce)
 175                (goto-char (point-min))
 176                (and (forward-comment 1) (eobp))))))
 177     (when (eq comment-nested 'maybe)
 178       (set (make-local-variable 'comment-nested)
 179            (let ((st (syntax-table))
 180                  (cs comment-start)
 181                  (ce (if (string= "" comment-end) "\n" comment-end)))
 182              (with-temp-buffer
 183                (set-syntax-table st)
 184                (insert cs " he " cs " hello " ce " ho " ce)
 185                (goto-char (point-min))
 186                (and (forward-comment 1) (eobp))))))
 187     ;; comment-padding
 188     (when (integerp comment-padding)
 189       (setq comment-padding (make-string comment-padding ? )))
 190     ;; comment markers
 191     ;;(setq comment-start (comment-string-strip comment-start t nil))
 192     ;;(setq comment-end (comment-string-strip comment-end nil t))
 193     ;; comment-continue
 194     (unless (or (car comment-continue) (string= comment-end ""))
 195       (set (make-local-variable 'comment-continue)
 196            (cons (concat " " (substring comment-start 1))
 197                  nil)))
 198     (when (and (car comment-continue) (null (cdr comment-continue)))
 199       (setcdr comment-continue (comment-string-reverse (car comment-continue))))
 200     ;; comment-skip regexps
 201     (unless comment-start-skip
 202       (set (make-local-variable 'comment-start-skip)
 203            (concat "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\)\\(\\s<+\\|"
 204                    (regexp-quote (comment-string-strip comment-start t t))
 205                    "+\\)\\s-*")))
 206     (unless comment-end-skip
 207       (let ((ce (if (string= "" comment-end) "\n"
 208                   (comment-string-strip comment-end t t))))
 209         (set (make-local-variable 'comment-end-skip)
 210              (concat "\\s-*\\(\\s>" (if comment-nested "+" "")
 211                      "\\|" (regexp-quote (substring ce 0 1))
 212                      (if (or comment-nested (> (length ce) 1)) "+" "")
 213                      (regexp-quote (substring ce 1))
 214                      "\\)"))))))
 215
 216 (defmacro until (&rest body)
 217   (let ((retsym (make-symbol "ret")))
 218     `(let (,retsym)
 219        (while (not (setq ,retsym (progn ,@body))))
 220        ,retsym)))
 221 (def-edebug-spec until t)
 222
 223 (defun comment-end-quote-re (str &optional re)
 224   "Make a regexp that matches the (potentially quoted) STR comment-end.
 225 The regexp has one group in it which matches RE right after the
 226 potential quoting."
 227   (setq str (comment-string-strip str t t))
 228   (when (and (not comment-nested) (> (length str) 1))
 229     (concat (regexp-quote (substring str 0 1))
 230             "\\\\*\\(" re "\\)"
 231             (regexp-quote (substring str 1)))))
 232
 233 ;;;;
 234 ;;;; Navigation
 235 ;;;;
 236
 237 (defun comment-search-forward (&optional limit noerror)
 238   "Find a comment start between the point and LIMIT.
 239 Moves the point to inside the comment and returns the position of the
 240 comment-starter.  If no comment is found, moves the point to LIMIT
 241 and raises an error or returns nil of NOERROR is non-nil."
 242   (if (not comment-use-syntax)
 243       (when (re-search-forward comment-start-skip limit noerror)
 244         (or (match-end 1) (match-beginning 0)))
 245     (let ((s (parse-partial-sexp (point) (or limit (point-max)) nil nil nil t)))
 246       (if (and (nth 8 s) (not (nth 3 s)))
 247           (let ((pt (point))
 248                 (start (nth 8 s))
 249                 (bol (save-excursion (beginning-of-line) (point)))
 250                 (end nil))
 251             (while (and (null end) (>= (point) bol))
 252               (if (looking-at comment-start-skip)
 253                   (setq end (match-end 0))
 254                 (backward-char)))
 255             (goto-char end)
 256             start)
 257         (unless noerror (error "No comment"))))))
 258
 259 (defun comment-search-backward (&optional limit noerror)
 260   "Find a comment start between LIMIT and point.
 261 Moves the point to inside the comment and returns the position of the
 262 comment-starter.  If no comment is found, moves the point to LIMIT
 263 and raises an error or returns nil of NOERROR is non-nil."
 264   (if (not (re-search-backward comment-start-skip limit t))
 265       (unless noerror (error "No comment"))
 266     (beginning-of-line)
 267     (let* ((end (match-end 0))
 268            (cs (comment-search-forward end t))
 269            (pt (point)))
 270       (if (not cs)
 271           (progn (beginning-of-line)
 272                  (comment-search-backward limit noerror))
 273         (while (progn (goto-char cs)
 274                       (comment-forward)
 275                       (and (< (point) end)
 276                            (setq cs (comment-search-forward end t))))
 277           (setq pt (point)))
 278         (goto-char pt)
 279         cs))))
 280
 281 (defun comment-beginning ()
 282   "Find the beginning of the inclosing comment.
 283 Returns nil if not inside a comment, else moves the point and returns
 284 the same as `comment-search-forward'."
 285   (let ((pt (point))
 286         (cs (comment-search-backward nil t)))
 287     (save-excursion
 288       (and cs
 289            (progn (goto-char cs) (forward-comment 1) (> (point) pt))
 290            cs))))
 291
 292 (defun comment-forward (&optional n)
 293   "Skip forward over N comments.
 294 Just like `forward-comment' but only for positive N
 295 and can use regexps instead of syntax."
 296   (setq n (or n 1))
 297   (if (< n 0) (error "No comment-backward")
 298     (if comment-use-syntax (forward-comment n)
 299       (while (> n 0)
 300         (skip-syntax-forward " ")
 301         (if (and (looking-at comment-start-skip)
 302                  (re-search-forward comment-end-skip nil 'move))
 303             (decf n)
 304           (setq n -1)))
 305       (= n 0))))
 306
 307 (defun comment-enter-backward ()
 308   "Move from the end of a comment to the end of its content.
 309 The point is assumed to be right at the end of a comment."
 310   (if (bolp)
 311       ;; comment-end = ""
 312       (progn (backward-char) (skip-syntax-backward " "))
 313     (let ((end (point)))
 314       (beginning-of-line)
 315       (save-restriction
 316         (narrow-to-region (point) end)
 317         (re-search-forward (concat comment-end-skip "\\'"))
 318         (goto-char (match-beginning 0))))))
 319
 320 ;;;;
 321 ;;;; Commands
 322 ;;;;
 323
 324 (defun indent-for-comment (&optional continue)
 325   "Indent this line's comment to comment column, or insert an empty comment.
 326 If CONTINUE is non-nil, use the `comment-continuation' markers if any."
 327   (interactive "*")
 328   (let* ((empty (save-excursion (beginning-of-line)
 329                                 (looking-at "[ \t]*$")))
 330          (starter (or (and continue (car comment-continue))
 331                       (and empty block-comment-start) comment-start))
 332          (ender (or (and continue (car comment-continue) "")
 333                     (and empty block-comment-end) comment-end)))
 334     (cond
 335      ((null starter)
 336       (error "No comment syntax defined"))
 337      (t (let* ((eolpos (save-excursion (end-of-line) (point)))
 338                cpos indent begpos)
 339           (beginning-of-line)
 340           (when (setq begpos (comment-search-forward eolpos t))
 341             (skip-chars-forward
 342              (concat (buffer-substring (1- (point)) (point)) " \t"))
 343             (setq cpos (point-marker))
 344             (goto-char begpos))
 345           (setq begpos (point))
 346           ;; Compute desired indent.
 347           (if (= (current-column)
 348                  (setq indent (if comment-indent-hook
 349                                   (funcall comment-indent-hook)
 350                                 (funcall comment-indent-function))))
 351               (goto-char begpos)
 352             ;; If that's different from current, change it.
 353             (skip-chars-backward " \t")
 354             (delete-region (point) begpos)
 355             (indent-to indent))
 356           ;; An existing comment?
 357           (if cpos
 358               (progn (goto-char cpos)
 359                      (set-marker cpos nil))
 360             ;; No, insert one.
 361             (insert starter)
 362             (save-excursion
 363               (insert ender))))))))
 364
 365 (defun set-comment-column (arg)
 366   "Set the comment column based on point.
 367 With no ARG, set the comment column to the current column.
 368 With just minus as arg, kill any comment on this line.
 369 With any other arg, set comment column to indentation of the previous comment
 370  and then align or create a comment on this line at that column."
 371   (interactive "P")
 372   (cond
 373    ((eq arg '-) (kill-comment nil))
 374    (arg
 375     (save-excursion
 376       (beginning-of-line)
 377       (comment-search-backward)
 378       (beginning-of-line)
 379       (goto-char (comment-search-forward))
 380       (setq comment-column (current-column))
 381       (message "Comment column set to %d" comment-column))
 382     (indent-for-comment))
 383    (t (setq comment-column (current-column))
 384       (message "Comment column set to %d" comment-column))))
 385
 386 (defun kill-comment (arg)
 387   "Kill the comment on this line, if any.
 388 With prefix ARG, kill comments on that many lines starting with this one."
 389   (interactive "P")
 390   (let (endc)
 391     (dotimes (_ (prefix-numeric-value arg))
 392       (save-excursion
 393         (end-of-line)
 394         (setq endc (point))
 395         (beginning-of-line)
 396         (let ((cs (comment-search-forward endc t)))
 397           (when cs
 398             (goto-char cs)
 399             (skip-syntax-backward " ")
 400             (setq cs (point))
 401             (comment-forward)
 402             (kill-region cs (if (bolp) (1- (point)) (point)))
 403             (indent-according-to-mode))))
 404       (if arg (forward-line 1)))))
 405
 406 (defun comment-padright (str &optional n)
 407   "Construct a string composed of STR plus `comment-padding'.
 408 It contains N copies of the last non-whitespace chars of STR.
 409 If STR already contains padding, the corresponding amount is
 410   ignored from `comment-padding'.
 411 N defaults to 1.
 412 It N is 're, a regexp is returned instead, that would match
 413   the string for any N."
 414   (setq n (or n 0))
 415   (when (and (stringp str) (not (string= "" str)))
 416     (string-match "\\s-*\\'" str)
 417     (let ((s (substring str 0 (match-beginning 0)))
 418           (pad (concat (match-string 0 str)
 419                        (substring comment-padding
 420                                   (min (- (match-end 0) (match-beginning 0))
 421                                        (length comment-padding))))))
 422       (if (symbolp n)
 423           (concat (regexp-quote s) "+"
 424                   (mapconcat (lambda (c) (concat (regexp-quote (string c)) "?"))
 425                              pad ""))
 426         (concat s (make-string n (aref str (1- (match-beginning 0)))) pad)))))
 427
 428 (defun comment-padleft (str &optional n)
 429   "Construct a string composed of `comment-padding' plus STR.
 430 It contains N copies of the last non-whitespace chars of STR.
 431 If STR already contains padding, the corresponding amount is
 432   ignored from `comment-padding'.
 433 N defaults to 1.
 434 It N is 're, a regexp is returned instead, that would match
 435   the string for any N."
 436   (setq n (or n 0))
 437   (when (and (stringp str) (not (string= "" str)))
 438     (string-match "\\`\\s-*" str)
 439     (let ((s (substring str (match-end 0)))
 440           (pad (concat (substring comment-padding
 441                                   (min (- (match-end 0) (match-beginning 0))
 442                                        (length comment-padding)))
 443                        (match-string 0 str)))
 444           (c (aref str (match-end 0)))
 445           (multi (or comment-nested (string= comment-end "")
 446                      (> (length str) (1+ (match-end 0))))))
 447       (if (symbolp n)
 448           (concat "\\s-*"
 449                   (if multi (concat (regexp-quote (string c)) "*"))
 450                   (regexp-quote s))
 451         (concat pad (when multi (make-string n c)) s)))))
 452
 453 (defun uncomment-region (beg end &optional arg)
 454   "Uncomment each line in the BEG..END region.
 455 ARG is currently ignored."
 456   (interactive "*r\nP")
 457   (comment-normalize-vars)
 458   (if (> beg end) (let (mid) (setq mid beg beg end end mid)))
 459   (save-excursion
 460     (goto-char beg)
 461     (unless (markerp end) (setq end (copy-marker end)))
 462     (let ((numarg (prefix-numeric-value arg))
 463           spt)
 464       (while (and (< (point) end)
 465                   (setq spt (comment-search-forward end t)))
 466         (let* ((ipt (point))
 467                ;; find the end of the comment
 468                (ept (progn
 469                       (goto-char spt)
 470                       (unless (comment-forward)
 471                         (error "Can't find the comment end"))
 472                       (point-marker)))
 473                (block nil)
 474                (end-quote-re (comment-end-quote-re comment-end "\\\\"))
 475                (ccs (car comment-continue))
 476                (srei (comment-padright ccs 're))
 477                (sre (and srei (concat "^\\s-*\\(" srei "\\)"))))
 478           (save-restriction
 479             (narrow-to-region spt ept)
 480             ;; remove the comment-start
 481             (goto-char ipt)
 482             (skip-syntax-backward " ")
 483             (when (> (- (point) (point-min) (length comment-start)) 7)
 484               (setq block t))
 485             (when (looking-at (regexp-quote comment-padding))
 486               (goto-char (match-end 0)))
 487             (when (and sre (looking-at (concat "\\s-*\n\\s-*" srei)))
 488               (goto-char (match-end 0)))
 489             (delete-region (point-min) (point))
 490
 491             ;; remove the end-comment (and leading padding and such)
 492             (goto-char (point-max)) (comment-enter-backward)
 493             (unless (string-match "\\`\\(\n\\|\\s-\\)*\\'"
 494                                   (buffer-substring (point) ept))
 495               (when (and (bolp) (not (bobp))) (backward-char))
 496               (delete-region (point) ept))
 497
 498             ;; unquote any nested end-comment
 499             (when end-quote-re
 500               (goto-char (point-min))
 501               (while (re-search-forward end-quote-re nil t)
 502                 (delete-region (match-beginning 1) (match-end 1))))
 503
 504             ;; eliminate continuation markers as well
 505             (let* ((cce (or (cdr comment-continue)
 506                         (comment-string-reverse comment-start)))
 507                    (erei (and block (comment-padleft cce 're)))
 508                    (ere (and erei (concat "\\(" erei "\\)\\s-*$")))
 509                    (re (if (and sre ere) (concat sre "\\|" ere) (or sre ere))))
 510               (when re
 511                 (goto-char (point-min))
 512                 ;; there can't be a real SRE on the first line.
 513                 (when (and sre (looking-at sre)) (goto-char (match-end 0)))
 514                 (while (re-search-forward re nil t)
 515                   (replace-match "" t t nil (if (match-end 2) 2 1)))))
 516               ;; go the the end for the next comment
 517             (goto-char (point-max))))))))
 518
 519 (defun comment-make-extra-lines (cs ce ccs cce min-indent max-indent &optional block)
 520   (if block
 521       (let* ((s (concat cs "a=m" cce "\n"
 522                         (make-string min-indent ? ) ccs))
 523              (e (concat cce "\n" (make-string min-indent ? )
 524                         ccs "a=m" ce))
 525              (_ (assert (string-match "\\s-*\\(a=m\\)\\s-*" s)))
 526              (fill (make-string (+ (- max-indent
 527                                       min-indent
 528                                       (match-beginning 0))
 529                                    (- (match-end 0)
 530                                       (match-end 1)))
 531                                 (aref s (match-end 0)))))
 532         (setq cs (replace-match fill t t s))
 533         (assert (string-match "\\s-*\\(a=m\\)\\s-*" e))
 534         (setq ce (replace-match fill t t e)))
 535     (when (and ce (string-match "\\`\\s-*\\(.*\\S-\\)\\s-*\\'" ce))
 536       (setq ce (match-string 1 ce)))
 537     (let* ((c (concat ce "a=m" cs))
 538            (indent (if (string-match "\\(.+\\).*a=m\\(.*\\)\\1" c)
 539                        (max (+ min-indent
 540                                (- (match-end 2) (match-beginning 2))
 541                                (- (match-beginning 0)))
 542                             0)
 543                      min-indent)))
 544       (setq ce (concat cce "\n" (make-string indent ? ) (or ce cs)))
 545       (setq cs (concat cs "\n" (make-string min-indent ? ) ccs))))
 546   (values cs ce))
 547
 548 (def-edebug-spec comment-with-narrowing t)
 549 (put 'comment-with-narrowing 'lisp-indent-function 2)
 550 (defmacro comment-with-narrowing (beg end &rest body)
 551   "Execute BODY with BEG..END narrowing.
 552 Space is added (and then removed) at the beginning for the text's
 553 indentation to be kept as it was before narrowing."
 554   `(let ((-bindent (save-excursion (goto-char beg) (current-column))))
 555      (save-restriction
 556        (narrow-to-region beg end)
 557        (goto-char (point-min))
 558        (insert (make-string -bindent ? ))
 559        (prog1
 560            (progn ,@body)
 561          ;; remove the -bindent
 562          (save-excursion
 563            (goto-char (point-min))
 564            (when (looking-at " *")
 565              (let ((n (min (- (match-end 0) (match-beginning 0)) -bindent)))
 566                (delete-char n)
 567                (decf -bindent n)))
 568            (end-of-line)
 569            (let ((e (point)))
 570              (beginning-of-line)
 571              (while (and (> -bindent 0) (re-search-forward "  +" e t))
 572                (let ((n (min -bindent (- (match-end 0) (match-beginning 0) 1))))
 573                  (goto-char (match-beginning 0))
 574                  (delete-char n)
 575                  (decf -bindent n)))))))))
 576
 577 (defun comment-region-internal (beg end cs ce &optional ccs cce block lines)
 578   (assert (< beg end))
 579   (let ((no-empty t))
 580     ;; sanitize ce and cce
 581     (if (and (stringp ce) (string= "" ce)) (setq ce nil))
 582     (if (and (stringp cce) (string= "" cce)) (setq cce nil))
 583     ;; should we mark empty lines as well ?
 584     (if (or ccs block lines) (setq no-empty nil))
 585     ;; make sure we have end-markers for BLOCK mode
 586     (when block (unless ce (setq ce (comment-string-reverse cs))))
 587     ;; continuation defaults to the same
 588     (if ccs (unless block (setq cce nil))
 589       (setq ccs cs cce ce))
 590
 591     (save-excursion
 592       (goto-char end)
 593       (unless (or ce (eolp)) (insert "\n") (indent-according-to-mode))
 594       (comment-with-narrowing beg end
 595         (let ((ce-quote-re (comment-end-quote-re comment-end))
 596               (min-indent (point-max))
 597               (max-indent 0))
 598           (goto-char (point-min))
 599           ;; loop over all lines to find the needed indentations
 600           (until
 601            (unless (looking-at "[ \t]*$")
 602              (setq min-indent (min min-indent (current-indentation))))
 603            (when ce-quote-re
 604              (let ((eol (save-excursion (end-of-line) (point))))
 605                (while (re-search-forward ce-quote-re eol 'move)
 606                  (incf eol)
 607                  (replace-match "\\" t t nil 1))))
 608            (end-of-line)
 609            (setq max-indent (max max-indent (current-column)))
 610            (or (eobp) (progn (forward-line) nil)))
 611
 612           ;; inserting ccs can change max-indent by (1- tab-width)
 613           (incf max-indent (+ (max (length cs) (length ccs)) -1 tab-width))
 614
 615           ;; make the leading and trailing lines if requested
 616           (when lines
 617             (multiple-value-setq (cs ce)
 618               (comment-make-extra-lines
 619                cs ce ccs cce min-indent max-indent block)))
 620
 621           (goto-char (point-min))
 622           ;; Loop over all lines from BEG to END.
 623           (until
 624            (unless (and no-empty (looking-at "[ \t]*$"))
 625              (move-to-column min-indent t)
 626              (insert cs) (setq cs ccs)
 627              (end-of-line)
 628              (if (eobp) (setq cce ce))
 629              (when cce
 630                (when block (move-to-column max-indent t))
 631                (insert cce)))
 632            (end-of-line)
 633            (or (eobp) (progn (forward-line) nil))))))))
 634
 635 (defun comment-region (beg end &optional arg)
 636   "Comment or uncomment each line in the region.
 637 With just \\[universal-prefix] prefix arg, uncomment each line in region BEG..END.
 638 Numeric prefix arg ARG means use ARG comment characters.
 639 If ARG is negative, delete that many comment characters instead.
 640 Comments are terminated on each line, even for syntax in which newline does
 641 not end the comment.  Blank lines do not get comments.
 642
 643 The strings used as comment starts are built from
 644 `comment-start' without trailing spaces and `comment-padding'."
 645   (interactive "*r\nP")
 646   (comment-normalize-vars)
 647   (if (> beg end) (let (mid) (setq mid beg beg end end mid)))
 648   (let* ((numarg (prefix-numeric-value arg))
 649          (add (car comment-add))
 650          (style (cdr (assoc comment-style comment-styles)))
 651          (lines (nth 2 style))
 652          (block (nth 1 style))
 653          (multi (nth 0 style)))
 654     (save-excursion
 655       ;; we use `chars' instead of `syntax' because `\n' might be
 656       ;; of end-comment syntax rather than of whitespace syntax.
 657       ;; sanitize BEG and END
 658       (goto-char beg) (skip-chars-forward " \t\n\r") (beginning-of-line)
 659       (setq beg (max beg (point)))
 660       (goto-char end) (skip-chars-backward " \t\n\r") (end-of-line)
 661       (setq end (min end (point)))
 662       (if (>= beg end) (error "Nothing to comment"))
 663
 664       ;; sanitize LINES
 665       (setq lines
 666             (and
 667              lines multi
 668              (progn (goto-char beg) (beginning-of-line)
 669                     (skip-syntax-forward " ")
 670                     (>= (point) beg))
 671              (progn (goto-char end) (end-of-line) (skip-syntax-backward " ")
 672                     (<= (point) end))
 673              (not (string= "" comment-end))
 674              (progn (goto-char beg) (search-forward "\n" end t)))))
 675
 676     ;; C-u C-u makes a full block
 677     (when (and (consp arg) (>= numarg 16))
 678       (setq lines t block t add (or (cdr comment-add) 2))
 679       (setq arg nil numarg 1))
 680
 681     ;; don't add end-markers just because the user asked for `block'
 682     (unless (or lines (string= "" comment-end)) (setq block nil))
 683
 684     (cond
 685      ((consp arg) (uncomment-region beg end))
 686      ((< numarg 0) (uncomment-region beg end (- numarg)))
 687      (t
 688       (if (and (null arg) (= (length comment-start) 1))
 689           (setq numarg add) (decf numarg))
 690       (comment-region-internal
 691        beg end
 692        (comment-padright comment-start numarg)
 693        (comment-padleft comment-end numarg)
 694        (if multi (comment-padright (car comment-continue) numarg))
 695        (if multi (comment-padleft (cdr comment-continue) numarg))
 696        block
 697        lines)))))
 698
 699 (defun comment-dwim (arg)
 700   "Call the comment command you want.
 701 If the region is active, calls `comment-region' (unless it only consists
 702 in comments, in which case it calls `uncomment-region').
 703 Else, if the current line is empty, insert a comment and indent it.
 704 Else call `indent-for-comment' or `kill-comment' if a prefix ARG is specified."
 705   (interactive "*P")
 706   (comment-normalize-vars)
 707   (if mark-active
 708       (let ((beg (min (point) (mark)))
 709             (end (max (point) (mark))))
 710         (if (save-excursion ;; check for already commented region
 711               (goto-char beg)
 712               (comment-forward (point-max))
 713               (<= end (point)))
 714             (uncomment-region beg end arg)
 715           (comment-region beg end arg)))
 716     (if (save-excursion (beginning-of-line) (not (looking-at "\\s-*$")))
 717         (if arg (kill-comment (and (integerp arg) arg)) (indent-for-comment))
 718       (let ((add (if arg (prefix-numeric-value arg)
 719                    (if (= (length comment-start) 1) (car comment-add) 0))))
 720         (insert (comment-padright comment-start add))
 721         (save-excursion
 722           (unless (string= "" comment-end)
 723             (insert (comment-padleft comment-end add)))
 724           (indent-according-to-mode))))))
 725
 726 (defcustom comment-multi-line nil
 727   "*Non-nil means \\[indent-new-comment-line] should continue same comment
 728 on new line, with no new terminator or starter.
 729 This is obsolete because you might as well use \\[newline-and-indent]."
 730   :type 'boolean
 731   :group 'fill-comments)
 732
 733 (defun indent-new-comment-line (&optional soft)
 734   "Break line at point and indent, continuing comment if within one.
 735 This indents the body of the continued comment
 736 under the previous comment line.
 737
 738 This command is intended for styles where you write a comment per line,
 739 starting a new comment (and terminating it if necessary) on each line.
 740 If you want to continue one comment across several lines, use \\[newline-and-indent].
 741
 742 If a fill column is specified, it overrides the use of the comment column
 743 or comment indentation.
 744
 745 The inserted newline is marked hard if variable `use-hard-newlines' is true,
 746 unless optional argument SOFT is non-nil."
 747   (interactive)
 748   (comment-normalize-vars t)
 749   (let (comcol comstart)
 750     (skip-chars-backward " \t")
 751     (delete-region (point)
 752                    (progn (skip-chars-forward " \t")
 753                           (point)))
 754     (if soft (insert-and-inherit ?\n) (newline 1))
 755     (if fill-prefix
 756         (progn
 757           (indent-to-left-margin)
 758           (insert-and-inherit fill-prefix))
 759       (unless comment-multi-line
 760         (save-excursion
 761           (backward-char)
 762           (if (and comment-start
 763                    (setq comcol (comment-beginning)))
 764               ;; The old line has a comment and point was inside the comment.
 765               ;; Set WIN to the pos of the comment-start.
 766
 767               ;; If comment-start-skip contains a \(...\) pair,
 768               ;; the real comment delimiter starts at the end of that pair.
 769               (let ((win comcol))
 770                 ;; But if the comment is empty, look at preceding lines
 771                 ;; to find one that has a nonempty comment.
 772                 ;; (while (and (eolp) (not (bobp))
 773                 ;;          (let (opoint)
 774                 ;;            (beginning-of-line)
 775                 ;;            (setq opoint (point))
 776                 ;;            (forward-line -1)
 777                 ;;            (setq win (comment-search-forward opoint t)))))
 778                 ;; Why do we do that ?  -sm
 779
 780                 ;; Indent this line like what we found.
 781                 (setq comstart (buffer-substring win (point)))
 782                 (goto-char win)
 783                 (setq comcol (current-column))
 784                 ))))
 785       (if comcol
 786           (let ((comment-column comcol)
 787                 (comment-start comstart))
 788             ;;(if (not (eolp)) (setq comment-end ""))
 789             (insert-and-inherit ?\n)
 790             (forward-char -1)
 791             (indent-for-comment (cadr (assoc comment-style comment-styles)))
 792             (save-excursion
 793               (let ((pt (point)))
 794                 (end-of-line)
 795                 (let ((comend (buffer-substring pt (point))))
 796                   ;; The 1+ is to make sure we delete the \n inserted above.
 797                   (delete-region pt (1+ (point)))
 798                   (beginning-of-line)
 799                   (backward-char)
 800                   (insert comend)
 801                   (forward-char)))))
 802         (indent-according-to-mode)))))
 803
 804 (provide 'newcomment)
 805
 806 ;;; Change Log:
 807 ;; $Log: newcomment.el,v $
 808 ;; Revision 1.4  1999/11/29 01:31:47  monnier
 809 ;; (comment-find): New function.
 810 ;; (indent-for-comment, set-comment-column, kill-comment): use it.
 811 ;;
 812 ;; Revision 1.3  1999/11/29 00:49:18  monnier
 813 ;; (kill-comment): Fixed by rewriting it with syntax-tables rather than regexps
 814 ;; (comment-normalize-vars): Set default (cdr comment-continue)
 815 ;; (comment-end-quote-re): new function taken out of `comment-region-internal'
 816 ;; (uncomment-region): Rewritten using syntax-tables.  Also unquotes
 817 ;;   nested comment-ends and eliminates continuation markers.
 818 ;; (comment-region-internal): Don't create a default for cce.
 819 ;;   Use `comment-end-quote-re'.
 820 ;;
 821 ;; Revision 1.2  1999/11/28 21:33:55  monnier
 822 ;; (comment-make-extra-lines): Moved out of comment-region-internal.
 823 ;; (comment-with-narrowing): New macro.  Provides a way to preserve
 824 ;;   indentation inside narrowing.
 825 ;; (comment-region-internal): Add "\n" to close the comment if necessary.
 826 ;;   Correctly handle commenting-out when BEG is not bolp.
 827 ;;
 828 ;; Revision 1.1  1999/11/28 18:51:06  monnier
 829 ;; First "working" version:
 830 ;; - uncomment-region doesn't work for some unknown reason
 831 ;; - comment-multi-line allows the use of multi line comments
 832 ;; - comment-extra-lines allows yet another style choice
 833 ;; - comment-add allows to default to `;;'
 834 ;; - comment-region on a comment calls uncomment-region
 835 ;; - C-u C-u comment-region aligns comment end markers
 836 ;; - C-u C-u C-u comment-region puts the comment inside a rectangle
 837 ;; - comment-region will try to quote coment-end markers inside the region
 838 ;; - comment-start markers are placed at the indentation level
 839 ;;
 840
 841 ;;; newcomment.el ends here