xemacs-beta: lisp/prim/fill.el comparison

comparison lisp/prim/fill.el @ 2:ac2d302a0011 r19-15b2

Import from CVS: tag r19-15b2

author	cvs
date	Mon, 13 Aug 2007 08:46:35 +0200
parents	376386a54a3c
children	b82b59fe008d

comparison

equal deleted inserted replaced

-:c0c6a60d29db
+:ac2d302a0011
 ;;; fill.el --- fill commands for XEmacs.
-;; Copyright (C) 1985, 1986, 1992-1995 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 86, 92, 94, 95, 1996 Free Software Foundation, Inc.
 ;; Keywords: wp
 ;; This file is part of XEmacs.
 ;; 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 XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+;; 02111-1307, USA.
-;;; Synched up with: FSF 19.30.
+;;; Synched up with: FSF 19.34.
 ;;; Commentary:
 ;; All the commands for filling text.  These are documented in the XEmacs
 ;; Reference Manual.
 ;;; Code:
-(defvar fill-individual-varying-indent nil
+(defconst 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.")
-(defvar sentence-end-double-space t
+(defconst sentence-end-double-space t
 "*Non-nil means a single space does not end a sentence.")
 (defconst colon-double-space nil
 "*Non-nil means put two spaces after a colon when filling.")
 (defvar fill-paragraph-function nil
-"Mode-specific function to fill a paragraph.")
+"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.")
 (defun set-fill-prefix ()
 "Set the fill prefix to the current line up to point.
-Filling expects lines to start with the fill prefix
+Filling expects lines to start with the fill prefix and
-and reinserts the fill prefix in each resulting line."
+reinserts the fill prefix in each resulting line."
 (interactive)
 (setq fill-prefix (buffer-substring
 		     (save-excursion (move-to-left-margin) (point))
 		     (point)))
 (if (equal fill-prefix "")
 (setq fill-prefix nil))
 (if fill-prefix
 (message "fill-prefix: \"%s\"" fill-prefix)
 (message "fill-prefix cancelled")))
-(defvar adaptive-fill-mode t
+(defconst adaptive-fill-mode t
 "*Non-nil means determine a paragraph's fill prefix from its text.")
 ;; #### - this is still weak.  Yeah, there's filladapt, but this should
 ;; still be better...  --Stig
-(defvar adaptive-fill-regexp (purecopy "[ \t]*\\([#;>*]+ +\\)?")
+(defconst adaptive-fill-regexp (purecopy "[ \t]*\\([#;>*]+ +\\)?")
 "*Regexp to match text at start of line that constitutes indentation.
 If Adaptive Fill mode is enabled, whatever text matches this pattern
 on the second line of a paragraph is used as the standard indentation
 for the paragraph.  If the paragraph has just one line, the indentation
 is taken from that line.")
 		  here-col col))
 	  (max here-col fill-col)))))
 (defun canonically-space-region (beg end)
 "Remove extra spaces between words in region.
-Puts one space between words in region; two between sentences.
+Leave one space between words, two at end of sentences or after colons
-Remove indentation from each line."
+(depending on values of `sentence-end-double-space' and `colon-double-space').
+Remove indentation from each line."
 (interactive "r")
 (save-excursion
 (goto-char beg)
 ;; XEmacs - (ENE/stig from fa-extras.el): Skip the start of a comment.
 (and comment-start-skip
 ;; Make sure sentences ending at end of line get an extra space.
 ;; loses on split abbrevs ("Mr.\nSmith")
 (goto-char beg)
 (while (and (< (point) end)
 		(re-search-forward "[.?!][])}\"']*$" end t))
+;; We insert before markers in case a caller such as
+;; do-auto-fill has done a save-excursion with point at the end
+;; of the line and wants it to stay at the end of the line.
 (insert ? ))))
+;; XEmacs: we don't have this function.
+;; (insert-before-markers-and-inherit ? ))))
 ;; XEmacs -- added DONT-SKIP-FIRST.  Port of older code changes by Stig.
 ;; #### probably this junk is broken -- do-auto-fill doesn't actually use
 ;; it.  If so, it should be removed.
 (defun fill-context-prefix (from to &optional first-line-regexp
 				 dont-skip-first)
 "Compute a fill prefix from the text between FROM and TO.
-This uses the variables `adapive-fill-prefix' and `adaptive-fill-function'.
+This uses the variables `adaptive-fill-prefix' and `adaptive-fill-function'.
 If FIRST-LINE-REGEXP is non-nil, then when taking a prefix from the
 first line, insist it must match FIRST-LINE-REGEXP."
 (save-excursion
 (goto-char from)
 (if (eolp) (forward-line 1))
 ;; Move to the second line unless there is just one.
 (let ((firstline (point))
 	  ;; Non-nil if we are on the second line.
 	  at-second
 	  result)
+;; XEmacs change
 (if (not dont-skip-first)
 	  (forward-line 1))
 (if (>= (point) to)
 	  (goto-char firstline)
 	(setq at-second t))
 (move-to-left-margin)
+;; XEmacs change
 (let ((start (point))
 	    (eol (save-excursion (end-of-line) (point))))
 	(setq result
 	      (if (not (looking-at paragraph-start))
 		  (cond ((and adaptive-fill-regexp (looking-at adaptive-fill-regexp))
 (defun maybe-adapt-fill-prefix (&optional from to dont-skip-first)
 (if (and adaptive-fill-mode
 	   (or (null fill-prefix) (string= fill-prefix "")))
 (setq fill-prefix (fill-context-prefix from to nil dont-skip-first))))
-(defun fill-region-as-paragraph (from to &optional justify nosqueeze)
+(defun fill-region-as-paragraph (from to &optional justify
+				      nosqueeze squeeze-after)
 "Fill the region as one paragraph.
 It removes any paragraph breaks in the region and extra newlines at the end,
 indents and fills lines between the margins given by the
 `current-left-margin' and `current-fill-column' functions.
 It leaves point at the beginning of the line following the paragraph.
 Normally performs justification according to the `current-justification'
 function, but with a prefix arg, does full justification instead.
 From a program, optional third arg JUSTIFY can specify any type of
-justification, and fourth arg NOSQUEEZE non-nil means not to make spaces
+ustification.  Fourth arg NOSQUEEZE non-nil means not to make spaces
-between words canonical before filling.
+between words canonical before filling.  Fifth arg SQUEEZE-AFTER, if non-nil,
+means don't canonicalize spaces before that position.
 If `sentence-end-double-space' is non-nil, then period followed by one
 space does not end a sentence, so don't break a line there."
 (interactive
 (progn
 (beginning-of-line)
 (setq from (point))
 ;; Delete all but one soft newline at end of region.
+;; And leave TO before that one.
 (goto-char to)
 (while (and (> (point) from) (eq ?\n (char-after (1- (point)))))
 (if (and oneleft
 	       (not (and use-hard-newlines
 			 (get-text-property (1- (point)) 'hard))))
 		   (while (not (eobp))
 		     (if (looking-at fpre)
 			 (delete-region (point) (match-end 0)))
 		     (forward-line 1))
 		   (goto-char from)
-		   (and (looking-at fpre) (goto-char (match-end 0)))
+		   (if (looking-at fpre)
+		       (goto-char (match-end 0)))
 		   (setq from (point)))))
 	  ;; Remove indentation from lines other than the first.
 	  (beginning-of-line 2)
 	  (indent-region (point) (point-max) 0)
 	  (goto-char from)
 	  ;; but after any fill prefix on the first line.
 	  ;; Make sure sentences ending at end of line get an extra space.
 	  ;; loses on split abbrevs ("Mr.\nSmith")
 	  (while (re-search-forward "[.?!][])}\"']*$" nil t)
+	    ;; XEmacs change (no insert-and-inherit)
 	    (or (eobp) (insert ?\ )))
 	  (goto-char from)
 	  (skip-chars-forward " \t")
 	  ;; Then change all newlines to spaces.
 	  (subst-char-in-region from (point-max) ?\n ?\ )
 	  (if (and nosqueeze (not (eq justify 'full)))
 	      nil
-	    (canonically-space-region (point) (point-max))
+	    (canonically-space-region (or squeeze-after (point)) (point-max))
 	    (goto-char (point-max))
 	    (delete-horizontal-space)
+	    ;; XEmacs change (no insert-and-inherit)
 	    (insert " "))
 	  (goto-char (point-min))
 	  ;; This is the actual filling loop.
 	  (let ((prefixcol 0) linebeg)
 				(not (eq (following-char) ?\ ))
 				(eq (char-after (- (point) 2)) ?\.))
 		      (forward-char -2)
 		      (skip-chars-backward "^ \n" linebeg)))
 		;; If the left margin and fill prefix by themselves
-		;; pass the fill-column, keep at least one word.
+		;; pass the fill-column. or if they are zero
+		;; but we have no room for even one word,
+		;; keep at least one word anyway.
 		;; This handles ALL BUT the first line of the paragraph.
 		(if (if (zerop prefixcol)
 			(save-excursion
 			  (skip-chars-backward " \t" linebeg)
 			  (bolp))
 							   (and (looking-at "\\. ")
 								(not (looking-at "\\.  ")))))))
 			(skip-chars-forward " \t")
 			(skip-chars-forward "^ \t\n")
 			(setq first nil))))
-		;; Replace whitespace here with one newline, then indent to left
+		;; Check again to see if we got to the end of the paragraph.
-		;; margin.
+		(if (save-excursion (skip-chars-forward " \t") (eobp))
-		(skip-chars-backward " \t")
+		    (or nosqueeze (delete-horizontal-space))
-		(insert ?\n)
+		  ;; Replace whitespace here with one newline, then indent to left
-		;; Give newline the properties of the space(s) it replaces
+		  ;; margin.
-		(set-text-properties (1- (point)) (point)
+		  (skip-chars-backward " \t")
-				     (text-properties-at (point)))
+		  (insert ?\n)
-		(indent-to-left-margin)
+		  ;; Give newline the properties of the space(s) it replaces
-		;; Insert the fill prefix after indentation.
+		  (set-text-properties (1- (point)) (point)
-		;; Set prefixcol so whitespace in the prefix won't get lost.
+				       (text-properties-at (point)))
-		(and fill-prefix (not (equal fill-prefix ""))
+		  (indent-to-left-margin)
-		     (progn
+		  ;; Insert the fill prefix after indentation.
-		       (insert fill-prefix)
+		  ;; Set prefixcol so whitespace in the prefix won't get lost.
-		       (setq prefixcol (current-column)))))
+		  (and fill-prefix (not (equal fill-prefix ""))
+		       (progn
+			 (insert fill-prefix)
+			 (setq prefixcol (current-column))))))
 	      ;; Justify the line just ended, if desired.
 	      (if justify
 		  (if (eobp)
 		      (justify-current-line justify t t)
 		    (forward-line -1)
 breaks.
 When calling from a program, operates just on region between BEGIN and END,
 unless optional fourth arg WHOLE-PAR is non-nil.  In that case bounds are
 extended to include entire paragraphs as in the interactive command."
+;; XEmacs change (was mark-active)
 (interactive (list (if (region-active-p) (region-beginning) (point))
 		     (if (region-active-p) (region-end) (point))
 		     (let ((s (completing-read
 			       "Set justification to: "
 			       '(("left") ("right") ("full")
 (fill-region begin (point-max) nil t))))
 (defun set-justification-none (b e)
 "Disable automatic filling for paragraphs in the region.
 If the mark is not active, this applies to the current paragraph."
+;; XEmacs change (was mark-active)
 (interactive (list (if (region-active-p) (region-beginning) (point))
 		     (if (region-active-p) (region-end) (point))))
 (set-justification b e 'none t))
 (defun set-justification-left (b e)
 "Make paragraphs in the region left-justified.
 This is usually the default, but see the variable `default-justification'.
 If the mark is not active, this applies to the current paragraph."
+;; XEmacs change (was mark-active)
 (interactive (list (if (region-active-p) (region-beginning) (point))
 		     (if (region-active-p) (region-end) (point))))
 (set-justification b e 'left t))
 (defun set-justification-right (b e)
 "Make paragraphs in the region right-justified:
 Flush at the right margin and ragged on the left.
 If the mark is not active, this applies to the current paragraph."
+;; XEmacs change (was mark-active)
 (interactive (list (if (region-active-p) (region-beginning) (point))
 		     (if (region-active-p) (region-end) (point))))
 (set-justification b e 'right t))
 (defun set-justification-full (b e)
 "Make paragraphs in the region fully justified:
 This makes lines flush on both margins by inserting spaces between words.
 If the mark is not active, this applies to the current paragraph."
+;; XEmacs change (was mark-active)
 (interactive (list (if (region-active-p) (region-beginning) (point))
 		     (if (region-active-p) (region-end) (point))))
 (set-justification b e 'full t))
 (defun set-justification-center (b e)
 "Make paragraphs in the region centered.
 If the mark is not active, this applies to the current paragraph."
+;; XEmacs change (was mark-active)
 (interactive (list (if (region-active-p) (region-beginning) (point))
 		     (if (region-active-p) (region-end) (point))))
 (set-justification b e 'center t))
 ;; A line has up to six parts:
 				     (progn
 				       (goto-char (point-max))
 				       (search-backward " ")))
 				 (skip-chars-backward " ")
 				 (setq nmove (1- nmove))))
+			     ;; XEmacs change
 			     (insert " ")
 			     (skip-chars-backward " ")
 			     (setq ncols (1- ncols)))))))
 		(t (error "Unknown justification value"))))
 	(goto-char pos)
 nil)
 (defun unjustify-current-line ()
 "Remove justification whitespace from current line.
 If the line is centered or right-justified, this function removes any
-indentation past the left margin.  If the line is full-jusitified, it removes
+indentation past the left margin.  If the line is full-justified, it removes
 extra spaces between words.  It does nothing in other justification modes."
 (let ((justify (current-justification)))
 (cond ((eq 'left justify) nil)
 	  ((eq  nil  justify) nil)
 	  ((eq 'full justify)		; full justify: remove extra spaces
 					   (point))))))))
 (defun unjustify-region (&optional begin end)
 "Remove justification whitespace from region.
 For centered or right-justified regions, this function removes any indentation
-past the left margin from each line.  For full-jusitified lines, it removes
+past the left margin from each line.  For full-justified lines, it removes
 extra spaces between words.  It does nothing in other justification modes.
 Arguments BEGIN and END are optional; default is the whole buffer."
 (save-excursion
 (save-restriction
 (if end (narrow-to-region (point-min) end))
 				(point)
 				(save-excursion (skip-chars-forward " \t")
 						(point))))
 			     fill-prefix-regexp (regexp-quote fill-prefix)))
 		   (forward-line 1)
-		   (move-to-left-margin)
+		   (if (bolp)
+		       ;; If forward-line went past a newline
+		       ;; move further to the left margin.
+		       (move-to-left-margin))
 		   ;; Now stop the loop if end of paragraph.
 		   (and (not (eobp))
 			(if fill-individual-varying-indent
 			    ;; If this line is a separator line, with or
 			    ;; without prefix, end the paragraph.
 			    (and
 			     (not (looking-at paragraph-separate))
 			     (save-excursion
 			       (not (and (looking-at fill-prefix-regexp)
+					 ;; XEmacs change
 					 (progn
 					   (forward-char (length fill-prefix))
 					   (looking-at paragraph-separate))))))
 ;; If this line has more or less indent
 ;; than the fill prefix wants, end the paragraph.

Mercurial > hg > xemacs-beta

comparison lisp/prim/fill.el @ 2:ac2d302a0011 r19-15b2