/[emacs]/emacs/lisp/newcomment.el
ViewVC logotype

Diff of /emacs/lisp/newcomment.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.48.2.9 by miles, Tue Jul 6 10:17:17 2004 UTC revision 1.48.2.10 by miles, Thu Sep 16 00:12:21 2004 UTC
# Line 1  Line 1 
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>
# Line 137  The function has no args. Line 137  The function has no args.
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'.
# Line 145  guaranteed to be correctly ordered.  It Line 145  guaranteed to be correctly ordered.  It
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'.
# Line 368  and raises an error or returns nil if NO Line 368  and raises an error or returns nil if NO
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.
# Line 710  comment markers." Line 710  comment markers."
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.
# Line 966  The strings used as comment starts are b Line 974  The strings used as comment starts are b
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.
# Line 1193  unless optional argument SOFT is non-nil Line 1203  unless optional argument SOFT is non-nil
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

Legend:
Removed from v.1.48.2.9  
changed lines
  Added in v.1.48.2.10

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26