/[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.78 by eliz, Sat Sep 4 12:30:24 2004 UTC revision 1.79 by monnier, Tue Sep 7 05:18:49 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      ;; Bind `comment-use-global-state' to nil.  While uncommenting a region
714    ;; Bind `comment-use-global-state' to nil. While uncommenting a    ;; (which works a line at a time), a comment can appear to be
   ;; (which works a line at a time) region a comment can appear to be  
715    ;; included in a mult-line string, but it is actually not.    ;; included in a mult-line string, but it is actually not.
716    (let ((comment-use-global-state nil))    (let ((comment-use-global-state nil))
717      (save-excursion      (save-excursion
718        (if uncomment-region-function        (funcall uncomment-region-function beg end arg))))
719            (funcall uncomment-region-function beg end arg)  
720          (goto-char beg)  (defun uncomment-region-default (beg end &optional arg)
721          (setq end (copy-marker end))    "Uncomment each line in the BEG .. END region.
722          (let* ((numarg (prefix-numeric-value arg))  The numeric prefix ARG can specify a number of chars to remove from the
723                 (ccs comment-continue)  comment markers."
724                 (srei (comment-padright ccs 're))    (goto-char beg)
725                 (csre (comment-padright comment-start 're))    (setq end (copy-marker end))
726                 (sre (and srei (concat "^\\s-*?\\(" srei "\\)")))    (let* ((numarg (prefix-numeric-value arg))
727                 spt)           (ccs comment-continue)
728            (while (and (< (point) end)           (srei (comment-padright ccs 're))
729                        (setq spt (comment-search-forward end t)))           (csre (comment-padright comment-start 're))
730              (let ((ipt (point))           (sre (and srei (concat "^\\s-*?\\(" srei "\\)")))
731                    ;; Find the end of the comment.           spt)
732                    (ept (progn      (while (and (< (point) end)
733                           (goto-char spt)                  (setq spt (comment-search-forward end t)))
734                           (unless (or (comment-forward)        (let ((ipt (point))
735                                       ;; Allow non-terminated comments.              ;; Find the end of the comment.
736                                       (eobp))              (ept (progn
737                             (error "Can't find the comment end"))                     (goto-char spt)
738                           (point)))                     (unless (or (comment-forward)
739                    (box nil)                                 ;; Allow non-terminated comments.
740                    (box-equal nil)) ;Whether we might be using `=' for boxes.                                 (eobp))
741                (save-restriction                       (error "Can't find the comment end"))
742                  (narrow-to-region spt ept)                     (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.            ;; Remove the comment-start.
749                  (goto-char ipt)            (goto-char ipt)
750                  (skip-syntax-backward " ")            (skip-syntax-backward " ")
751                  ;; A box-comment starts with a looong comment-start marker.            ;; A box-comment starts with a looong comment-start marker.
752                  (when (and (or (and (= (- (point) (point-min)) 1)            (when (and (or (and (= (- (point) (point-min)) 1)
753                                      (setq box-equal t)                                (setq box-equal t)
754                                      (looking-at "=\\{7\\}")                                (looking-at "=\\{7\\}")
755                                      (not (eq (char-before (point-max)) ?\n))                                (not (eq (char-before (point-max)) ?\n))
756                                      (skip-chars-forward "="))                                (skip-chars-forward "="))
757                                 (> (- (point) (point-min) (length comment-start)) 7))                           (> (- (point) (point-min) (length comment-start)) 7))
758                             (> (count-lines (point-min) (point-max)) 2))                       (> (count-lines (point-min) (point-max)) 2))
759                    (setq box t))              (setq box t))
760                  ;; Skip the padding.  Padding can come from comment-padding and/or            ;; Skip the padding.  Padding can come from comment-padding and/or
761                  ;; from comment-start, so we first check comment-start.            ;; from comment-start, so we first check comment-start.
762                  (if (or (save-excursion (goto-char (point-min)) (looking-at csre))            (if (or (save-excursion (goto-char (point-min)) (looking-at csre))
763                          (looking-at (regexp-quote comment-padding)))                    (looking-at (regexp-quote comment-padding)))
764                      (goto-char (match-end 0)))                (goto-char (match-end 0)))
765                  (when (and sre (looking-at (concat "\\s-*\n\\s-*" srei)))            (when (and sre (looking-at (concat "\\s-*\n\\s-*" srei)))
766                    (goto-char (match-end 0)))              (goto-char (match-end 0)))
767                  (if (null arg) (delete-region (point-min) (point))            (if (null arg) (delete-region (point-min) (point))
768                    (skip-syntax-backward " ")              (skip-syntax-backward " ")
769                    (delete-char (- numarg))              (delete-char (- numarg))
770                    (unless (or (bobp)              (unless (or (bobp)
771                                (save-excursion (goto-char (point-min))                          (save-excursion (goto-char (point-min))
772                                                (looking-at comment-start-skip)))                                          (looking-at comment-start-skip)))
773                      ;; If there's something left but it doesn't look like                ;; If there's something left but it doesn't look like
774                      ;; a comment-start any more, just remove it.                ;; a comment-start any more, just remove it.
775                      (delete-region (point-min) (point))))                (delete-region (point-min) (point))))
776                                    
777                  ;; Remove the end-comment (and leading padding and such).            ;; Remove the end-comment (and leading padding and such).
778                  (goto-char (point-max)) (comment-enter-backward)            (goto-char (point-max)) (comment-enter-backward)
779                  ;; Check for special `=' used sometimes in comment-box.            ;; Check for special `=' used sometimes in comment-box.
780                  (when (and box-equal (not (eq (char-before (point-max)) ?\n)))            (when (and box-equal (not (eq (char-before (point-max)) ?\n)))
781                    (let ((pos (point)))              (let ((pos (point)))
782                      ;; skip `=' but only if there are at least 7.                ;; skip `=' but only if there are at least 7.
783                      (when (> (skip-chars-backward "=") -7) (goto-char pos))))                (when (> (skip-chars-backward "=") -7) (goto-char pos))))
784                  (unless (looking-at "\\(\n\\|\\s-\\)*\\'")            (unless (looking-at "\\(\n\\|\\s-\\)*\\'")
785                    (when (and (bolp) (not (bobp))) (backward-char))              (when (and (bolp) (not (bobp))) (backward-char))
786                    (if (null arg) (delete-region (point) (point-max))              (if (null arg) (delete-region (point) (point-max))
787                      (skip-syntax-forward " ")                (skip-syntax-forward " ")
788                      (delete-char numarg)                (delete-char numarg)
789                      (unless (or (eobp) (looking-at comment-end-skip))                (unless (or (eobp) (looking-at comment-end-skip))
790                        ;; If there's something left but it doesn't look like                  ;; If there's something left but it doesn't look like
791                        ;; a comment-end any more, just remove it.                  ;; a comment-end any more, just remove it.
792                        (delete-region (point) (point-max)))))                  (delete-region (point) (point-max)))))
793    
794                  ;; Unquote any nested end-comment.            ;; Unquote any nested end-comment.
795                  (comment-quote-nested comment-start comment-end t)            (comment-quote-nested comment-start comment-end t)
796    
797                  ;; Eliminate continuation markers as well.            ;; Eliminate continuation markers as well.
798                  (when sre            (when sre
799                    (let* ((cce (comment-string-reverse (or comment-continue              (let* ((cce (comment-string-reverse (or comment-continue
800                                                            comment-start)))                                                      comment-start)))
801                           (erei (and box (comment-padleft cce 're)))                     (erei (and box (comment-padleft cce 're)))
802                           (ere (and erei (concat "\\(" erei "\\)\\s-*$"))))                     (ere (and erei (concat "\\(" erei "\\)\\s-*$"))))
803                      (goto-char (point-min))                (goto-char (point-min))
804                      (while (progn                (while (progn
805                               (if (and ere (re-search-forward                         (if (and ere (re-search-forward
806                                             ere (line-end-position) t))                                       ere (line-end-position) t))
807                                   (replace-match "" t t nil (if (match-end 2) 2 1))                             (replace-match "" t t nil (if (match-end 2) 2 1))
808                                 (setq ere nil))                           (setq ere nil))
809                               (forward-line 1)                         (forward-line 1)
810                               (re-search-forward sre (line-end-position) t))                         (re-search-forward sre (line-end-position) t))
811                        (replace-match "" t t nil (if (match-end 2) 2 1)))))                  (replace-match "" t t nil (if (match-end 2) 2 1)))))
812                  ;; Go to the end for the next comment.            ;; Go to the end for the next comment.
813                  (goto-char (point-max)))))))            (goto-char (point-max))))))
814        (set-marker end nil))))    (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 971  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 1198  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.78  
changed lines
  Added in v.1.79

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