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