Mercurial > hg > xemacs-beta
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 |