comparison lisp/newcomment.el @ 2511:b9a1074dc6bf

[xemacs-hg @ 2005-01-26 09:57:14 by ben] Sync newcomment in FSF 21.3 newcomment.el: Sync to FSF 21.3.
author ben
date Wed, 26 Jan 2005 09:57:14 +0000
parents ce294639d321
children f97e1a4cbc28
comparison
equal deleted inserted replaced
2510:6f72d9a709c3 2511:b9a1074dc6bf
3 ;; Copyright (C) 1999, 2000 Free Software Foundation Inc. 3 ;; Copyright (C) 1999, 2000 Free Software Foundation Inc.
4 4
5 ;; Author: code extracted from Emacs-20's simple.el 5 ;; Author: code extracted from Emacs-20's simple.el
6 ;; Maintainer: Stefan Monnier <monnier@cs.yale.edu> 6 ;; Maintainer: Stefan Monnier <monnier@cs.yale.edu>
7 ;; Keywords: comment uncomment 7 ;; Keywords: comment uncomment
8 ;; Revision: $Id: newcomment.el,v 1.2 2004/06/06 23:58:44 adrian Exp $
9 8
10 ;; This file is part of GNU Emacs. 9 ;; This file is part of GNU Emacs.
11 10
12 ;; GNU Emacs is free software; you can redistribute it and/or modify 11 ;; GNU Emacs is free software; you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by 12 ;; it under the terms of the GNU General Public License as published by
22 ;; You should have received a copy of the GNU General Public License 21 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs; see the file COPYING. If not, write to the 22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25 ;; Boston, MA 02111-1307, USA. 24 ;; Boston, MA 02111-1307, USA.
26 25
26 ;;; Synched up with: FSF 21.3.
27
27 ;;; Commentary: 28 ;;; Commentary:
28 29
29 ;; A replacement for simple.el's comment-related functions. 30 ;; A replacement for simple.el's comment-related functions.
30 31
31 ;;; Bugs: 32 ;;; Bugs:
32 33
34 ;; - boxed comments in Perl are not properly uncommented because they are
35 ;; uncommented one-line at a time.
36 ;; - nested comments in sgml-mode are not properly quoted.
33 ;; - single-char nestable comment-start can only do the "\\s<+" stuff 37 ;; - single-char nestable comment-start can only do the "\\s<+" stuff
34 ;; if the corresponding closing marker happens to be right. 38 ;; if the corresponding closing marker happens to be right.
35 ;; - comment-box in TeXinfo generate bogus comments @ccccc@
36 ;; - uncomment-region with a numeric argument can render multichar 39 ;; - uncomment-region with a numeric argument can render multichar
37 ;; comment markers invalid. 40 ;; comment markers invalid.
38 ;; - comment-indent or comment-region when called inside a comment 41 ;; - comment-indent or comment-region when called inside a comment
39 ;; will happily break the surrounding comment. 42 ;; will happily break the surrounding comment.
40 ;; - comment-quote-nested will not (un)quote properly all nested comment 43 ;; - comment-quote-nested will not (un)quote properly all nested comment
41 ;; markers if there are more than just comment-start and comment-end. 44 ;; markers if there are more than just comment-start and comment-end.
42 ;; For example, in Pascal where {...*) and (*...} are possible. 45 ;; For example, in Pascal where {...*) and (*...} are possible.
43 46
44 ;;; Todo: 47 ;;; Todo:
45 48
46 ;; - quantized steps in comment-alignment 49 ;; - rebox.el-style refill.
47 ;; - try to align tail comments 50 ;; - quantized steps in comment-alignment.
48 ;; - check what c-comment-line-break-function has to say 51 ;; - try to align tail comments.
49 ;; - spill auto-fill of comments onto the end of the next line 52 ;; - check what c-comment-line-break-function has to say.
53 ;; - spill auto-fill of comments onto the end of the next line.
50 ;; - uncomment-region with a consp (for blocks) or somehow make the 54 ;; - uncomment-region with a consp (for blocks) or somehow make the
51 ;; deletion of continuation markers less dangerous 55 ;; deletion of continuation markers less dangerous.
52 ;; - drop block-comment-<foo> unless it's really used 56 ;; - drop block-comment-<foo> unless it's really used.
53 ;; - uncomment-region on a subpart of a comment 57 ;; - uncomment-region on a subpart of a comment.
54 ;; - support gnu-style "multi-line with space in continue" 58 ;; - support gnu-style "multi-line with space in continue".
55 ;; - somehow allow comment-dwim to use the region even if transient-mark-mode 59 ;; - somehow allow comment-dwim to use the region even if transient-mark-mode
56 ;; is not turned on. 60 ;; is not turned on.
57 61
58 ;; - when auto-filling a comment, try to move the comment to the left 62 ;; - when auto-filling a comment, try to move the comment to the left
59 ;; rather than break it (if possible). 63 ;; rather than break it (if possible).
69 ;;;###autoload 73 ;;;###autoload
70 (defalias 'kill-comment 'comment-kill) 74 (defalias 'kill-comment 'comment-kill)
71 ;;;###autoload 75 ;;;###autoload
72 (defalias 'indent-new-comment-line 'comment-indent-new-line) 76 (defalias 'indent-new-comment-line 'comment-indent-new-line)
73 77
74 ;;;###autoload
75 (defgroup comment nil 78 (defgroup comment nil
76 "Indenting and filling of comments." 79 "Indenting and filling of comments."
77 :prefix "comment-" 80 :prefix "comment-"
78 :version "21.1" 81 :version "21.1"
79 :group 'fill) 82 :group 'fill)
83 Can also be `undecided' which means that a somewhat expensive test will 86 Can also be `undecided' which means that a somewhat expensive test will
84 be used to try to determine whether syntax-tables should be trusted 87 be used to try to determine whether syntax-tables should be trusted
85 to understand comments or not in the given buffer. 88 to understand comments or not in the given buffer.
86 Major modes should set this variable.") 89 Major modes should set this variable.")
87 90
91 (defcustom comment-fill-column nil
92 "Column to use for `comment-indent'. If nil, use `fill-column' instead."
93 :type '(choice (const nil) integer))
94
88 ;;;###autoload 95 ;;;###autoload
89 (defcustom comment-column 32 96 (defcustom comment-column 32
90 "*Column to indent right-margin comments to. 97 "*Column to indent right-margin comments to.
91 Setting this variable automatically makes it local to the current buffer.
92 Each mode establishes a different default value for this variable; you 98 Each mode establishes a different default value for this variable; you
93 can set the value for a particular mode using that mode's hook." 99 can set the value for a particular mode using that mode's hook.
94 :type 'integer 100 Comments might be indented to a value smaller than this in order
95 :group 'comment) 101 not to go beyond `comment-fill-column'."
102 :type 'integer)
96 (make-variable-buffer-local 'comment-column) 103 (make-variable-buffer-local 'comment-column)
97 104
98 ;;;###autoload 105 ;;;###autoload
99 (defvar comment-start nil 106 (defvar comment-start nil
100 "*String to insert to start a new comment, or nil if no comment syntax.") 107 "*String to insert to start a new comment, or nil if no comment syntax.")
165 172
166 ;;;###autoload 173 ;;;###autoload
167 (defcustom comment-style 'plain 174 (defcustom comment-style 'plain
168 "*Style to be used for `comment-region'. 175 "*Style to be used for `comment-region'.
169 See `comment-styles' for a list of available styles." 176 See `comment-styles' for a list of available styles."
170 :group 'comment
171 :type (if (boundp 'comment-styles) 177 :type (if (boundp 'comment-styles)
172 `(choice ,@(mapcar (lambda (s) `(const ,(car s))) comment-styles)) 178 `(choice ,@(mapcar (lambda (s) `(const ,(car s))) comment-styles))
173 'symbol)) 179 'symbol))
174 180
175 ;;;###autoload 181 ;;;###autoload
177 "Padding string that `comment-region' puts between comment chars and text. 183 "Padding string that `comment-region' puts between comment chars and text.
178 Can also be an integer which will be automatically turned into a string 184 Can also be an integer which will be automatically turned into a string
179 of the corresponding number of spaces. 185 of the corresponding number of spaces.
180 186
181 Extra spacing between the comment characters and the comment text 187 Extra spacing between the comment characters and the comment text
182 makes the comment easier to read. Default is \" \". nil means 0." 188 makes the comment easier to read. Default is 1. nil means 0."
183 :group 'comment
184 :type '(choice string integer (const nil))) 189 :type '(choice string integer (const nil)))
185 190
186 ;;;###autoload 191 ;;;###autoload
187 (defcustom comment-multi-line t ; XEmacs - this works well with adaptive fill 192 (defcustom comment-multi-line t ; XEmacs - this works well with adaptive fill
188 "*Non-nil means \\[indent-new-comment-line] should continue same comment 193 "*Non-nil means \\[indent-new-comment-line] should continue same comment
189 on new line, with no new terminator or starter. 194 on new line, with no new terminator or starter.
190 This is obsolete because you might as well use \\[newline-and-indent]." 195 This is obsolete because you might as well use \\[newline-and-indent]."
191 :type 'boolean 196 :type 'boolean)
192 :group 'comment)
193 197
194 ;;;; 198 ;;;;
195 ;;;; Helpers 199 ;;;; Helpers
196 ;;;; 200 ;;;;
197 201
204 208
205 (defun comment-string-reverse (s) 209 (defun comment-string-reverse (s)
206 "Return the mirror image of string S, without any trailing space." 210 "Return the mirror image of string S, without any trailing space."
207 (comment-string-strip (concat (nreverse (string-to-list s))) nil t)) 211 (comment-string-strip (concat (nreverse (string-to-list s))) nil t))
208 212
213 ;;;###autoload
209 (defun comment-normalize-vars (&optional noerror) 214 (defun comment-normalize-vars (&optional noerror)
210 (if (not comment-start) (or noerror (error "No comment syntax is defined")) 215 (if (not comment-start) (or noerror (error "No comment syntax is defined"))
211 ;; comment-use-syntax 216 ;; comment-use-syntax
212 (when (eq comment-use-syntax 'undecided) 217 (when (eq comment-use-syntax 'undecided)
213 (set (make-local-variable 'comment-use-syntax) 218 (set (make-local-variable 'comment-use-syntax)
230 ;;(setq comment-end (comment-string-strip comment-end nil t)) 235 ;;(setq comment-end (comment-string-strip comment-end nil t))
231 ;; comment-continue 236 ;; comment-continue
232 (unless (or comment-continue (string= comment-end "")) 237 (unless (or comment-continue (string= comment-end ""))
233 (set (make-local-variable 'comment-continue) 238 (set (make-local-variable 'comment-continue)
234 (concat (if (string-match "\\S-\\S-" comment-start) " " "|") 239 (concat (if (string-match "\\S-\\S-" comment-start) " " "|")
235 (substring comment-start 1)))) 240 (substring comment-start 1)))
241 ;; Hasn't been necessary yet.
242 ;; (unless (string-match comment-start-skip comment-continue)
243 ;; (kill-local-variable 'comment-continue))
244 )
236 ;; comment-skip regexps 245 ;; comment-skip regexps
237 (unless comment-start-skip 246 (unless (and comment-start-skip
247 ;; In case comment-start has changed since last time.
248 (string-match comment-start-skip comment-start))
238 (set (make-local-variable 'comment-start-skip) 249 (set (make-local-variable 'comment-start-skip)
239 (concat "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\)\\(\\s<+\\|" 250 (concat "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\)\\(\\s<+\\|"
240 (regexp-quote (comment-string-strip comment-start t t)) 251 (regexp-quote (comment-string-strip comment-start t t))
241 ;; Let's not allow any \s- but only [ \t] since \n 252 ;; Let's not allow any \s- but only [ \t] since \n
242 ;; might be both a comment-end marker and \s-. 253 ;; might be both a comment-end marker and \s-.
243 "+\\)[ \t]*"))) 254 "+\\)[ \t]*")))
244 (unless comment-end-skip 255 (unless (and comment-end-skip
256 ;; In case comment-end has changed since last time.
257 (string-match comment-end-skip comment-end))
245 (let ((ce (if (string= "" comment-end) "\n" 258 (let ((ce (if (string= "" comment-end) "\n"
246 (comment-string-strip comment-end t t)))) 259 (comment-string-strip comment-end t t))))
247 (set (make-local-variable 'comment-end-skip) 260 (set (make-local-variable 'comment-end-skip)
248 ;; We use [ \t] rather than \s- because we don't want to 261 ;; We use [ \t] rather than \s- because we don't want to
249 ;; remove ^L in C mode when uncommenting. 262 ;; remove ^L in C mode when uncommenting.
250 (concat "[ \t]*\\(\\s>" (if comment-quote-nested "" "+") 263 (concat "[ \t]*\\(\\s>" (if comment-quote-nested "" "+")
251 "\\|" (regexp-quote (substring ce 0 1)) 264 "\\|" (regexp-quote (substring ce 0 1))
252 (if (and comment-quote-nested (<= (length ce) 1)) "" "+") 265 (if (and comment-quote-nested (<= (length ce) 1)) "" "+")
253 (regexp-quote (substring ce 1)) 266 (regexp-quote (substring ce 1))
254 "\\)")))))) 267 "\\)"))))))
255 268
256 (defun comment-quote-re (str unp) 269 (defun comment-quote-re (str unp)
257 (concat (regexp-quote (substring str 0 1)) 270 (concat (regexp-quote (substring str 0 1))
258 "\\\\" (if unp "+" "*") 271 "\\\\" (if unp "+" "*")
259 (regexp-quote (substring str 1)))) 272 (regexp-quote (substring str 1))))
260 273
466 (beginning-of-line) 479 (beginning-of-line)
467 (let* ((eolpos (line-end-position)) 480 (let* ((eolpos (line-end-position))
468 (begpos (comment-search-forward eolpos t)) 481 (begpos (comment-search-forward eolpos t))
469 cpos indent) 482 cpos indent)
470 ;; An existing comment? 483 ;; An existing comment?
471 (if begpos (setq cpos (point-marker)) 484 (if begpos
485 (progn
486 (if (and (not (looking-at "[\t\n ]"))
487 (looking-at comment-end-skip))
488 ;; The comment is empty and we have skipped all its space
489 ;; and landed right before the comment-ender:
490 ;; Go back to the middle of the space.
491 (forward-char (/ (skip-chars-backward " \t") -2)))
492 (setq cpos (point-marker)))
472 ;; If none, insert one. 493 ;; If none, insert one.
473 (save-excursion 494 (save-excursion
474 ;; Some comment-indent-function insist on not moving comments that 495 ;; Some comment-indent-function insist on not moving comments that
475 ;; are in column 0, so we first go to the likely target column. 496 ;; are in column 0, so we first go to the likely target column.
476 (indent-to comment-column) 497 (indent-to comment-column)
477 (setq begpos (point)) 498 (setq begpos (point))
499 ;; Ensure there's a space before the comment for things
500 ;; like sh where it matters (as well as being neater).
501 (unless (eq ?\ (char-syntax (char-before)))
502 (insert ?\ ))
478 (insert starter) 503 (insert starter)
479 (setq cpos (point-marker)) 504 (setq cpos (point-marker))
480 (insert ender))) 505 (insert ender)))
481 (goto-char begpos) 506 (goto-char begpos)
482 ;; Compute desired indent. 507 ;; Compute desired indent.
483 (setq indent (save-excursion (funcall comment-indent-function))) 508 (setq indent (save-excursion (funcall comment-indent-function)))
484 (if (not indent) 509 (if (not indent)
485 ;; comment-indent-function refuses delegates to indent. 510 ;; comment-indent-function refuses: delegate to indent.
486 (indent-according-to-mode) 511 (indent-according-to-mode)
487 ;; Avoid moving comments past the fill-column. 512 ;; Avoid moving comments past the fill-column.
488 (unless (save-excursion (skip-chars-backward " \t") (bolp)) 513 (unless (save-excursion (skip-chars-backward " \t") (bolp))
489 (setq indent 514 (setq indent
490 (min indent 515 (min indent
491 (+ (current-column) 516 (+ (current-column)
492 (- fill-column 517 (- (or comment-fill-column fill-column)
493 (save-excursion (end-of-line) (current-column))))))) 518 (save-excursion (end-of-line) (current-column)))))))
494 ;; XEmacs change: Preserve indentation of comments starting in 519 ;; XEmacs change: Preserve indentation of comments starting in
495 ;; column 0, as documented. 520 ;; column 0, as documented.
496 (if (or (= (current-column) 0) (= (current-column) indent)) 521 (unless (or (= (current-column) 0) (= (current-column) indent))
497 (goto-char begpos)
498 ;; If that's different from current, change it. 522 ;; If that's different from current, change it.
499 (skip-chars-backward " \t") 523 (delete-region (point) (progn (skip-chars-backward " \t") (point)))
500 (delete-region (point) begpos)
501 (indent-to (if (bolp) indent 524 (indent-to (if (bolp) indent
502 (max indent (1+ (current-column))))))) 525 (max indent (1+ (current-column)))))))
503 (goto-char cpos) 526 (goto-char cpos)
504 (set-marker cpos nil)))) 527 (set-marker cpos nil))))
505 528
617 (if multi (concat (regexp-quote (string c)) "*")) 640 (if multi (concat (regexp-quote (string c)) "*"))
618 (regexp-quote s)))))) 641 (regexp-quote s))))))
619 642
620 ;;;###autoload 643 ;;;###autoload
621 (defun uncomment-region (beg end &optional arg) 644 (defun uncomment-region (beg end &optional arg)
622 "Uncomment each line in the BEG..END region. 645 "Uncomment each line in the BEG .. END region.
623 The numeric prefix ARG can specify a number of chars to remove from the 646 The numeric prefix ARG can specify a number of chars to remove from the
624 comment markers." 647 comment markers."
625 (interactive "*r\nP") 648 (interactive "*r\nP")
626 (comment-normalize-vars) 649 (comment-normalize-vars)
627 (if (> beg end) (let (mid) (setq mid beg beg end end mid))) 650 (if (> beg end) (let (mid) (setq mid beg beg end end mid)))
647 (forward-line 1))) 670 (forward-line 1)))
648 (if (< min-comments 999999) 671 (if (< min-comments 999999)
649 (setq arg (list min-comments))) 672 (setq arg (list min-comments)))
650 (goto-char beg))) 673 (goto-char beg)))
651 674
652 (let ((numarg (prefix-numeric-value arg)) 675 (let* ((numarg (prefix-numeric-value arg))
653 spt) 676 (ccs comment-continue)
677 (srei (comment-padright ccs 're))
678 (sre (and srei (concat "^\\s-*?\\(" srei "\\)")))
679 spt)
654 (while (and (< (point) end) 680 (while (and (< (point) end)
655 (setq spt (comment-search-forward end t))) 681 (setq spt (comment-search-forward end t)))
656 (let* ((ipt (point)) 682 (let ((ipt (point))
657 ;; Find the end of the comment. 683 ;; Find the end of the comment.
658 (ept (progn 684 (ept (progn
659 (goto-char spt) 685 (goto-char spt)
660 (unless (comment-forward) 686 (unless (comment-forward)
661 (error "Can't find the comment end")) 687 (error "Can't find the comment end"))
662 (point))) 688 (point)))
663 (box nil) 689 (box nil)
664 (ccs comment-continue) 690 (box-equal nil)) ;Whether we might be using `=' for boxes.
665 (srei (comment-padright ccs 're))
666 (sre (and srei (concat "^\\s-*?\\(" srei "\\)"))))
667 (save-restriction 691 (save-restriction
668 (narrow-to-region spt ept) 692 (narrow-to-region spt ept)
693
669 ;; Remove the comment-start. 694 ;; Remove the comment-start.
670 (goto-char ipt) 695 (goto-char ipt)
671 (skip-syntax-backward " ") 696 (skip-syntax-backward " ")
672 ;; Check for special `=' used sometimes in comment-box.
673 (when (and (= (- (point) (point-min)) 1) (looking-at "=\\{7\\}"))
674 (skip-chars-forward "="))
675 ;; A box-comment starts with a looong comment-start marker. 697 ;; A box-comment starts with a looong comment-start marker.
676 (when (> (- (point) (point-min) (length comment-start)) 7) 698 (when (and (or (and (= (- (point) (point-min)) 1)
699 (setq box-equal t)
700 (looking-at "=\\{7\\}")
701 (not (eq (char-before (point-max)) ?\n))
702 (skip-chars-forward "="))
703 (> (- (point) (point-min) (length comment-start)) 7))
704 (> (count-lines (point-min) (point-max)) 2))
677 (setq box t)) 705 (setq box t))
678 (when (looking-at (regexp-quote comment-padding)) 706 (when (looking-at (regexp-quote comment-padding))
679 (goto-char (match-end 0))) 707 (goto-char (match-end 0)))
680 (when (and sre (looking-at (concat "\\s-*\n\\s-*" srei))) 708 (when (and sre (looking-at (concat "\\s-*\n\\s-*" srei)))
681 (goto-char (match-end 0))) 709 (goto-char (match-end 0)))
684 (delete-char (- numarg))) 712 (delete-char (- numarg)))
685 713
686 ;; Remove the end-comment (and leading padding and such). 714 ;; Remove the end-comment (and leading padding and such).
687 (goto-char (point-max)) (comment-enter-backward) 715 (goto-char (point-max)) (comment-enter-backward)
688 ;; Check for special `=' used sometimes in comment-box. 716 ;; Check for special `=' used sometimes in comment-box.
689 (when (= (- (point-max) (point)) 1) 717 (when (and box-equal (not (eq (char-before (point-max)) ?\n)))
690 (let ((pos (point))) 718 (let ((pos (point)))
691 ;; skip `=' but only if there are at least 7. 719 ;; skip `=' but only if there are at least 7.
692 (when (> (skip-chars-backward "=") -7) (goto-char pos)))) 720 (when (> (skip-chars-backward "=") -7) (goto-char pos))))
693 (unless (looking-at "\\(\n\\|\\s-\\)*\\'") 721 (unless (looking-at "\\(\n\\|\\s-\\)*\\'")
694 (when (and (bolp) (not (bobp))) (backward-char)) 722 (when (and (bolp) (not (bobp))) (backward-char))
733 ;; box comment 761 ;; box comment
734 (let* ((width (- max-indent min-indent)) 762 (let* ((width (- max-indent min-indent))
735 (s (concat cs "a=m" cce)) 763 (s (concat cs "a=m" cce))
736 (e (concat ccs "a=m" ce)) 764 (e (concat ccs "a=m" ce))
737 (c (if (string-match ".*\\S-\\S-" cs) 765 (c (if (string-match ".*\\S-\\S-" cs)
738 (aref cs (1- (match-end 0))) ?=)) 766 (aref cs (1- (match-end 0)))
739 ; Huh? (_ (string-match "\\s-*a=m\\s-*" s)) 767 (if (and (equal comment-end "") (string-match ".*\\S-" cs))
768 (aref cs (1- (match-end 0))) ?=)))
769 (re "\\s-*a=m\\s-*")
770 ; Huh? (_ (string-match re s))
771 (lcs (length cs))
740 (fill 772 (fill
741 (make-string (+ width (- (match-end 0) 773 (make-string (+ width (- (match-end 0)
742 (match-beginning 0) (length cs) 3)) c))) 774 (match-beginning 0) lcs 3)) c)))
743 (setq cs (replace-match fill t t s)) 775 (setq cs (replace-match fill t t s))
744 (string-match "\\s-*a=m\\s-*" e) 776 (when (and (not (string-match comment-start-skip cs))
777 (string-match "a=m" s))
778 ;; The whitespace around CS cannot be ignored: put it back.
779 (setq re "a=m")
780 (setq fill (make-string (- width lcs) c))
781 (setq cs (replace-match fill t t s)))
782 (string-match re e)
745 (setq ce (replace-match fill t t e)))) 783 (setq ce (replace-match fill t t e))))
746 (cons (concat cs "\n" (make-string min-indent ? ) ccs) 784 (cons (concat cs "\n" (make-string min-indent ? ) ccs)
747 (concat cce "\n" (make-string (+ min-indent eindent) ? ) ce)))) 785 (concat cce "\n" (make-string (+ min-indent eindent) ? ) ce))))
748 786
749 ;(def-edebug-spec comment-with-narrowing t)
750 (put 'comment-with-narrowing 'lisp-indent-function 2)
751 (defmacro comment-with-narrowing (beg end &rest body) 787 (defmacro comment-with-narrowing (beg end &rest body)
752 "Execute BODY with BEG..END narrowing. 788 "Execute BODY with BEG..END narrowing.
753 Space is added (and then removed) at the beginning for the text's 789 Space is added (and then removed) at the beginning for the text's
754 indentation to be kept as it was before narrowing." 790 indentation to be kept as it was before narrowing."
791 (declare (debug t) (indent 2))
755 (let ((bindent (make-symbol "bindent"))) 792 (let ((bindent (make-symbol "bindent")))
756 `(let ((,bindent (save-excursion (goto-char beg) (current-column)))) 793 `(let ((,bindent (save-excursion (goto-char beg) (current-column))))
757 (save-restriction 794 (save-restriction
758 (narrow-to-region beg end) 795 (narrow-to-region beg end)
759 (goto-char (point-min)) 796 (goto-char (point-min))
776 (delete-char n) 813 (delete-char n)
777 (setq ,bindent (- ,bindent n))))))))))) 814 (setq ,bindent (- ,bindent n)))))))))))
778 815
779 (defun comment-region-internal (beg end cs ce 816 (defun comment-region-internal (beg end cs ce
780 &optional ccs cce block lines indent) 817 &optional ccs cce block lines indent)
781 "Comment region BEG..END. 818 "Comment region BEG .. END.
782 CS and CE are the comment start resp end string. 819 CS and CE are the comment start resp end string.
783 CCS and CCE are the comment continuation strings for the start resp end 820 CCS and CCE are the comment continuation strings for the start resp end
784 of lines (default to CS and CE). 821 of lines (default to CS and CE).
785 BLOCK indicates that end of lines should be marked with either CCE, CE or CS 822 BLOCK indicates that end of lines should be marked with either CCE, CE or CS
786 \(if CE is empty) and that those markers should be aligned. 823 \(if CE is empty) and that those markers should be aligned.
801 (when block (unless ce (setq ce (comment-string-reverse cs)))) 838 (when block (unless ce (setq ce (comment-string-reverse cs))))
802 ;; If BLOCK is not requested, we don't need CCE. 839 ;; If BLOCK is not requested, we don't need CCE.
803 (unless block (setq cce nil)) 840 (unless block (setq cce nil))
804 ;; Continuation defaults to the same as CS and CE. 841 ;; Continuation defaults to the same as CS and CE.
805 (unless ccs (setq ccs cs cce ce)) 842 (unless ccs (setq ccs cs cce ce))
806 843
807 (save-excursion 844 (save-excursion
808 (goto-char end) 845 (goto-char end)
809 ;; If the end is not at the end of a line and the comment-end 846 ;; If the end is not at the end of a line and the comment-end
810 ;; is implicit (i.e. a newline), explicitly insert a newline. 847 ;; is implicit (i.e. a newline), explicitly insert a newline.
811 (unless (or ce (eolp)) (insert "\n") (indent-according-to-mode)) 848 (unless (or ce (eolp)) (insert "\n") (indent-according-to-mode))
823 (unless (looking-at "[ \t]*$") 860 (unless (looking-at "[ \t]*$")
824 (setq min-indent (min min-indent (current-indentation)))) 861 (setq min-indent (min min-indent (current-indentation))))
825 (end-of-line) 862 (end-of-line)
826 (setq max-indent (max max-indent (current-column))) 863 (setq max-indent (max max-indent (current-column)))
827 (not (or (eobp) (progn (forward-line) nil))))) 864 (not (or (eobp) (progn (forward-line) nil)))))
828 865
829 ;; Inserting ccs can change max-indent by (1- tab-width). 866 ;; Inserting ccs can change max-indent by (1- tab-width).
830 (setq max-indent 867 (setq max-indent
831 (+ max-indent (max (length cs) (length ccs)) tab-width -1)) 868 (+ max-indent (max (length cs) (length ccs)) tab-width -1))
832 (unless indent (setq min-indent 0)) 869 (unless indent (setq min-indent 0))
833 870
836 (let ((csce 873 (let ((csce
837 (comment-make-extra-lines 874 (comment-make-extra-lines
838 cs ce ccs cce min-indent max-indent block))) 875 cs ce ccs cce min-indent max-indent block)))
839 (setq cs (car csce)) 876 (setq cs (car csce))
840 (setq ce (cdr csce)))) 877 (setq ce (cdr csce))))
841 878
842 (goto-char (point-min)) 879 (goto-char (point-min))
843 ;; Loop over all lines from BEG to END. 880 ;; Loop over all lines from BEG to END.
844 (while 881 (while
845 (progn 882 (progn
846 (unless (and no-empty (looking-at "[ \t]*$")) 883 (unless (and no-empty (looking-at "[ \t]*$"))
855 (not (or (eobp) (progn (forward-line) nil)))))))))) 892 (not (or (eobp) (progn (forward-line) nil))))))))))
856 893
857 ;;;###autoload 894 ;;;###autoload
858 (defun comment-region (beg end &optional arg) 895 (defun comment-region (beg end &optional arg)
859 "Comment or uncomment each line in the region. 896 "Comment or uncomment each line in the region.
860 With just \\[universal-argument] prefix arg, uncomment each line in region BEG..END. 897 With just \\[universal-argument] prefix arg, uncomment each line in region BEG .. END.
861 Numeric prefix arg ARG means use ARG comment characters. 898 Numeric prefix arg ARG means use ARG comment characters.
862 If ARG is negative, delete that many comment characters instead. 899 If ARG is negative, delete that many comment characters instead.
863 By default, comments start at the left margin, are terminated on each line, 900 By default, comments start at the left margin, are terminated on each line,
864 even for syntax in which newline does not end the comment and blank lines 901 even for syntax in which newline does not end the comment and blank lines
865 do not get comments. This can be changed with `comment-style'. 902 do not get comments. This can be changed with `comment-style'.
892 (progn (goto-char beg) (beginning-of-line) 929 (progn (goto-char beg) (beginning-of-line)
893 (skip-syntax-forward " ") 930 (skip-syntax-forward " ")
894 (>= (point) beg)) 931 (>= (point) beg))
895 (progn (goto-char end) (end-of-line) (skip-syntax-backward " ") 932 (progn (goto-char end) (end-of-line) (skip-syntax-backward " ")
896 (<= (point) end)) 933 (<= (point) end))
897 (or (not (string= "" comment-end)) block) 934 (or block (not (string= "" comment-end)))
898 (progn (goto-char beg) (search-forward "\n" end t))))) 935 (or block (progn (goto-char beg) (search-forward "\n" end t))))))
899 936
900 ;; don't add end-markers just because the user asked for `block' 937 ;; don't add end-markers just because the user asked for `block'
901 (unless (or lines (string= "" comment-end)) (setq block nil)) 938 (unless (or lines (string= "" comment-end)) (setq block nil))
902 939
903 (cond 940 (cond
919 block 956 block
920 lines 957 lines
921 (nth 3 style)))))) 958 (nth 3 style))))))
922 959
923 (defun comment-box (beg end &optional arg) 960 (defun comment-box (beg end &optional arg)
924 "Comment out the BEG..END region, putting it inside a box. 961 "Comment out the BEG .. END region, putting it inside a box.
925 The numeric prefix ARG specifies how many characters to add to begin- and 962 The numeric prefix ARG specifies how many characters to add to begin- and
926 end- comment markers additionally to what `comment-add' already specifies." 963 end- comment markers additionally to what `comment-add' already specifies."
927 (interactive "*r\np") 964 (interactive "*r\np")
928 (let ((comment-style (if (cadr (assoc comment-style comment-styles)) 965 (let ((comment-style (if (cadr (assoc comment-style comment-styles))
929 'box-multi 'box))) 966 'box-multi 'box)))
930 (comment-region beg end (+ comment-add arg)))) 967 (comment-region beg end (+ comment-add arg))))
968
969
970 ;;;###autoload
971 (defun comment-or-uncomment-region (beg end &optional arg)
972 "Call `comment-region', unless the region only consists of comments,
973 in which case call `uncomment-region'. If a prefix arg is given, it
974 is passed on to the respective function."
975 (interactive "*r\nP")
976 (funcall (if (save-excursion ;; check for already commented region
977 (goto-char beg)
978 (comment-forward (point-max))
979 (<= end (point)))
980 'uncomment-region 'comment-region)
981 beg end arg))
931 982
932 ;;;###autoload 983 ;;;###autoload
933 (defun comment-dwim (arg) 984 (defun comment-dwim (arg)
934 "Call the comment command you want (Do What I Mean). 985 "Call the comment command you want (Do What I Mean).
935 If the region is active and `transient-mark-mode' is on, call 986 If the region is active and `transient-mark-mode' is on, call
939 Else if a prefix ARG is specified, call `comment-kill'. 990 Else if a prefix ARG is specified, call `comment-kill'.
940 Else, call `comment-indent'." 991 Else, call `comment-indent'."
941 (interactive "*P") 992 (interactive "*P")
942 (comment-normalize-vars) 993 (comment-normalize-vars)
943 (if (region-active-p) ;mark-active transient-mark-mode) 994 (if (region-active-p) ;mark-active transient-mark-mode)
944 (let ((beg (min (point) (mark))) 995 (comment-or-uncomment-region (region-beginning) (region-end) arg)
945 (end (max (point) (mark))))
946 (if (save-excursion ;; check for already commented region
947 (goto-char beg)
948 (comment-forward (point-max))
949 (<= end (point)))
950 (uncomment-region beg end arg)
951 (comment-region beg end arg)))
952 (if (save-excursion (beginning-of-line) (not (looking-at "\\s-*$"))) 996 (if (save-excursion (beginning-of-line) (not (looking-at "\\s-*$")))
953 ;; FIXME: If there's no comment to kill on this line and ARG is 997 ;; FIXME: If there's no comment to kill on this line and ARG is
954 ;; specified, calling comment-kill is not very clever. 998 ;; specified, calling comment-kill is not very clever.
955 (if arg (comment-kill (and (integerp arg) arg)) (comment-indent)) 999 (if arg (comment-kill (and (integerp arg) arg)) (comment-indent))
956 (let ((add (if arg (prefix-numeric-value arg) 1000 (let ((add (if arg (prefix-numeric-value arg)
965 (indent-according-to-mode)))))) 1009 (indent-according-to-mode))))))
966 1010
967 (defcustom comment-auto-fill-only-comments nil 1011 (defcustom comment-auto-fill-only-comments nil
968 "Non-nil means to only auto-fill inside comments. 1012 "Non-nil means to only auto-fill inside comments.
969 This has no effect in modes that do not define a comment syntax." 1013 This has no effect in modes that do not define a comment syntax."
970 :type 'boolean 1014 :type 'boolean)
971 :group 'comment) 1015
1016 (defun comment-valid-prefix (prefix compos)
1017 (or
1018 ;; Accept any prefix if the current comment is not EOL-terminated.
1019 (save-excursion (goto-char compos) (comment-forward) (not (bolp)))
1020 ;; Accept any prefix that starts with a comment-start marker.
1021 (string-match (concat "\\`[ \t]*\\(?:" comment-start-skip "\\)")
1022 fill-prefix)))
972 1023
973 ;;;###autoload 1024 ;;;###autoload
974 (defun comment-indent-new-line (&optional soft) 1025 (defun comment-indent-new-line (&optional soft)
975 "Break line at point and indent, continuing comment if within one. 1026 "Break line at point and indent, continuing comment if within one.
976 This indents the body of the continued comment 1027 This indents the body of the continued comment
990 (let (compos comin) 1041 (let (compos comin)
991 ;; If we are not inside a comment and we only auto-fill comments, 1042 ;; If we are not inside a comment and we only auto-fill comments,
992 ;; don't do anything (unless no comment syntax is defined). 1043 ;; don't do anything (unless no comment syntax is defined).
993 (unless (and comment-start 1044 (unless (and comment-start
994 comment-auto-fill-only-comments 1045 comment-auto-fill-only-comments
1046 (not (interactive-p))
995 (not (save-excursion 1047 (not (save-excursion
996 (prog1 (setq compos (comment-beginning)) 1048 (prog1 (setq compos (comment-beginning))
997 (setq comin (point)))))) 1049 (setq comin (point))))))
998 1050
999 ;; Now we know we should auto-fill.
1000 ;; XEmacs: next 3 lines from old version. 1051 ;; XEmacs: next 3 lines from old version.
1001 (skip-chars-backward " \t") 1052 (skip-chars-backward " \t")
1002 (if (featurep 'mule) 1053 (if (featurep 'mule)
1003 (declare-fboundp (kinsoku-process))) 1054 (declare-fboundp (kinsoku-process)))
1055
1056 ;; Now we know we should auto-fill.
1057 ;; Insert the newline before removing empty space so that markers
1058 ;; get preserved better.
1059 (if soft (insert-and-inherit ?\n) (newline 1))
1060 (save-excursion (forward-char -1) (delete-horizontal-space))
1004 (delete-horizontal-space) 1061 (delete-horizontal-space)
1005 (if soft (insert-and-inherit ?\n) (newline 1)) 1062
1006 (if fill-prefix 1063 (if (and fill-prefix (not adaptive-fill-mode))
1064 ;; Blindly trust a non-adaptive fill-prefix.
1007 (progn 1065 (progn
1008 (indent-to-left-margin) 1066 (indent-to-left-margin)
1009 (insert-and-inherit fill-prefix)) 1067 (insert-before-markers-and-inherit fill-prefix))
1010 1068
1011 ;;#### jhod: probably need to fix this for kinsoku processing 1069 ;;#### jhod: probably need to fix this for kinsoku processing
1012 ;; If necessary check whether we're inside a comment. 1070 ;; If necessary check whether we're inside a comment.
1013 (unless (or comment-multi-line compos (null comment-start)) 1071 (unless (or compos (null comment-start))
1014 (save-excursion 1072 (save-excursion
1015 (backward-char) 1073 (backward-char)
1016 (setq compos (comment-beginning)) 1074 (setq compos (comment-beginning))
1017 (setq comin (point)))) 1075 (setq comin (point))))
1018 1076
1019 ;; If we're not inside a comment, just try to indent. 1077 (cond
1020 ;; #### XEmacs: the line `(if comcol' was changed as follows. 1078 ;; If there's an adaptive prefix, use it unless we're inside
1021 ;; I'm leaving it out since who knows if it's applicable any more. 1079 ;; a comment and the prefix is not a comment starter.
1022 ;; --ben 1080 ((and fill-prefix
1023 ;; (if (and comcol (not fill-prefix)) ; XEmacs - (ENE) from fa-extras. 1081 (or (not compos)
1024 (if (not compos) (indent-according-to-mode) 1082 (comment-valid-prefix fill-prefix compos)))
1083 (indent-to-left-margin)
1084 (insert-and-inherit fill-prefix))
1085 ;; If we're not inside a comment, just try to indent.
1086 ;; #### XEmacs: the line `(if comcol' was changed as follows.
1087 ;; I'm leaving it out since who knows if it's applicable any more.
1088 ;; --ben
1089 ;; (if (and comcol (not fill-prefix)) ; XEmacs - (ENE) from fa-extras.
1090 ((not compos) (indent-according-to-mode))
1091 (t
1025 (let* ((comment-column 1092 (let* ((comment-column
1026 ;; The continuation indentation should be somewhere between 1093 ;; The continuation indentation should be somewhere between
1027 ;; the current line's indentation (plus 2 for good measure) 1094 ;; the current line's indentation (plus 2 for good measure)
1028 ;; and the current comment's indentation, with a preference 1095 ;; and the current comment's indentation, with a preference
1029 ;; for comment-column. 1096 ;; for comment-column.
1030 (save-excursion 1097 (save-excursion
1098 ;; FIXME: use prev line's info rather than first line's.
1031 (goto-char compos) 1099 (goto-char compos)
1032 (min (current-column) (max comment-column 1100 (min (current-column) (max comment-column
1033 (+ 2 (current-indentation)))))) 1101 (+ 2 (current-indentation))))))
1034 (comstart (buffer-substring compos comin)) 1102 (comstart (buffer-substring compos comin))
1035 (normalp 1103 (normalp
1047 (buffer-substring 1115 (buffer-substring
1048 (save-excursion (comment-enter-backward) (point)) 1116 (save-excursion (comment-enter-backward) (point))
1049 (point)) 1117 (point))
1050 nil t))))) 1118 nil t)))))
1051 (comment-start comstart) 1119 (comment-start comstart)
1120 (continuep (or comment-multi-line
1121 (cadr (assoc comment-style comment-styles))))
1052 ;; Force comment-continue to be recreated from comment-start. 1122 ;; Force comment-continue to be recreated from comment-start.
1053 ;; FIXME: wrong if comment-continue was set explicitly! 1123 ;; FIXME: wrong if comment-continue was set explicitly!
1124 ;; FIXME: use prev line's continuation if available.
1054 (comment-continue nil)) 1125 (comment-continue nil))
1055 (insert-and-inherit ?\n) 1126 (if (and comment-multi-line (> (length comment-end) 0))
1056 (forward-char -1) 1127 (indent-according-to-mode)
1057 (comment-indent (cadr (assoc comment-style comment-styles))) 1128 (insert-and-inherit ?\n)
1058 (save-excursion 1129 (forward-char -1)
1059 (let ((pt (point))) 1130 (comment-indent continuep)
1060 (end-of-line) 1131 (save-excursion
1061 (let ((comend (buffer-substring pt (point)))) 1132 (let ((pt (point)))
1062 ;; The 1+ is to make sure we delete the \n inserted above. 1133 (end-of-line)
1063 (delete-region pt (1+ (point))) 1134 (let ((comend (buffer-substring pt (point))))
1064 (beginning-of-line) 1135 ;; The 1+ is to make sure we delete the \n inserted above.
1065 (backward-char) 1136 (delete-region pt (1+ (point)))
1066 (insert comend) 1137 (end-of-line 0)
1067 (forward-char)))))))))) 1138 (insert comend))))))))))))
1068 1139
1069 (provide 'newcomment) 1140 (provide 'newcomment)
1070 1141
1071 ;;; newcomment.el ends here 1142 ;;; newcomment.el ends here