5 |
;; Author: code extracted from Emacs-20's simple.el |
;; Author: code extracted from Emacs-20's simple.el |
6 |
;; Maintainer: Stefan Monnier <monnier@cs.yale.edu> |
;; Maintainer: Stefan Monnier <monnier@cs.yale.edu> |
7 |
;; Keywords: comment uncomment |
;; Keywords: comment uncomment |
|
;; Revision: $Id$ |
|
8 |
|
|
9 |
;; This file is part of GNU Emacs. |
;; This file is part of GNU Emacs. |
10 |
|
|
29 |
|
|
30 |
;;; Bugs: |
;;; Bugs: |
31 |
|
|
32 |
|
;; - boxed comments in Perl are not properly uncommented because they are |
33 |
|
;; uncommented one-line at a time. |
34 |
;; - nested comments in sgml-mode are not properly quoted. |
;; - nested comments in sgml-mode are not properly quoted. |
35 |
;; - single-char nestable comment-start can only do the "\\s<+" stuff |
;; - single-char nestable comment-start can only do the "\\s<+" stuff |
36 |
;; if the corresponding closing marker happens to be right. |
;; if the corresponding closing marker happens to be right. |
|
;; - comment-box in TeXinfo generate bogus comments @ccccc@ |
|
37 |
;; - uncomment-region with a numeric argument can render multichar |
;; - uncomment-region with a numeric argument can render multichar |
38 |
;; comment markers invalid. |
;; comment markers invalid. |
39 |
;; - comment-indent or comment-region when called inside a comment |
;; - comment-indent or comment-region when called inside a comment |
44 |
|
|
45 |
;;; Todo: |
;;; Todo: |
46 |
|
|
47 |
;; - quantized steps in comment-alignment |
;; - rebox.el-style refill. |
48 |
;; - try to align tail comments |
;; - quantized steps in comment-alignment. |
49 |
;; - check what c-comment-line-break-function has to say |
;; - try to align tail comments. |
50 |
;; - spill auto-fill of comments onto the end of the next line |
;; - check what c-comment-line-break-function has to say. |
51 |
|
;; - spill auto-fill of comments onto the end of the next line. |
52 |
;; - uncomment-region with a consp (for blocks) or somehow make the |
;; - uncomment-region with a consp (for blocks) or somehow make the |
53 |
;; deletion of continuation markers less dangerous |
;; deletion of continuation markers less dangerous. |
54 |
;; - drop block-comment-<foo> unless it's really used |
;; - drop block-comment-<foo> unless it's really used. |
55 |
;; - uncomment-region on a subpart of a comment |
;; - uncomment-region on a subpart of a comment. |
56 |
;; - support gnu-style "multi-line with space in continue" |
;; - support gnu-style "multi-line with space in continue". |
57 |
;; - somehow allow comment-dwim to use the region even if transient-mark-mode |
;; - somehow allow comment-dwim to use the region even if transient-mark-mode |
58 |
;; is not turned on. |
;; is not turned on. |
59 |
|
|
73 |
;;;###autoload |
;;;###autoload |
74 |
(defalias 'indent-new-comment-line 'comment-indent-new-line) |
(defalias 'indent-new-comment-line 'comment-indent-new-line) |
75 |
|
|
|
;;;###autoload |
|
76 |
(defgroup comment nil |
(defgroup comment nil |
77 |
"Indenting and filling of comments." |
"Indenting and filling of comments." |
78 |
:prefix "comment-" |
:prefix "comment-" |
240 |
;; (kill-local-variable 'comment-continue)) |
;; (kill-local-variable 'comment-continue)) |
241 |
) |
) |
242 |
;; comment-skip regexps |
;; comment-skip regexps |
243 |
(unless comment-start-skip |
(unless (and comment-start-skip |
244 |
|
;; In case comment-start has changed since last time. |
245 |
|
(string-match comment-start-skip comment-start)) |
246 |
(set (make-local-variable 'comment-start-skip) |
(set (make-local-variable 'comment-start-skip) |
247 |
(concat "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\)\\(\\s<+\\|" |
(concat "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\)\\(\\s<+\\|" |
248 |
(regexp-quote (comment-string-strip comment-start t t)) |
(regexp-quote (comment-string-strip comment-start t t)) |
249 |
;; Let's not allow any \s- but only [ \t] since \n |
;; Let's not allow any \s- but only [ \t] since \n |
250 |
;; might be both a comment-end marker and \s-. |
;; might be both a comment-end marker and \s-. |
251 |
"+\\)[ \t]*"))) |
"+\\)[ \t]*"))) |
252 |
(unless comment-end-skip |
(unless (and comment-end-skip |
253 |
|
;; In case comment-end has changed since last time. |
254 |
|
(string-match comment-end-skip comment-end)) |
255 |
(let ((ce (if (string= "" comment-end) "\n" |
(let ((ce (if (string= "" comment-end) "\n" |
256 |
(comment-string-strip comment-end t t)))) |
(comment-string-strip comment-end t t)))) |
257 |
(set (make-local-variable 'comment-end-skip) |
(set (make-local-variable 'comment-end-skip) |
262 |
(if (and comment-quote-nested (<= (length ce) 1)) "" "+") |
(if (and comment-quote-nested (<= (length ce) 1)) "" "+") |
263 |
(regexp-quote (substring ce 1)) |
(regexp-quote (substring ce 1)) |
264 |
"\\)")))))) |
"\\)")))))) |
265 |
|
|
266 |
(defun comment-quote-re (str unp) |
(defun comment-quote-re (str unp) |
267 |
(concat (regexp-quote (substring str 0 1)) |
(concat (regexp-quote (substring str 0 1)) |
268 |
"\\\\" (if unp "+" "*") |
"\\\\" (if unp "+" "*") |
473 |
;; are in column 0, so we first go to the likely target column. |
;; are in column 0, so we first go to the likely target column. |
474 |
(indent-to comment-column) |
(indent-to comment-column) |
475 |
(setq begpos (point)) |
(setq begpos (point)) |
476 |
|
;; Ensure there's a space before the comment for things |
477 |
|
;; like sh where it matters (as well as being neater). |
478 |
|
(unless (eq ?\ (char-syntax (char-before))) |
479 |
|
(insert ?\ )) |
480 |
(insert starter) |
(insert starter) |
481 |
(setq cpos (point-marker)) |
(setq cpos (point-marker)) |
482 |
(insert ender))) |
(insert ender))) |
616 |
|
|
617 |
;;;###autoload |
;;;###autoload |
618 |
(defun uncomment-region (beg end &optional arg) |
(defun uncomment-region (beg end &optional arg) |
619 |
"Uncomment each line in the BEG..END region. |
"Uncomment each line in the BEG .. END region. |
620 |
The numeric prefix ARG can specify a number of chars to remove from the |
The numeric prefix ARG can specify a number of chars to remove from the |
621 |
comment markers." |
comment markers." |
622 |
(interactive "*r\nP") |
(interactive "*r\nP") |
625 |
(save-excursion |
(save-excursion |
626 |
(goto-char beg) |
(goto-char beg) |
627 |
(setq end (copy-marker end)) |
(setq end (copy-marker end)) |
628 |
(let ((numarg (prefix-numeric-value arg)) |
(let* ((numarg (prefix-numeric-value arg)) |
629 |
spt) |
(ccs comment-continue) |
630 |
|
(srei (comment-padright ccs 're)) |
631 |
|
(sre (and srei (concat "^\\s-*?\\(" srei "\\)"))) |
632 |
|
spt) |
633 |
(while (and (< (point) end) |
(while (and (< (point) end) |
634 |
(setq spt (comment-search-forward end t))) |
(setq spt (comment-search-forward end t))) |
635 |
(let* ((ipt (point)) |
(let ((ipt (point)) |
636 |
;; Find the end of the comment. |
;; Find the end of the comment. |
637 |
(ept (progn |
(ept (progn |
638 |
(goto-char spt) |
(goto-char spt) |
639 |
(unless (comment-forward) |
(unless (comment-forward) |
640 |
(error "Can't find the comment end")) |
(error "Can't find the comment end")) |
641 |
(point))) |
(point))) |
642 |
(box nil) |
(box nil) |
643 |
(ccs comment-continue) |
(box-equal nil)) ;Whether we might be using `=' for boxes. |
|
(srei (comment-padright ccs 're)) |
|
|
(sre (and srei (concat "^\\s-*?\\(" srei "\\)")))) |
|
644 |
(save-restriction |
(save-restriction |
645 |
(narrow-to-region spt ept) |
(narrow-to-region spt ept) |
646 |
|
|
647 |
;; Remove the comment-start. |
;; Remove the comment-start. |
648 |
(goto-char ipt) |
(goto-char ipt) |
649 |
(skip-syntax-backward " ") |
(skip-syntax-backward " ") |
|
;; Check for special `=' used sometimes in comment-box. |
|
|
(when (and (= (- (point) (point-min)) 1) (looking-at "=\\{7\\}")) |
|
|
(skip-chars-forward "=")) |
|
650 |
;; A box-comment starts with a looong comment-start marker. |
;; A box-comment starts with a looong comment-start marker. |
651 |
(when (> (- (point) (point-min) (length comment-start)) 7) |
(when (and (or (and (= (- (point) (point-min)) 1) |
652 |
|
(setq box-equal t) |
653 |
|
(looking-at "=\\{7\\}") |
654 |
|
(not (eq (char-before (point-max)) ?\n)) |
655 |
|
(skip-chars-forward "=")) |
656 |
|
(> (- (point) (point-min) (length comment-start)) 7)) |
657 |
|
(> (count-lines (point-min) (point-max)) 2)) |
658 |
(setq box t)) |
(setq box t)) |
659 |
(when (looking-at (regexp-quote comment-padding)) |
(when (looking-at (regexp-quote comment-padding)) |
660 |
(goto-char (match-end 0))) |
(goto-char (match-end 0))) |
667 |
;; Remove the end-comment (and leading padding and such). |
;; Remove the end-comment (and leading padding and such). |
668 |
(goto-char (point-max)) (comment-enter-backward) |
(goto-char (point-max)) (comment-enter-backward) |
669 |
;; Check for special `=' used sometimes in comment-box. |
;; Check for special `=' used sometimes in comment-box. |
670 |
(when (= (- (point-max) (point)) 1) |
(when (and box-equal (not (eq (char-before (point-max)) ?\n))) |
671 |
(let ((pos (point))) |
(let ((pos (point))) |
672 |
;; skip `=' but only if there are at least 7. |
;; skip `=' but only if there are at least 7. |
673 |
(when (> (skip-chars-backward "=") -7) (goto-char pos)))) |
(when (> (skip-chars-backward "=") -7) (goto-char pos)))) |
716 |
(s (concat cs "a=m" cce)) |
(s (concat cs "a=m" cce)) |
717 |
(e (concat ccs "a=m" ce)) |
(e (concat ccs "a=m" ce)) |
718 |
(c (if (string-match ".*\\S-\\S-" cs) |
(c (if (string-match ".*\\S-\\S-" cs) |
719 |
(aref cs (1- (match-end 0))) ?=)) |
(aref cs (1- (match-end 0))) |
720 |
(_ (string-match "\\s-*a=m\\s-*" s)) |
(if (and (equal comment-end "") (string-match ".*\\S-" cs)) |
721 |
|
(aref cs (1- (match-end 0))) ?=))) |
722 |
|
(re "\\s-*a=m\\s-*") |
723 |
|
(_ (string-match re s)) |
724 |
|
(lcs (length cs)) |
725 |
(fill |
(fill |
726 |
(make-string (+ width (- (match-end 0) |
(make-string (+ width (- (match-end 0) |
727 |
(match-beginning 0) (length cs) 3)) c))) |
(match-beginning 0) lcs 3)) c))) |
728 |
(setq cs (replace-match fill t t s)) |
(setq cs (replace-match fill t t s)) |
729 |
(string-match "\\s-*a=m\\s-*" e) |
(when (and (not (string-match comment-start-skip cs)) |
730 |
|
(string-match "a=m" s)) |
731 |
|
;; The whitespace around CS cannot be ignored: put it back. |
732 |
|
(setq re "a=m") |
733 |
|
(setq fill (make-string (- width lcs) c)) |
734 |
|
(setq cs (replace-match fill t t s))) |
735 |
|
(string-match re e) |
736 |
(setq ce (replace-match fill t t e)))) |
(setq ce (replace-match fill t t e)))) |
737 |
(cons (concat cs "\n" (make-string min-indent ? ) ccs) |
(cons (concat cs "\n" (make-string min-indent ? ) ccs) |
738 |
(concat cce "\n" (make-string (+ min-indent eindent) ? ) ce)))) |
(concat cce "\n" (make-string (+ min-indent eindent) ? ) ce)))) |
739 |
|
|
|
(def-edebug-spec comment-with-narrowing t) |
|
|
(put 'comment-with-narrowing 'lisp-indent-function 2) |
|
740 |
(defmacro comment-with-narrowing (beg end &rest body) |
(defmacro comment-with-narrowing (beg end &rest body) |
741 |
"Execute BODY with BEG..END narrowing. |
"Execute BODY with BEG..END narrowing. |
742 |
Space is added (and then removed) at the beginning for the text's |
Space is added (and then removed) at the beginning for the text's |
743 |
indentation to be kept as it was before narrowing." |
indentation to be kept as it was before narrowing." |
744 |
|
(declare (debug t) (indent 2)) |
745 |
(let ((bindent (make-symbol "bindent"))) |
(let ((bindent (make-symbol "bindent"))) |
746 |
`(let ((,bindent (save-excursion (goto-char beg) (current-column)))) |
`(let ((,bindent (save-excursion (goto-char beg) (current-column)))) |
747 |
(save-restriction |
(save-restriction |
768 |
|
|
769 |
(defun comment-region-internal (beg end cs ce |
(defun comment-region-internal (beg end cs ce |
770 |
&optional ccs cce block lines indent) |
&optional ccs cce block lines indent) |
771 |
"Comment region BEG..END. |
"Comment region BEG .. END. |
772 |
CS and CE are the comment start resp end string. |
CS and CE are the comment start resp end string. |
773 |
CCS and CCE are the comment continuation strings for the start resp end |
CCS and CCE are the comment continuation strings for the start resp end |
774 |
of lines (default to CS and CE). |
of lines (default to CS and CE). |
793 |
(unless block (setq cce nil)) |
(unless block (setq cce nil)) |
794 |
;; Continuation defaults to the same as CS and CE. |
;; Continuation defaults to the same as CS and CE. |
795 |
(unless ccs (setq ccs cs cce ce)) |
(unless ccs (setq ccs cs cce ce)) |
796 |
|
|
797 |
(save-excursion |
(save-excursion |
798 |
(goto-char end) |
(goto-char end) |
799 |
;; If the end is not at the end of a line and the comment-end |
;; If the end is not at the end of a line and the comment-end |
815 |
(end-of-line) |
(end-of-line) |
816 |
(setq max-indent (max max-indent (current-column))) |
(setq max-indent (max max-indent (current-column))) |
817 |
(not (or (eobp) (progn (forward-line) nil))))) |
(not (or (eobp) (progn (forward-line) nil))))) |
818 |
|
|
819 |
;; Inserting ccs can change max-indent by (1- tab-width). |
;; Inserting ccs can change max-indent by (1- tab-width). |
820 |
(setq max-indent |
(setq max-indent |
821 |
(+ max-indent (max (length cs) (length ccs)) tab-width -1)) |
(+ max-indent (max (length cs) (length ccs)) tab-width -1)) |
828 |
cs ce ccs cce min-indent max-indent block))) |
cs ce ccs cce min-indent max-indent block))) |
829 |
(setq cs (car csce)) |
(setq cs (car csce)) |
830 |
(setq ce (cdr csce)))) |
(setq ce (cdr csce)))) |
831 |
|
|
832 |
(goto-char (point-min)) |
(goto-char (point-min)) |
833 |
;; Loop over all lines from BEG to END. |
;; Loop over all lines from BEG to END. |
834 |
(while |
(while |
847 |
;;;###autoload |
;;;###autoload |
848 |
(defun comment-region (beg end &optional arg) |
(defun comment-region (beg end &optional arg) |
849 |
"Comment or uncomment each line in the region. |
"Comment or uncomment each line in the region. |
850 |
With just \\[universal-argument] prefix arg, uncomment each line in region BEG..END. |
With just \\[universal-argument] prefix arg, uncomment each line in region BEG .. END. |
851 |
Numeric prefix arg ARG means use ARG comment characters. |
Numeric prefix arg ARG means use ARG comment characters. |
852 |
If ARG is negative, delete that many comment characters instead. |
If ARG is negative, delete that many comment characters instead. |
853 |
By default, comments start at the left margin, are terminated on each line, |
By default, comments start at the left margin, are terminated on each line, |
884 |
(>= (point) beg)) |
(>= (point) beg)) |
885 |
(progn (goto-char end) (end-of-line) (skip-syntax-backward " ") |
(progn (goto-char end) (end-of-line) (skip-syntax-backward " ") |
886 |
(<= (point) end)) |
(<= (point) end)) |
887 |
(or (not (string= "" comment-end)) block) |
(or block (not (string= "" comment-end))) |
888 |
(progn (goto-char beg) (search-forward "\n" end t))))) |
(or block (progn (goto-char beg) (search-forward "\n" end t)))))) |
889 |
|
|
890 |
;; don't add end-markers just because the user asked for `block' |
;; don't add end-markers just because the user asked for `block' |
891 |
(unless (or lines (string= "" comment-end)) (setq block nil)) |
(unless (or lines (string= "" comment-end)) (setq block nil)) |
911 |
(nth 3 style)))))) |
(nth 3 style)))))) |
912 |
|
|
913 |
(defun comment-box (beg end &optional arg) |
(defun comment-box (beg end &optional arg) |
914 |
"Comment out the BEG..END region, putting it inside a box. |
"Comment out the BEG .. END region, putting it inside a box. |
915 |
The numeric prefix ARG specifies how many characters to add to begin- and |
The numeric prefix ARG specifies how many characters to add to begin- and |
916 |
end- comment markers additionally to what `comment-add' already specifies." |
end- comment markers additionally to what `comment-add' already specifies." |
917 |
(interactive "*r\np") |
(interactive "*r\np") |