# HG changeset patch # User Kenichi Handa # Date 1078268954 0 # Node ID 0d6a283ae6d0e6836c5f1ba213e6c24f6d279d4c # Parent 31a284f9d6cf67712db07ff9baeaa63c41caaf83 Merged from HEAD (1.72). diff -r 31a284f9d6cf -r 0d6a283ae6d0 lisp/newcomment.el --- a/lisp/newcomment.el Tue Feb 17 00:18:33 2004 +0000 +++ b/lisp/newcomment.el Tue Mar 02 23:09:14 2004 +0000 @@ -129,6 +129,31 @@ column indentation or nil. If nil is returned, indentation is delegated to `indent-according-to-mode'.") +;;;###autoload +(defvar comment-insert-comment-function nil + "Function to insert a comment when a line doesn't contain one. +The function has no args. + +Applicable at least in modes for languages like fixed-format Fortran where +comments always start in column zero.") + +(defvar comment-region-function nil + "Function to comment a region. +Its args are the same as those of `comment-region', but BEG and END are +guaranteed to be correctly ordered. It is called within `save-excursion'. + +Applicable at least in modes for languages like fixed-format Fortran where +comments always start in column zero.") + +(defvar uncomment-region-function nil + "Function to uncomment a region. +Its args are the same as those of `uncomment-region', but BEG and END are +guaranteed to be correctly ordered. It is called within `save-excursion'. + +Applicable at least in modes for languages like fixed-format Fortran where +comments always start in column zero.") + +;; ?? never set (defvar block-comment-start nil) (defvar block-comment-end nil) @@ -224,10 +249,10 @@ Functions autoloaded from newcomment.el, being entry points, should call this function before any other, so the rest of the code can assume that the variables are properly set." - (if (not comment-start) - (unless noerror - (set (make-local-variable 'comment-start) - (read-string "No comment syntax is defined. Use: "))) + (unless (and (not comment-start) noerror) + (unless comment-start + (set (make-local-variable 'comment-start) + (read-string "No comment syntax is defined. Use: "))) ;; comment-use-syntax (when (eq comment-use-syntax 'undecided) (set (make-local-variable 'comment-use-syntax) @@ -460,7 +485,7 @@ ;;;###autoload (defun comment-indent (&optional continue) - "Indent this line's comment to comment column, or insert an empty comment. + "Indent this line's comment to `comment-column', or insert an empty comment. If CONTINUE is non-nil, use the `comment-continue' markers if any." (interactive "*") (comment-normalize-vars) @@ -486,9 +511,12 @@ (forward-char (/ (skip-chars-backward " \t") -2))) (setq cpos (point-marker))) ;; If none, insert one. + (if comment-insert-comment-function + (funcall comment-insert-comment-function) (save-excursion - ;; Some comment-indent-function insist on not moving comments that - ;; are in column 0, so we first go to the likely target column. + ;; Some `comment-indent-function's insist on not moving + ;; comments that are in column 0, so we first go to the + ;; likely target column. (indent-to comment-column) ;; Ensure there's a space before the comment for things ;; like sh where it matters (as well as being neater). @@ -497,15 +525,20 @@ (setq begpos (point)) (insert starter) (setq cpos (point-marker)) - (insert ender))) + (insert ender)))) (goto-char begpos) ;; Compute desired indent. (setq indent (save-excursion (funcall comment-indent-function))) + ;; If `indent' is nil and there's code before the comment, we can't + ;; use `indent-according-to-mode', so we default to comment-column. + (unless (or indent (save-excursion (skip-chars-backward " \t") (bolp))) + (setq indent comment-column)) (if (not indent) ;; comment-indent-function refuses: delegate to line-indent. (indent-according-to-mode) - ;; Avoid moving comments past the fill-column. + ;; If the comment is at the left of code, adjust the indentation. (unless (save-excursion (skip-chars-backward " \t") (bolp)) + ;; Avoid moving comments past the fill-column. (let ((max (+ (current-column) (- (or comment-fill-column fill-column) (save-excursion (end-of-line) (current-column)))))) @@ -513,13 +546,16 @@ (setq indent max) ;Don't move past the fill column. ;; We can choose anywhere between indent..max. ;; Let's try to align to a comment on the previous line. - (let ((other nil)) + (let ((other nil) + (min (max indent + (save-excursion (skip-chars-backward " \t") + (1+ (current-column)))))) (save-excursion (when (and (zerop (forward-line -1)) (setq other (comment-search-forward (line-end-position) t))) (goto-char other) (setq other (current-column)))) - (if (and other (<= other max) (> other indent)) + (if (and other (<= other max) (>= other min)) ;; There is a comment and it's in the range: bingo. (setq indent other) ;; Let's try to align to a comment on the next line, then. @@ -529,7 +565,7 @@ (setq other (comment-search-forward (line-end-position) t))) (goto-char other) (setq other (current-column)))) - (if (and other (<= other max) (> other indent)) + (if (and other (<= other max) (> other min)) ;; There is a comment and it's in the range: bingo. (setq indent other)))))))) (unless (= (current-column) indent) @@ -662,32 +698,62 @@ comment markers." (interactive "*r\nP") (comment-normalize-vars) - (if (> beg end) (let (mid) (setq mid beg beg end end mid))) + (when (> beg end) (setq beg (prog1 end (setq end beg)))) (save-excursion - (goto-char beg) - (setq end (copy-marker end)) - (let* ((numarg (prefix-numeric-value 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 (comment-forward) - (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) + (if uncomment-region-function + (funcall uncomment-region-function beg end arg) + (goto-char beg) + (setq end (copy-marker end)) + (let* ((numarg (prefix-numeric-value 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 eob as comment-end instead of \n. + (and + (eobp) + (let ((s1 (aref (syntax-table) (char-after spt))) + (s2 (aref (syntax-table) + (or (char-after (1+ spt)) 0))) + (sn (aref (syntax-table) ?\n)) + (flag->b (car (string-to-syntax "> b"))) + (flag-1b (car (string-to-syntax " 1b"))) + (flag-2b (car (string-to-syntax " 2b")))) + (cond + ;; One-character comment-start terminated by + ;; \n. + ((and + (equal sn (string-to-syntax ">")) + (equal s1 (string-to-syntax "<"))) + (insert-char ?\n 1) + t) + ;; Two-character type b comment-start + ;; terminated by \n. + ((and + (= (logand (car sn) flag->b) flag->b) + (= (logand (car s1) flag-1b) flag-1b) + (= (logand (car s2) flag-2b) flag-2b)) + (insert-char ?\n 1) + t))))) + (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) - ;; Remove the comment-start. - (goto-char ipt) + ;; Remove the comment-start. + (goto-char ipt) (skip-syntax-backward " ") ;; A box-comment starts with a looong comment-start marker. (when (and (or (and (= (- (point) (point-min)) 1) @@ -707,52 +773,52 @@ (goto-char (match-end 0))) (if (null arg) (delete-region (point-min) (point)) (skip-syntax-backward " ") - (delete-char (- numarg)) - (unless (or (bobp) - (save-excursion (goto-char (point-min)) - (looking-at comment-start-skip))) - ;; If there's something left but it doesn't look like - ;; a comment-start any more, just remove it. - (delete-region (point-min) (point)))) + (delete-char (- numarg)) + (unless (or (bobp) + (save-excursion (goto-char (point-min)) + (looking-at comment-start-skip))) + ;; If there's something left but it doesn't look like + ;; a comment-start any more, just remove it. + (delete-region (point-min) (point)))) - ;; Remove the end-comment (and leading padding and such). - (goto-char (point-max)) (comment-enter-backward) - ;; Check for special `=' used sometimes in comment-box. - (when (and box-equal (not (eq (char-before (point-max)) ?\n))) - (let ((pos (point))) - ;; skip `=' but only if there are at least 7. - (when (> (skip-chars-backward "=") -7) (goto-char pos)))) - (unless (looking-at "\\(\n\\|\\s-\\)*\\'") - (when (and (bolp) (not (bobp))) (backward-char)) - (if (null arg) (delete-region (point) (point-max)) - (skip-syntax-forward " ") - (delete-char numarg) - (unless (or (eobp) (looking-at comment-end-skip)) - ;; If there's something left but it doesn't look like - ;; a comment-end any more, just remove it. - (delete-region (point) (point-max))))) + ;; Remove the end-comment (and leading padding and such). + (goto-char (point-max)) (comment-enter-backward) + ;; Check for special `=' used sometimes in comment-box. + (when (and box-equal (not (eq (char-before (point-max)) ?\n))) + (let ((pos (point))) + ;; skip `=' but only if there are at least 7. + (when (> (skip-chars-backward "=") -7) (goto-char pos)))) + (unless (looking-at "\\(\n\\|\\s-\\)*\\'") + (when (and (bolp) (not (bobp))) (backward-char)) + (if (null arg) (delete-region (point) (point-max)) + (skip-syntax-forward " ") + (delete-char numarg) + (unless (or (eobp) (looking-at comment-end-skip)) + ;; If there's something left but it doesn't look like + ;; a comment-end any more, just remove it. + (delete-region (point) (point-max))))) - ;; Unquote any nested end-comment. - (comment-quote-nested comment-start comment-end t) + ;; Unquote any nested end-comment. + (comment-quote-nested comment-start comment-end t) - ;; Eliminate continuation markers as well. - (when sre - (let* ((cce (comment-string-reverse (or comment-continue - comment-start))) - (erei (and box (comment-padleft cce 're))) - (ere (and erei (concat "\\(" erei "\\)\\s-*$")))) - (goto-char (point-min)) - (while (progn - (if (and ere (re-search-forward - ere (line-end-position) t)) - (replace-match "" t t nil (if (match-end 2) 2 1)) - (setq ere nil)) - (forward-line 1) - (re-search-forward sre (line-end-position) t)) - (replace-match "" t t nil (if (match-end 2) 2 1))))) - ;; Go to the end for the next comment. - (goto-char (point-max))))) - (set-marker end nil)))) + ;; Eliminate continuation markers as well. + (when sre + (let* ((cce (comment-string-reverse (or comment-continue + comment-start))) + (erei (and box (comment-padleft cce 're))) + (ere (and erei (concat "\\(" erei "\\)\\s-*$")))) + (goto-char (point-min)) + (while (progn + (if (and ere (re-search-forward + ere (line-end-position) t)) + (replace-match "" t t nil (if (match-end 2) 2 1)) + (setq ere nil)) + (forward-line 1) + (re-search-forward sre (line-end-position) t)) + (replace-match "" t t nil (if (match-end 2) 2 1))))) + ;; Go to the end for the next comment. + (goto-char (point-max))))))) + (set-marker end nil))) (defun comment-make-extra-lines (cs ce ccs cce min-indent max-indent &optional block) "Make the leading and trailing extra lines. @@ -922,49 +988,52 @@ (block (nth 1 style)) (multi (nth 0 style))) (save-excursion - ;; we use `chars' instead of `syntax' because `\n' might be - ;; of end-comment syntax rather than of whitespace syntax. - ;; sanitize BEG and END - (goto-char beg) (skip-chars-forward " \t\n\r") (beginning-of-line) - (setq beg (max beg (point))) - (goto-char end) (skip-chars-backward " \t\n\r") (end-of-line) - (setq end (min end (point))) - (if (>= beg end) (error "Nothing to comment")) + (if comment-region-function + (funcall comment-region-function beg end arg) + ;; we use `chars' instead of `syntax' because `\n' might be + ;; of end-comment syntax rather than of whitespace syntax. + ;; sanitize BEG and END + (goto-char beg) (skip-chars-forward " \t\n\r") (beginning-of-line) + (setq beg (max beg (point))) + (goto-char end) (skip-chars-backward " \t\n\r") (end-of-line) + (setq end (min end (point))) + (if (>= beg end) (error "Nothing to comment")) - ;; sanitize LINES - (setq lines - (and - lines ;; multi - (progn (goto-char beg) (beginning-of-line) - (skip-syntax-forward " ") - (>= (point) beg)) - (progn (goto-char end) (end-of-line) (skip-syntax-backward " ") - (<= (point) end)) - (or block (not (string= "" comment-end))) - (or block (progn (goto-char beg) (search-forward "\n" end t)))))) + ;; sanitize LINES + (setq lines + (and + lines ;; multi + (progn (goto-char beg) (beginning-of-line) + (skip-syntax-forward " ") + (>= (point) beg)) + (progn (goto-char end) (end-of-line) (skip-syntax-backward " ") + (<= (point) end)) + (or block (not (string= "" comment-end))) + (or block (progn (goto-char beg) (search-forward "\n" end t)))))) - ;; don't add end-markers just because the user asked for `block' - (unless (or lines (string= "" comment-end)) (setq block nil)) + ;; don't add end-markers just because the user asked for `block' + (unless (or lines (string= "" comment-end)) (setq block nil)) - (cond - ((consp arg) (uncomment-region beg end)) - ((< numarg 0) (uncomment-region beg end (- numarg))) - (t - (setq numarg (if (and (null arg) (= (length comment-start) 1)) - add (1- numarg))) - (comment-region-internal - beg end - (let ((s (comment-padright comment-start numarg))) - (if (string-match comment-start-skip s) s - (comment-padright comment-start))) - (let ((s (comment-padleft comment-end numarg))) - (and s (if (string-match comment-end-skip s) s - (comment-padright comment-end)))) - (if multi (comment-padright comment-continue numarg)) - (if multi (comment-padleft (comment-string-reverse comment-continue) numarg)) - block - lines - (nth 3 style)))))) + (cond + ((consp arg) (uncomment-region beg end)) + ((< numarg 0) (uncomment-region beg end (- numarg))) + (t + (setq numarg (if (and (null arg) (= (length comment-start) 1)) + add (1- numarg))) + (comment-region-internal + beg end + (let ((s (comment-padright comment-start numarg))) + (if (string-match comment-start-skip s) s + (comment-padright comment-start))) + (let ((s (comment-padleft comment-end numarg))) + (and s (if (string-match comment-end-skip s) s + (comment-padright comment-end)))) + (if multi (comment-padright comment-continue numarg)) + (if multi + (comment-padleft (comment-string-reverse comment-continue) numarg)) + block + lines + (nth 3 style))))))) (defun comment-box (beg end &optional arg) "Comment out the BEG .. END region, putting it inside a box. @@ -1139,4 +1208,5 @@ (provide 'newcomment) +;;; arch-tag: 01e3320a-00c8-44ea-a696-8f8e7354c858 ;;; newcomment.el ends here