(fill-context-prefix): Fix last change with yet-another-approach.

[bpt/emacs.git] / lisp / textmodes / fill.el

;;; fill.el --- fill commands for Emacs

;; Copyright (C) 1985,86,92,94,95,96,97,1999,2001,2002
;;               Free Software Foundation, Inc.

;; Maintainer: FSF
;; Keywords: wp

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; All the commands for filling text.  These are documented in the Emacs
;; manual.

;;; Code:

(defcustom fill-individual-varying-indent nil
  "*Controls criterion for a new paragraph in `fill-individual-paragraphs'.
Non-nil means changing indent doesn't end a paragraph.
That mode can handle paragraphs with extra indentation on the first line,
but it requires separator lines between paragraphs.
A value of nil means that any change in indentation starts a new paragraph."
  :type 'boolean
  :group 'fill)

(defcustom colon-double-space nil
  "*Non-nil means put two spaces after a colon when filling."
  :type 'boolean
  :group 'fill)

(defvar fill-paragraph-function nil
  "Mode-specific function to fill a paragraph, or nil if there is none.
If the function returns nil, then `fill-paragraph' does its normal work.")

(defvar enable-kinsoku t
  "*Non-nil means enable \"kinsoku\" processing on filling paragraph.
Kinsoku processing is designed to prevent certain characters from being
placed at the beginning or end of a line by filling.
See the documentation of `kinsoku' for more information.")

(defun set-fill-prefix ()
  "Set the fill prefix to the current line up to point.
Filling expects lines to start with the fill prefix and
reinserts the fill prefix in each resulting line."
  (interactive)
  (let ((left-margin-pos (save-excursion (move-to-left-margin) (point))))
    (if (> (point) left-margin-pos)
	(progn
	  (setq fill-prefix (buffer-substring left-margin-pos (point)))
	  (if (equal fill-prefix "")
	      (setq fill-prefix nil)))
      (setq fill-prefix nil)))
  (if fill-prefix
      (message "fill-prefix: \"%s\"" fill-prefix)
    (message "fill-prefix cancelled")))

(defcustom adaptive-fill-mode t
  "*Non-nil means determine a paragraph's fill prefix from its text."
  :type 'boolean
  :group 'fill)

(defcustom adaptive-fill-regexp
  ;; Added `!' for doxygen comments starting with `//!' or `/*!'.
  ;; Added `%' for TeX comments.
  (purecopy "[ \t]*\\([-!|#%;>*]+[ \t]*\\|(?[0-9]+[.)][ \t]*\\)*")
  "*Regexp to match text at start of line that constitutes indentation.
If Adaptive Fill mode is enabled, a prefix matching this pattern
on the first and second lines of a paragraph is used as the
standard indentation for the whole paragraph.

If the paragraph has just one line, the indentation is taken from that
line, but in that case `adaptive-fill-first-line-regexp' also plays
a role."
  :type 'regexp
  :group 'fill)

(defcustom adaptive-fill-first-line-regexp "\\`[ \t]*\\'"
  "*Regexp specifying whether to set fill prefix from a one-line paragraph.
When a paragraph has just one line, then after `adaptive-fill-regexp'
finds the prefix at the beginning of the line, if it doesn't
match this regexp, it is replaced with whitespace.

By default, this regexp matches sequences of just spaces and tabs.

However, we never use a prefix from a one-line paragraph
if it would act as a paragraph-starter on the second line."
  :type 'regexp
  :group 'fill)

(defcustom adaptive-fill-function nil
  "*Function to call to choose a fill prefix for a paragraph, or nil.
This function is used when `adaptive-fill-regexp' does not match."
  :type '(choice (const nil) function)
  :group 'fill)

(defvar fill-indent-according-to-mode nil ;Screws up CC-mode's filling tricks.
  "Whether or not filling should try to use the major mode's indentation.")

(defun current-fill-column ()
  "Return the fill-column to use for this line.
The fill-column to use for a buffer is stored in the variable `fill-column',
but can be locally modified by the `right-margin' text property, which is
subtracted from `fill-column'.

The fill column to use for a line is the first column at which the column
number equals or exceeds the local fill-column - right-margin difference."
  (save-excursion
    (if fill-column
	(let* ((here (progn (beginning-of-line) (point)))
	       (here-col 0)
	       (eol (progn (end-of-line) (point)))
	       margin fill-col change col)
	  ;; Look separately at each region of line with a different
	  ;; right-margin.
	  (while (and (setq margin (get-text-property here 'right-margin)
			    fill-col (- fill-column (or margin 0))
			    change (text-property-not-all
				    here eol 'right-margin margin))
		      (progn (goto-char (1- change))
			     (setq col (current-column))
			     (< col fill-col)))
	    (setq here change
		  here-col col))
	  (max here-col fill-col)))))

(defun canonically-space-region (beg end)
  "Remove extra spaces between words in region.
Leave one space between words, two at end of sentences or after colons
\(depending on values of `sentence-end-double-space', `colon-double-space',
and `sentence-end-without-period').
Remove indentation from each line."
  (interactive "*r")
  (let ((end-spc-re (concat "\\(" sentence-end "\\) *\\|  +")))
    (save-excursion
      (goto-char beg)
      ;; Nuke tabs; they get screwed up in a fill.
      ;; This is quick, but loses when a tab follows the end of a sentence.
      ;; Actually, it is difficult to tell that from "Mr.\tSmith".
      ;; Blame the typist.
      (subst-char-in-region beg end ?\t ?\ )
      (while (and (< (point) end)
		  (re-search-forward end-spc-re end t))
	(delete-region
	 (cond
	  ;; `sentence-end' matched and did not match all spaces.
	  ;; I.e. it only matched the number of spaces it needs: drop the rest.
	  ((and (match-end 1) (> (match-end 0) (match-end 1)))  (match-end 1))
	  ;; `sentence-end' matched but with nothing left.  Either that means
	  ;; nothing should be removed, or it means it's the "old-style"
	  ;; sentence-end which matches all it can.  Keep only 2 spaces.
	  ;; We probably don't even need to check `sentence-end-double-space'.
	  ((match-end 1)
	   (min (match-end 0)
		(+ (if sentence-end-double-space 2 1)
		   (save-excursion (goto-char (match-end 0))
				   (skip-chars-backward " ")
				   (point)))))
	  (t ;; It's not an end of sentence.
	   (+ (match-beginning 0)
	      ;; Determine number of spaces to leave:
	      (save-excursion
		(skip-chars-backward " ]})\"'")
		(cond ((and sentence-end-double-space
			    (or (memq (preceding-char) '(?. ?? ?!))
				(and sentence-end-without-period
				     (= (char-syntax (preceding-char)) ?w)))) 2)
		      ((and colon-double-space
			    (= (preceding-char) ?:))  2)
		      ((char-equal (preceding-char) ?\n)  0)
		      (t 1))))))
	 (match-end 0))))))

(defun fill-common-string-prefix (s1 s2)
  "Return the longest common prefix of strings S1 and S2, or nil if none."
  (let ((cmp (compare-strings s1 nil nil s2 nil nil)))
    (if (eq cmp t)
	s1
      (setq cmp (1- (abs cmp)))
      (unless (zerop cmp)
	(substring s1 0 cmp)))))
    
(defun fill-context-prefix (from to &optional first-line-regexp)
  "Compute a fill prefix from the text between FROM and TO.
This uses the variables `adaptive-fill-regexp' and `adaptive-fill-function'
and `adaptive-fill-first-line-regexp'.  `paragraph-start' also plays a role;
we reject a prefix based on a one-line paragraph if that prefix would
act as a paragraph-separator."
  (or first-line-regexp
      (setq first-line-regexp adaptive-fill-first-line-regexp))
  (save-excursion
    (goto-char from)
    (if (eolp) (forward-line 1))
    ;; Move to the second line unless there is just one.
    (move-to-left-margin)
    (let ((firstline (point))
	  first-line-prefix
	  ;; Non-nil if we are on the second line.
	  second-line-prefix
	  start)
      (setq start (point))
      (setq first-line-prefix
	    ;; We don't need to consider `paragraph-start' here since it
	    ;; will be explicitly checked later on.
	    ;; Also setting first-line-prefix to nil prevents
	    ;; second-line-prefix from being used.
	    (cond ;; ((looking-at paragraph-start) nil)
		  ((and adaptive-fill-regexp (looking-at adaptive-fill-regexp))
		   (match-string-no-properties 0))
		  (adaptive-fill-function (funcall adaptive-fill-function))))
      (forward-line 1)
      (if (< (point) to)
	(progn
	  (move-to-left-margin)
	  (setq start (point))
	  (setq second-line-prefix
		(cond ((looking-at paragraph-start) nil) ;Can it happen ? -stef
		      ((and adaptive-fill-regexp
			    (looking-at adaptive-fill-regexp))
		       (buffer-substring-no-properties start (match-end 0)))
		      (adaptive-fill-function
		       (funcall adaptive-fill-function))))
	  ;; If we get a fill prefix from the second line,
	  ;; make sure it or something compatible is on the first line too.
	  (when second-line-prefix
	    (unless first-line-prefix (setq first-line-prefix ""))
	    ;; If the non-whitespace chars match the first line,
	    ;; just use it (this subsumes the 2 checks used previously).
	    ;; Used when first line is `/* ...' and second-line is
	    ;; ` * ...'.
	    (let ((tmp second-line-prefix)
		  (re "\\`"))
	      (while (string-match "\\`[ \t]*\\([^ \t]+\\)" tmp)
		(setq re (concat re ".*" (regexp-quote (match-string 1 tmp))))
		(setq tmp (substring tmp (match-end 0))))
	      ;; (assert (string-match "\\`[ \t]*\\'" tmp))

	      (if (string-match re first-line-prefix)
		  second-line-prefix

		;; Use the longest common substring of both prefixes,
		;; if there is one.
		(fill-common-string-prefix first-line-prefix
					   second-line-prefix)))))
	;; If we get a fill prefix from a one-line paragraph,
	;; maybe change it to whitespace,
	;; and check that it isn't a paragraph starter.
	(if first-line-prefix
	    (let ((result
		   ;; If first-line-prefix comes from the first line,
		   ;; see if it seems reasonable to use for all lines.
		   ;; If not, replace it with whitespace.
		   (if (or (and first-line-regexp
				(string-match first-line-regexp
					      first-line-prefix))
			   (and comment-start-skip
				(string-match comment-start-skip
					      first-line-prefix)))
		       first-line-prefix
		     (make-string (string-width first-line-prefix) ?\ ))))
	      ;; But either way, reject it if it indicates the start
	      ;; of a paragraph when text follows it.
	      (if (not (eq 0 (string-match paragraph-start
					   (concat result "a"))))
		  result)))))))

(defun fill-single-word-nobreak-p ()
  "Don't break a line after the first or before the last word of a sentence."
  (or (looking-at "[ \t]*\\sw+[ \t]*[.?!:][ \t]*$")
      (save-excursion
	(skip-chars-backward " \t")
	(and (/= (skip-syntax-backward "w") 0)
	     (/= (skip-chars-backward " \t") 0)
	     (/= (skip-chars-backward ".?!:") 0)))))

(defun fill-french-nobreak-p ()
  "Return nil if French style allows breaking the line at point.
This is used in `fill-nobreak-predicate' to prevent breaking lines just
after an opening paren or just before a closing paren or a punctuation
mark such as `?' or `:'.  It is common in French writing to put a space
at such places, which would normally allow breaking the line at those
places."