1 |
;;; newcomment.el --- (un)comment regions of buffers |
;;; newcomment.el --- (un)comment regions of buffers |
2 |
|
|
3 |
;; Copyright (C) 1999,2000,2003,2004 Free Software Foundation Inc. |
;; Copyright (C) 1999, 2000, 2003, 2004 Free Software Foundation Inc. |
4 |
|
|
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> |
137 |
Applicable at least in modes for languages like fixed-format Fortran where |
Applicable at least in modes for languages like fixed-format Fortran where |
138 |
comments always start in column zero.") |
comments always start in column zero.") |
139 |
|
|
140 |
(defvar comment-region-function nil |
(defvar comment-region-function 'comment-region-default |
141 |
"Function to comment a region. |
"Function to comment a region. |
142 |
Its args are the same as those of `comment-region', but BEG and END are |
Its args are the same as those of `comment-region', but BEG and END are |
143 |
guaranteed to be correctly ordered. It is called within `save-excursion'. |
guaranteed to be correctly ordered. It is called within `save-excursion'. |
145 |
Applicable at least in modes for languages like fixed-format Fortran where |
Applicable at least in modes for languages like fixed-format Fortran where |
146 |
comments always start in column zero.") |
comments always start in column zero.") |
147 |
|
|
148 |
(defvar uncomment-region-function nil |
(defvar uncomment-region-function 'uncomment-region-default |
149 |
"Function to uncomment a region. |
"Function to uncomment a region. |
150 |
Its args are the same as those of `uncomment-region', but BEG and END are |
Its args are the same as those of `uncomment-region', but BEG and END are |
151 |
guaranteed to be correctly ordered. It is called within `save-excursion'. |
guaranteed to be correctly ordered. It is called within `save-excursion'. |
368 |
(if comment-use-global-state (syntax-ppss pt)) |
(if comment-use-global-state (syntax-ppss pt)) |
369 |
t))) |
t))) |
370 |
(when (and (nth 8 s) (nth 3 s) (not comment-use-global-state)) |
(when (and (nth 8 s) (nth 3 s) (not comment-use-global-state)) |
371 |
;; The search ended inside a string. Try to see if it |
;; The search ended at eol inside a string. Try to see if it |
372 |
;; works better when we assume that pt is inside a string. |
;; works better when we assume that pt is inside a string. |
373 |
(setq s (parse-partial-sexp |
(setq s (parse-partial-sexp |
374 |
pt (or limit (point-max)) nil nil |
pt (or limit (point-max)) nil nil |
375 |
(list nil nil nil (nth 3 s) nil nil nil nil) |
(list nil nil nil (nth 3 s) nil nil nil nil) |
376 |
t))) |
t))) |
377 |
(if (not (and (nth 8 s) (not (nth 3 s)))) |
(if (not (and (nth 8 s) (not (nth 3 s)))) |
378 |
(unless noerror (error "No comment")) |
(unless noerror (error "No comment")) |
379 |
;; We found the comment. |
;; We found the comment. |
710 |
(interactive "*r\nP") |
(interactive "*r\nP") |
711 |
(comment-normalize-vars) |
(comment-normalize-vars) |
712 |
(when (> beg end) (setq beg (prog1 end (setq end beg)))) |
(when (> beg end) (setq beg (prog1 end (setq end beg)))) |
713 |
(save-excursion |
;; Bind `comment-use-global-state' to nil. While uncommenting a region |
714 |
(if uncomment-region-function |
;; (which works a line at a time), a comment can appear to be |
715 |
(funcall uncomment-region-function beg end arg) |
;; included in a mult-line string, but it is actually not. |
716 |
(goto-char beg) |
(let ((comment-use-global-state nil)) |
717 |
(setq end (copy-marker end)) |
(save-excursion |
718 |
(let* ((numarg (prefix-numeric-value arg)) |
(funcall uncomment-region-function beg end arg)))) |
|
(ccs comment-continue) |
|
|
(srei (comment-padright ccs 're)) |
|
|
(csre (comment-padright comment-start 're)) |
|
|
(sre (and srei (concat "^\\s-*?\\(" srei "\\)"))) |
|
|
spt) |
|
|
(while (and (< (point) end) |
|
|
(setq spt (comment-search-forward end t))) |
|
|
(let ((ipt (point)) |
|
|
;; Find the end of the comment. |
|
|
(ept (progn |
|
|
(goto-char spt) |
|
|
(unless (or (comment-forward) |
|
|
;; Allow non-terminated comments. |
|
|
(eobp)) |
|
|
(error "Can't find the comment end")) |
|
|
(point))) |
|
|
(box nil) |
|
|
(box-equal nil)) ;Whether we might be using `=' for boxes. |
|
|
(save-restriction |
|
|
(narrow-to-region spt ept) |
|
719 |
|
|
720 |
;; Remove the comment-start. |
(defun uncomment-region-default (beg end &optional arg) |
721 |
(goto-char ipt) |
"Uncomment each line in the BEG .. END region. |
722 |
(skip-syntax-backward " ") |
The numeric prefix ARG can specify a number of chars to remove from the |
723 |
;; A box-comment starts with a looong comment-start marker. |
comment markers." |
724 |
(when (and (or (and (= (- (point) (point-min)) 1) |
(goto-char beg) |
725 |
(setq box-equal t) |
(setq end (copy-marker end)) |
726 |
(looking-at "=\\{7\\}") |
(let* ((numarg (prefix-numeric-value arg)) |
727 |
(not (eq (char-before (point-max)) ?\n)) |
(ccs comment-continue) |
728 |
(skip-chars-forward "=")) |
(srei (comment-padright ccs 're)) |
729 |
(> (- (point) (point-min) (length comment-start)) 7)) |
(csre (comment-padright comment-start 're)) |
730 |
(> (count-lines (point-min) (point-max)) 2)) |
(sre (and srei (concat "^\\s-*?\\(" srei "\\)"))) |
731 |
(setq box t)) |
spt) |
732 |
;; Skip the padding. Padding can come from comment-padding and/or |
(while (and (< (point) end) |
733 |
;; from comment-start, so we first check comment-start. |
(setq spt (comment-search-forward end t))) |
734 |
(if (or (save-excursion (goto-char (point-min)) (looking-at csre)) |
(let ((ipt (point)) |
735 |
(looking-at (regexp-quote comment-padding))) |
;; Find the end of the comment. |
736 |
(goto-char (match-end 0))) |
(ept (progn |
737 |
(when (and sre (looking-at (concat "\\s-*\n\\s-*" srei))) |
(goto-char spt) |
738 |
|
(unless (or (comment-forward) |
739 |
|
;; Allow non-terminated comments. |
740 |
|
(eobp)) |
741 |
|
(error "Can't find the comment end")) |
742 |
|
(point))) |
743 |
|
(box nil) |
744 |
|
(box-equal nil)) ;Whether we might be using `=' for boxes. |
745 |
|
(save-restriction |
746 |
|
(narrow-to-region spt ept) |
747 |
|
|
748 |
|
;; Remove the comment-start. |
749 |
|
(goto-char ipt) |
750 |
|
(skip-syntax-backward " ") |
751 |
|
;; A box-comment starts with a looong comment-start marker. |
752 |
|
(when (and (or (and (= (- (point) (point-min)) 1) |
753 |
|
(setq box-equal t) |
754 |
|
(looking-at "=\\{7\\}") |
755 |
|
(not (eq (char-before (point-max)) ?\n)) |
756 |
|
(skip-chars-forward "=")) |
757 |
|
(> (- (point) (point-min) (length comment-start)) 7)) |
758 |
|
(> (count-lines (point-min) (point-max)) 2)) |
759 |
|
(setq box t)) |
760 |
|
;; Skip the padding. Padding can come from comment-padding and/or |
761 |
|
;; from comment-start, so we first check comment-start. |
762 |
|
(if (or (save-excursion (goto-char (point-min)) (looking-at csre)) |
763 |
|
(looking-at (regexp-quote comment-padding))) |
764 |
(goto-char (match-end 0))) |
(goto-char (match-end 0))) |
765 |
(if (null arg) (delete-region (point-min) (point)) |
(when (and sre (looking-at (concat "\\s-*\n\\s-*" srei))) |
766 |
(skip-syntax-backward " ") |
(goto-char (match-end 0))) |
767 |
(delete-char (- numarg)) |
(if (null arg) (delete-region (point-min) (point)) |
768 |
(unless (or (bobp) |
(skip-syntax-backward " ") |
769 |
(save-excursion (goto-char (point-min)) |
(delete-char (- numarg)) |
770 |
(looking-at comment-start-skip))) |
(unless (or (bobp) |
771 |
;; If there's something left but it doesn't look like |
(save-excursion (goto-char (point-min)) |
772 |
;; a comment-start any more, just remove it. |
(looking-at comment-start-skip))) |
773 |
(delete-region (point-min) (point)))) |
;; If there's something left but it doesn't look like |
774 |
|
;; a comment-start any more, just remove it. |
775 |
;; Remove the end-comment (and leading padding and such). |
(delete-region (point-min) (point)))) |
776 |
(goto-char (point-max)) (comment-enter-backward) |
|
777 |
;; Check for special `=' used sometimes in comment-box. |
;; Remove the end-comment (and leading padding and such). |
778 |
(when (and box-equal (not (eq (char-before (point-max)) ?\n))) |
(goto-char (point-max)) (comment-enter-backward) |
779 |
(let ((pos (point))) |
;; Check for special `=' used sometimes in comment-box. |
780 |
;; skip `=' but only if there are at least 7. |
(when (and box-equal (not (eq (char-before (point-max)) ?\n))) |
781 |
(when (> (skip-chars-backward "=") -7) (goto-char pos)))) |
(let ((pos (point))) |
782 |
(unless (looking-at "\\(\n\\|\\s-\\)*\\'") |
;; skip `=' but only if there are at least 7. |
783 |
(when (and (bolp) (not (bobp))) (backward-char)) |
(when (> (skip-chars-backward "=") -7) (goto-char pos)))) |
784 |
(if (null arg) (delete-region (point) (point-max)) |
(unless (looking-at "\\(\n\\|\\s-\\)*\\'") |
785 |
(skip-syntax-forward " ") |
(when (and (bolp) (not (bobp))) (backward-char)) |
786 |
(delete-char numarg) |
(if (null arg) (delete-region (point) (point-max)) |
787 |
(unless (or (eobp) (looking-at comment-end-skip)) |
(skip-syntax-forward " ") |
788 |
;; If there's something left but it doesn't look like |
(delete-char numarg) |
789 |
;; a comment-end any more, just remove it. |
(unless (or (eobp) (looking-at comment-end-skip)) |
790 |
(delete-region (point) (point-max))))) |
;; If there's something left but it doesn't look like |
791 |
|
;; a comment-end any more, just remove it. |
792 |
;; Unquote any nested end-comment. |
(delete-region (point) (point-max))))) |
793 |
(comment-quote-nested comment-start comment-end t) |
|
794 |
|
;; Unquote any nested end-comment. |
795 |
;; Eliminate continuation markers as well. |
(comment-quote-nested comment-start comment-end t) |
796 |
(when sre |
|
797 |
(let* ((cce (comment-string-reverse (or comment-continue |
;; Eliminate continuation markers as well. |
798 |
comment-start))) |
(when sre |
799 |
(erei (and box (comment-padleft cce 're))) |
(let* ((cce (comment-string-reverse (or comment-continue |
800 |
(ere (and erei (concat "\\(" erei "\\)\\s-*$")))) |
comment-start))) |
801 |
(goto-char (point-min)) |
(erei (and box (comment-padleft cce 're))) |
802 |
(while (progn |
(ere (and erei (concat "\\(" erei "\\)\\s-*$")))) |
803 |
(if (and ere (re-search-forward |
(goto-char (point-min)) |
804 |
ere (line-end-position) t)) |
(while (progn |
805 |
(replace-match "" t t nil (if (match-end 2) 2 1)) |
(if (and ere (re-search-forward |
806 |
(setq ere nil)) |
ere (line-end-position) t)) |
807 |
(forward-line 1) |
(replace-match "" t t nil (if (match-end 2) 2 1)) |
808 |
(re-search-forward sre (line-end-position) t)) |
(setq ere nil)) |
809 |
(replace-match "" t t nil (if (match-end 2) 2 1))))) |
(forward-line 1) |
810 |
;; Go to the end for the next comment. |
(re-search-forward sre (line-end-position) t)) |
811 |
(goto-char (point-max))))))) |
(replace-match "" t t nil (if (match-end 2) 2 1))))) |
812 |
(set-marker end nil))) |
;; Go to the end for the next comment. |
813 |
|
(goto-char (point-max)))))) |
814 |
|
(set-marker end nil)) |
815 |
|
|
816 |
(defun comment-make-extra-lines (cs ce ccs cce min-indent max-indent &optional block) |
(defun comment-make-extra-lines (cs ce ccs cce min-indent max-indent &optional block) |
817 |
"Make the leading and trailing extra lines. |
"Make the leading and trailing extra lines. |
974 |
(interactive "*r\nP") |
(interactive "*r\nP") |
975 |
(comment-normalize-vars) |
(comment-normalize-vars) |
976 |
(if (> beg end) (let (mid) (setq mid beg beg end end mid))) |
(if (> beg end) (let (mid) (setq mid beg beg end end mid))) |
977 |
|
(save-excursion |
978 |
|
;; FIXME: maybe we should call uncomment depending on ARG. |
979 |
|
(funcall comment-region-function beg end arg))) |
980 |
|
|
981 |
|
(defun comment-region-default (beg end &optional arg) |
982 |
(let* ((numarg (prefix-numeric-value arg)) |
(let* ((numarg (prefix-numeric-value arg)) |
983 |
(add comment-add) |
(add comment-add) |
984 |
(style (cdr (assoc comment-style comment-styles))) |
(style (cdr (assoc comment-style comment-styles))) |
985 |
(lines (nth 2 style)) |
(lines (nth 2 style)) |
986 |
(block (nth 1 style)) |
(block (nth 1 style)) |
987 |
(multi (nth 0 style))) |
(multi (nth 0 style))) |
988 |
(save-excursion |
;; we use `chars' instead of `syntax' because `\n' might be |
989 |
(if comment-region-function |
;; of end-comment syntax rather than of whitespace syntax. |
990 |
(funcall comment-region-function beg end arg) |
;; sanitize BEG and END |
991 |
;; we use `chars' instead of `syntax' because `\n' might be |
(goto-char beg) (skip-chars-forward " \t\n\r") (beginning-of-line) |
992 |
;; of end-comment syntax rather than of whitespace syntax. |
(setq beg (max beg (point))) |
993 |
;; sanitize BEG and END |
(goto-char end) (skip-chars-backward " \t\n\r") (end-of-line) |
994 |
(goto-char beg) (skip-chars-forward " \t\n\r") (beginning-of-line) |
(setq end (min end (point))) |
995 |
(setq beg (max beg (point))) |
(if (>= beg end) (error "Nothing to comment")) |
996 |
(goto-char end) (skip-chars-backward " \t\n\r") (end-of-line) |
|
997 |
(setq end (min end (point))) |
;; sanitize LINES |
998 |
(if (>= beg end) (error "Nothing to comment")) |
(setq lines |
999 |
|
(and |
1000 |
;; sanitize LINES |
lines ;; multi |
1001 |
(setq lines |
(progn (goto-char beg) (beginning-of-line) |
1002 |
(and |
(skip-syntax-forward " ") |
1003 |
lines ;; multi |
(>= (point) beg)) |
1004 |
(progn (goto-char beg) (beginning-of-line) |
(progn (goto-char end) (end-of-line) (skip-syntax-backward " ") |
1005 |
(skip-syntax-forward " ") |
(<= (point) end)) |
1006 |
(>= (point) beg)) |
(or block (not (string= "" comment-end))) |
1007 |
(progn (goto-char end) (end-of-line) (skip-syntax-backward " ") |
(or block (progn (goto-char beg) (search-forward "\n" end t))))) |
1008 |
(<= (point) end)) |
|
1009 |
(or block (not (string= "" comment-end))) |
;; don't add end-markers just because the user asked for `block' |
1010 |
(or block (progn (goto-char beg) (search-forward "\n" end t)))))) |
(unless (or lines (string= "" comment-end)) (setq block nil)) |
1011 |
|
|
1012 |
;; don't add end-markers just because the user asked for `block' |
(cond |
1013 |
(unless (or lines (string= "" comment-end)) (setq block nil)) |
((consp arg) (uncomment-region beg end)) |
1014 |
|
((< numarg 0) (uncomment-region beg end (- numarg))) |
1015 |
(cond |
(t |
1016 |
((consp arg) (uncomment-region beg end)) |
(setq numarg (if (and (null arg) (= (length comment-start) 1)) |
1017 |
((< numarg 0) (uncomment-region beg end (- numarg))) |
add (1- numarg))) |
1018 |
(t |
(comment-region-internal |
1019 |
(setq numarg (if (and (null arg) (= (length comment-start) 1)) |
beg end |
1020 |
add (1- numarg))) |
(let ((s (comment-padright comment-start numarg))) |
1021 |
(comment-region-internal |
(if (string-match comment-start-skip s) s |
1022 |
beg end |
(comment-padright comment-start))) |
1023 |
(let ((s (comment-padright comment-start numarg))) |
(let ((s (comment-padleft comment-end numarg))) |
1024 |
(if (string-match comment-start-skip s) s |
(and s (if (string-match comment-end-skip s) s |
1025 |
(comment-padright comment-start))) |
(comment-padright comment-end)))) |
1026 |
(let ((s (comment-padleft comment-end numarg))) |
(if multi (comment-padright comment-continue numarg)) |
1027 |
(and s (if (string-match comment-end-skip s) s |
(if multi |
1028 |
(comment-padright comment-end)))) |
(comment-padleft (comment-string-reverse comment-continue) numarg)) |
1029 |
(if multi (comment-padright comment-continue numarg)) |
block |
1030 |
(if multi |
lines |
1031 |
(comment-padleft (comment-string-reverse comment-continue) numarg)) |
(nth 3 style)))))) |
|
block |
|
|
lines |
|
|
(nth 3 style))))))) |
|
1032 |
|
|
1033 |
(defun comment-box (beg end &optional arg) |
(defun comment-box (beg end &optional arg) |
1034 |
"Comment out the BEG .. END region, putting it inside a box. |
"Comment out the BEG .. END region, putting it inside a box. |
1203 |
|
|
1204 |
(provide 'newcomment) |
(provide 'newcomment) |
1205 |
|
|
1206 |
;;; arch-tag: 01e3320a-00c8-44ea-a696-8f8e7354c858 |
;; arch-tag: 01e3320a-00c8-44ea-a696-8f8e7354c858 |
1207 |
;;; newcomment.el ends here |
;;; newcomment.el ends here |