Function: c-guess-fill-prefix
c-guess-fill-prefix is a byte-compiled function defined in
cc-cmds.el.gz.
Signature
(c-guess-fill-prefix LIT-LIMITS LIT-TYPE)
Source Code
;; Defined in /usr/src/emacs/lisp/progmodes/cc-cmds.el.gz
;; The filling code is based on a simple theory; leave the intricacies
;; of the text handling to the currently active mode for that
;; (e.g. adaptive-fill-mode or filladapt-mode) and do as little as
;; possible to make them work correctly wrt the comment and string
;; separators, one-line paragraphs etc. Unfortunately, when it comes
;; to it, there's quite a lot of special cases to handle which makes
;; the code anything but simple. The intention is that it will work
;; with any well-written text filling package that preserves a fill
;; prefix.
;;
;; We temporarily mask comment starters and enders as necessary for
;; the filling code to do its job on a seemingly normal text block.
;; We do _not_ mask the fill prefix, so it's up to the filling code to
;; preserve it correctly (especially important when filling C++ style
;; line comments). By default, we set up and use adaptive-fill-mode,
;; which is standard in all supported Emacs flavors.
(defun c-guess-fill-prefix (lit-limits lit-type)
;; Determine the appropriate comment fill prefix for a block or line
;; comment. Return a cons of the prefix string and the column where
;; it ends. If fill-prefix is set, it'll override. Note that this
;; function also uses the value of point in some heuristics.
;;
;; This function might do hidden buffer changes.
(let* ((here (point))
(prefix-regexp (concat "[ \t]*\\("
c-current-comment-prefix
"\\)[ \t]*"))
(comment-start-regexp (if (eq lit-type 'c++)
prefix-regexp
comment-start-skip))
prefix-line comment-prefix res comment-text-end)
(cond
(fill-prefix
(setq res (cons fill-prefix
;; Ugly way of getting the column after the fill
;; prefix; it'd be nice with a current-column
;; that works on strings..
(let ((start (point)))
(unwind-protect
(progn
(insert-and-inherit "\n" fill-prefix)
(current-column))
(delete-region start (point)))))))
((eq lit-type 'c++)
(save-excursion
;; Set fallback for comment-prefix if none is found.
(setq comment-prefix "// "
comment-text-end (cdr lit-limits))
(beginning-of-line)
(if (> (point) (car lit-limits))
;; The current line is not the comment starter, so the
;; comment has more than one line, and it can therefore be
;; used to find the comment fill prefix.
(setq prefix-line (point))
(goto-char (car lit-limits))
(if (and (= (forward-line 1) 0)
(< (point) (cdr lit-limits)))
;; The line after the comment starter is inside the
;; comment, so we can use it.
(setq prefix-line (point))
;; The comment is only one line. Take the comment prefix
;; from it and keep the indentation.
(goto-char (car lit-limits))
(if (looking-at prefix-regexp)
(goto-char (match-end 0))
(forward-char 2)
(skip-chars-forward " \t"))
(let (str col)
(if (eq (c-point 'boi) (car lit-limits))
;; There is only whitespace before the comment
;; starter; take the prefix straight from this line.
(setq str (buffer-substring-no-properties
(c-point 'bol) (point))
col (current-column))
;; There is code before the comment starter, so we
;; have to temporarily insert and indent a new line to
;; get the right space/tab mix in the indentation.
(let ((prefix-len (- (point) (car lit-limits)))
tmp)
(unwind-protect
(progn
(goto-char (car lit-limits))
(indent-to (prog1 (current-column)
(insert ?\n)))
(setq tmp (point))
(forward-char prefix-len)
(setq str (buffer-substring-no-properties
(c-point 'bol) (point))
col (current-column)))
(delete-region (car lit-limits) tmp))))
(setq res
(if (or (string-match "\\s \\'" str) (not (eolp)))
(cons str col)
;; The prefix ends the line with no whitespace
;; after it. Default to a single space.
(cons (concat str " ") (1+ col))))
)))))
(t
(setq comment-text-end
(save-excursion
(goto-char (- (cdr lit-limits) 2))
(if (looking-at "\\*/") (point) (cdr lit-limits))))
(save-excursion
(beginning-of-line)
(if (and (> (point) (car lit-limits))
(not (and (looking-at "[ \t]*\\*/")
(eq (cdr lit-limits) (match-end 0)))))
;; The current line is not the comment starter and
;; contains more than just the ender, so it's good enough
;; to be used for the comment fill prefix.
(setq prefix-line (point))
(goto-char (car lit-limits))
(cond ((or (/= (forward-line 1) 0)
(>= (point) (cdr lit-limits))
(and (looking-at "[ \t]*\\*/")
(eq (cdr lit-limits) (match-end 0)))
(and (looking-at prefix-regexp)
(<= (1- (cdr lit-limits)) (match-end 0))))
;; The comment is either one line or the next line contains
;; just the comment ender. In this case we have no
;; information about a suitable comment prefix, so we resort
;; to c-block-comment-prefix.
(setq comment-prefix (or c-block-comment-prefix "")))
((< here (point))
;; The point was on the comment opener line, so we might want
;; to treat this as a not yet closed comment.
(if (and (match-beginning 1)
(/= (match-beginning 1) (match-end 1)))
;; Above `prefix-regexp' matched a nonempty prefix on the
;; second line, so let's use it. Normally it should do
;; to set `prefix-line' and let the code below pick up
;; the whole prefix, but if there's no text after the
;; match then it will probably fall back to no prefix at
;; all if the comment isn't closed yet, so in that case
;; it's better to force use of the prefix matched now.
(if (= (match-end 0) (c-point 'eol))
(setq comment-prefix (match-string 1))
(setq prefix-line (point)))
;; There's no nonempty prefix on the line after the
;; comment opener. If the line is empty, or if the
;; text on it has less or equal indentation than the
;; comment starter we assume it's an unclosed
;; comment starter, i.e. that
;; `c-block-comment-prefix' should be used.
;; Otherwise we assume it's a closed comment where
;; the prefix really is the empty string.
;; E.g. this is an unclosed comment:
;;
;; /*
;; foo
;;
;; But this is not:
;;
;; /*
;; foo
;; */
;;
;; (Looking for the presence of the comment closer
;; rarely works since it's probably the closer of
;; some comment further down when the comment
;; really is unclosed.)
(if (<= (save-excursion (back-to-indentation)
(current-column))
(save-excursion (goto-char (car lit-limits))
(current-column)))
(setq comment-prefix (or c-block-comment-prefix ""))
(setq prefix-line (point)))))
(t
;; Otherwise the line after the comment starter is good
;; enough to find the prefix in.
(setq prefix-line (point))))
(when comment-prefix
;; Haven't got the comment prefix on any real line that we
;; can take it from, so we have to temporarily insert
;; `comment-prefix' on a line and indent it to find the
;; correct column and the correct mix of tabs and spaces.
(setq res
(let (tmp-pre tmp-post at-close)
(unwind-protect
(progn
(goto-char (car lit-limits))
(if (looking-at comment-start-regexp)
(progn
(goto-char (min (match-end 0)
comment-text-end))
(setq
at-close
(looking-at c-block-comment-ender-regexp)))
(forward-char 2)
(skip-chars-forward " \t"))
(when (eq (char-syntax (char-before)) ?\ )
;; If there's ws on the current line, we'll use it
;; instead of what's ending comment-prefix.
(setq comment-prefix
(concat (substring comment-prefix
0 (string-match
"\\s *\\'"
comment-prefix))
(buffer-substring-no-properties
(save-excursion
(skip-chars-backward " \t")
(point))
(point))))
;; If hard up against the comment ender, the
;; prefix must end in at least two spaces.
(when at-close
(or (string-match "\\s \\s +\\'" comment-prefix)
(setq comment-prefix
(concat comment-prefix " ")))))
(setq tmp-pre (point-marker))
;; We insert an extra non-whitespace character
;; before the line break and after comment-prefix in
;; case it's "" or ends with whitespace.
(insert-and-inherit "x\n" comment-prefix "x")
(setq tmp-post (point-marker))
(indent-according-to-mode)
(goto-char (1- tmp-post))
(cons (buffer-substring-no-properties
(c-point 'bol) (point))
(current-column)))
(when tmp-post
(delete-region tmp-pre tmp-post)
(set-marker tmp-pre nil)
(set-marker tmp-post nil))))))))))
(or res ; Found a good prefix above.
(save-excursion
;; prefix-line is the bol of a line on which we should try
;; to find the prefix.
(let* (fb-string fb-endpos ; Contains any fallback prefix found.
(test-line
(lambda ()
(when (and (looking-at prefix-regexp)
(<= (match-end 0) comment-text-end))
(unless (eq (match-end 0) (c-point 'eol))
;; The match is fine if there's text after it.
(throw 'found (cons (buffer-substring-no-properties
(match-beginning 0) (match-end 0))
(progn (goto-char (match-end 0))
(current-column)))))
(unless fb-string
;; This match is better than nothing, so let's
;; remember it in case nothing better is found
;; on another line.
(setq fb-string (buffer-substring-no-properties
(match-beginning 0) (match-end 0))
fb-endpos (match-end 0)))
t))))
(or (catch 'found
;; Search for a line which has text after the prefix
;; so that we get the proper amount of whitespace
;; after it. We start with the current line, then
;; search backwards, then forwards.
(goto-char prefix-line)
(when (and (funcall test-line)
(or (/= (match-end 1) (match-end 0))
;; The whitespace is sucked up by the
;; first [ \t]* glob if the prefix is empty.
(and (= (match-beginning 1) (match-end 1))
(/= (match-beginning 0) (match-end 0)))))
;; If the current line doesn't have text but do
;; have whitespace after the prefix, we'll use it.
(throw 'found (cons fb-string
(progn (goto-char fb-endpos)
(current-column)))))
(if (eq lit-type 'c++)
;; For line comments we can search up to and
;; including the first line.
(while (and (zerop (forward-line -1))
(>= (point) (car lit-limits)))
(funcall test-line))
;; For block comments we must stop before the
;; block starter.
(while (and (zerop (forward-line -1))
(> (point) (car lit-limits)))
(funcall test-line)))
(goto-char prefix-line)
(while (and (zerop (forward-line 1))
(< (point) (cdr lit-limits)))
(funcall test-line))
(goto-char prefix-line)
nil)
(when fb-string
;; A good line wasn't found, but at least we have a
;; fallback that matches the comment prefix regexp.
(cond ((or (string-match "\\s \\'" fb-string)
(progn
(goto-char fb-endpos)
(not (eolp))))
;; There are ws or text after the prefix, so
;; let's use it.
(cons fb-string (current-column)))
((progn
;; Check if there's any whitespace padding
;; on the comment start line that we can
;; use after the prefix.
(goto-char (car lit-limits))
(if (looking-at comment-start-regexp)
(goto-char (match-end 0))
(forward-char 2)
(skip-chars-forward " \t"))
(or (not (eolp))
(eq (char-syntax (char-before)) ?\ )))
(setq fb-string (buffer-substring-no-properties
(save-excursion
(skip-chars-backward " \t")
(point))
(point)))
(goto-char fb-endpos)
(skip-chars-backward " \t")
(let ((tmp (point)))
;; Got to mess in the buffer once again to
;; ensure the column gets correct. :P
(unwind-protect
(progn
(insert-and-inherit fb-string)
(cons (buffer-substring-no-properties
(c-point 'bol)
(point))
(current-column)))
(delete-region tmp (point)))))
(t
;; Last resort: Just add a single space after
;; the prefix.
(cons (concat fb-string " ")
(progn (goto-char fb-endpos)
(1+ (current-column)))))))
;; The line doesn't match the comment prefix regexp.
(if comment-prefix
;; We have a fallback for line comments that we must use.
(cons (concat (buffer-substring-no-properties
prefix-line (c-point 'boi))
comment-prefix)
(progn (back-to-indentation)
(+ (current-column) (length comment-prefix))))
;; Assume we are dealing with a "free text" block
;; comment where the lines doesn't have any comment
;; prefix at all and we should just fill it as
;; normal text.
'("" . 0))))))
))