![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to fill.el CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Apple XNU] / GNUtools / emacs / lisp|
Return to fill.el CVS log | Up to [Apple XNU] / GNUtools / emacs / lisp |
1.1 ! root 1: ;; Fill commands for Emacs ! 2: ;; Copyright (C) 1985, 1986, 1992 Free Software Foundation, Inc. ! 3: ! 4: ;; This file is part of GNU Emacs. ! 5: ! 6: ;; GNU Emacs is free software; you can redistribute it and/or modify ! 7: ;; it under the terms of the GNU General Public License as published by ! 8: ;; the Free Software Foundation; either version 1, or (at your option) ! 9: ;; any later version. ! 10: ! 11: ;; GNU Emacs is distributed in the hope that it will be useful, ! 12: ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ! 13: ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ! 14: ;; GNU General Public License for more details. ! 15: ! 16: ;; You should have received a copy of the GNU General Public License ! 17: ;; along with GNU Emacs; see the file COPYING. If not, write to ! 18: ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ! 19: ! 20: (defconst fill-individual-varying-indent nil ! 21: "*Controls criterion for a new paragraph in `fill-individual-paragraphs'. ! 22: Non-nil means changing indent doesn't end a paragraph. ! 23: That mode can handle paragraphs with extra indentation on the first line, ! 24: but it requires separator lines between paragraphs. ! 25: Nil means that any change in indentation starts a new paragraph.") ! 26: ! 27: (defun set-fill-prefix () ! 28: "Set the fill-prefix to the current line up to point. ! 29: Filling expects lines to start with the fill prefix ! 30: and reinserts the fill prefix in each resulting line." ! 31: (interactive) ! 32: (setq fill-prefix (buffer-substring ! 33: (save-excursion (beginning-of-line) (point)) ! 34: (point))) ! 35: (if (equal fill-prefix "") ! 36: (setq fill-prefix nil)) ! 37: (if fill-prefix ! 38: (message "fill-prefix: \"%s\"" fill-prefix) ! 39: (message "fill-prefix cancelled"))) ! 40: ! 41: (defun fill-region-as-paragraph (from to &optional justify-flag) ! 42: "Fill region as one paragraph: break lines to fit fill-column. ! 43: Prefix arg means justify too. ! 44: From program, pass args FROM, TO and JUSTIFY-FLAG." ! 45: (interactive "r\nP") ! 46: (save-restriction ! 47: (narrow-to-region from to) ! 48: (goto-char (point-min)) ! 49: (skip-chars-forward "\n") ! 50: (narrow-to-region (point) (point-max)) ! 51: (setq from (point)) ! 52: (let ((fpre (and fill-prefix (not (equal fill-prefix "")) ! 53: (regexp-quote fill-prefix)))) ! 54: ;; Delete the fill prefix from every line except the first. ! 55: ;; The first line may not even have a fill prefix. ! 56: (and fpre ! 57: (progn ! 58: (if (>= (length fill-prefix) fill-column) ! 59: (error "fill-prefix too long for specified width")) ! 60: (goto-char (point-min)) ! 61: (forward-line 1) ! 62: (while (not (eobp)) ! 63: (if (looking-at fpre) ! 64: (delete-region (point) (match-end 0))) ! 65: (forward-line 1)) ! 66: (goto-char (point-min)) ! 67: (and (looking-at fpre) (forward-char (length fill-prefix))) ! 68: (setq from (point))))) ! 69: ;; from is now before the text to fill, ! 70: ;; but after any fill prefix on the first line. ! 71: ! 72: ;; Make sure sentences ending at end of line get an extra space. ! 73: (goto-char from) ! 74: (while (re-search-forward "[.?!][])""']*$" nil t) ! 75: (insert ? )) ! 76: ;; The change all newlines to spaces. ! 77: (subst-char-in-region from (point-max) ?\n ?\ ) ! 78: ;; Flush excess spaces, except in the paragraph indentation. ! 79: (goto-char from) ! 80: (skip-chars-forward " \t") ! 81: (while (re-search-forward " *" nil t) ! 82: (delete-region ! 83: (+ (match-beginning 0) ! 84: (if (save-excursion ! 85: (skip-chars-backward " ])\"'") ! 86: (memq (preceding-char) '(?. ?? ?!))) ! 87: 2 1)) ! 88: (match-end 0))) ! 89: (goto-char (point-max)) ! 90: (delete-horizontal-space) ! 91: (insert " ") ! 92: (goto-char (point-min)) ! 93: (let ((prefixcol 0) linebeg) ! 94: (while (not (eobp)) ! 95: (setq linebeg (point)) ! 96: (move-to-column (1+ fill-column)) ! 97: (if (eobp) ! 98: nil ! 99: ;; Move back to start of word. ! 100: (skip-chars-backward "^ \n" linebeg) ! 101: (if (if (zerop prefixcol) (bolp) (>= prefixcol (current-column))) ! 102: ;; Keep at least one word even if fill prefix exceeds margin. ! 103: ;; This handles all but the first line of the paragraph. ! 104: (progn ! 105: (skip-chars-forward " ") ! 106: (skip-chars-forward "^ \n")) ! 107: ;; Normally, move back over the single space between the words. ! 108: (forward-char -1))) ! 109: (if (and fill-prefix (zerop prefixcol) ! 110: (< (- (point) (point-min)) (length fill-prefix)) ! 111: (string= (buffer-substring (point-min) (point)) ! 112: (substring fill-prefix 0 (- (point) (point-min))))) ! 113: ;; Keep at least one word even if fill prefix exceeds margin. ! 114: ;; This handles the first line of the paragraph. ! 115: (progn ! 116: (skip-chars-forward " ") ! 117: (skip-chars-forward "^ \n"))) ! 118: ;; Replace all whitespace here with one newline. ! 119: ;; Insert before deleting, so we don't forget which side of ! 120: ;; the whitespace point or markers used to be on. ! 121: (skip-chars-backward " ") ! 122: (insert ?\n) ! 123: (delete-horizontal-space) ! 124: ;; Insert the fill prefix at start of each line. ! 125: ;; Set prefixcol so whitespace in the prefix won't get lost. ! 126: (and (not (eobp)) fill-prefix (not (equal fill-prefix "")) ! 127: (progn ! 128: (insert fill-prefix) ! 129: (setq prefixcol (current-column)))) ! 130: ;; Justify the line just ended, if desired. ! 131: (and justify-flag (not (eobp)) ! 132: (progn ! 133: (forward-line -1) ! 134: (justify-current-line) ! 135: (forward-line 1))))))) ! 136: ! 137: (defun fill-paragraph (arg) ! 138: "Fill paragraph at or after point. ! 139: Prefix arg means justify as well." ! 140: (interactive "P") ! 141: (save-excursion ! 142: (forward-paragraph) ! 143: (or (bolp) (newline 1)) ! 144: (let ((end (point))) ! 145: (backward-paragraph) ! 146: (fill-region-as-paragraph (point) end arg)))) ! 147: ! 148: (defun fill-region (from to &optional justify-flag) ! 149: "Fill each of the paragraphs in the region. ! 150: Prefix arg (non-nil third arg, if called from program) ! 151: means justify as well." ! 152: (interactive "r\nP") ! 153: (save-restriction ! 154: (narrow-to-region from to) ! 155: (goto-char (point-min)) ! 156: (while (not (eobp)) ! 157: (let ((initial (point)) ! 158: (end (progn ! 159: (forward-paragraph 1) (point)))) ! 160: (forward-paragraph -1) ! 161: (if (>= (point) initial) ! 162: (fill-region-as-paragraph (point) end justify-flag) ! 163: (goto-char end)))))) ! 164: ! 165: (defun justify-current-line () ! 166: "Add spaces to line point is in, so it ends at fill-column." ! 167: (interactive) ! 168: (save-excursion ! 169: (save-restriction ! 170: (let (ncols nwhites beg indent flags) ! 171: (beginning-of-line) ! 172: (forward-char (length fill-prefix)) ! 173: (skip-chars-forward " \t") ! 174: (setq indent (current-column)) ! 175: (setq beg (point)) ! 176: (end-of-line) ! 177: (narrow-to-region beg (point)) ! 178: (goto-char beg) ! 179: (while (re-search-forward " *" nil t) ! 180: (delete-region ! 181: (+ (match-beginning 0) ! 182: (if (save-excursion ! 183: (skip-chars-backward " ])\"'") ! 184: (memq (preceding-char) '(?. ?? ?!))) ! 185: 2 1)) ! 186: (match-end 0))) ! 187: (goto-char beg) ! 188: (while (re-search-forward "[.?!][])""']*\n" nil t) ! 189: (forward-char -1) ! 190: (insert ? )) ! 191: (goto-char (point-max)) ! 192: ;; Note that the buffer bounds start after the indentation, ! 193: ;; so the columns counted by INDENT don't appear in (current-column). ! 194: (setq ncols (- fill-column (current-column) indent)) ! 195: ;; Count word-boundaries in the line. ! 196: (setq nwhites 0) ! 197: (while (search-backward " " nil t) ! 198: (skip-chars-backward " ") ! 199: (setq nwhites (1+ nwhites))) ! 200: (if (> nwhites 0) ! 201: (progn ! 202: ;; Add space uniformly as far as we can. ! 203: (goto-char (point-max)) ! 204: (while (search-backward " " nil t) ! 205: (insert-char ?\ (/ ncols nwhites)) ! 206: (skip-chars-backward " ")) ! 207: ;; Make a bit vector for where to add the rest. ! 208: (setq ncols (% ncols nwhites)) ! 209: (setq flags (make-string nwhites 0)) ! 210: ;; Randomly set NCOLS different bits. ! 211: (while (> ncols 0) ! 212: (let ((where (% (logand 262143 (random)) nwhites))) ! 213: (or (> (aref flags where) 0) ! 214: (progn ! 215: (aset flags where 1) ! 216: (setq ncols (1- ncols)))))) ! 217: ;; Insert a space at the boundaries flagged in the vector. ! 218: (goto-char (point-max)) ! 219: (let ((where 0)) ! 220: (while (search-backward " " nil t) ! 221: (if (> (aref flags where) 0) ! 222: (insert " ")) ! 223: (setq where (1+ where)) ! 224: (skip-chars-backward " "))))))))) ! 225: ! 226: (defun fill-individual-paragraphs (min max &optional justifyp mailp) ! 227: "Fill each paragraph in region according to its individual fill prefix. ! 228: ! 229: If `fill-individual-varying-indent' is non-nil, ! 230: then a mere change in indentation does not end a paragraph. In this mode, ! 231: the indentation for a paragraph is the minimum indentation of any line in it. ! 232: ! 233: Calling from a program, pass range to fill as first two arguments. ! 234: ! 235: Optional third and fourth arguments JUSTIFY-FLAG and MAIL-FLAG: ! 236: JUSTIFY-FLAG to justify paragraphs (prefix arg), ! 237: MAIL-FLAG for a mail message, i. e. don't fill header lines." ! 238: (interactive "r\nP") ! 239: (save-restriction ! 240: (save-excursion ! 241: (goto-char min) ! 242: (beginning-of-line) ! 243: (if mailp ! 244: (while (looking-at "[^ \t\n]*:") ! 245: (forward-line 1))) ! 246: (narrow-to-region (point) max) ! 247: ;; Loop over paragraphs. ! 248: (while (progn (skip-chars-forward " \t\n") (not (eobp))) ! 249: (beginning-of-line) ! 250: (let ((start (point)) ! 251: fill-prefix fill-prefix-regexp) ! 252: ;; Find end of paragraph, and compute the smallest fill-prefix ! 253: ;; that fits all the lines in this paragraph. ! 254: (while (progn ! 255: ;; Update the fill-prefix on the first line ! 256: ;; and whenever the prefix good so far is too long. ! 257: (if (not (and fill-prefix ! 258: (looking-at fill-prefix-regexp))) ! 259: (setq fill-prefix ! 260: (buffer-substring (point) ! 261: (save-excursion (skip-chars-forward " \t") (point))) ! 262: fill-prefix-regexp ! 263: (regexp-quote fill-prefix))) ! 264: (forward-line 1) ! 265: ;; Now stop the loop if end of paragraph. ! 266: (and (not (eobp)) ! 267: (if fill-individual-varying-indent ! 268: ;; If this line is a separator line, with or ! 269: ;; without prefix, end the paragraph. ! 270: (and ! 271: (not (looking-at paragraph-separate)) ! 272: (save-excursion ! 273: (not (and (looking-at fill-prefix-regexp) ! 274: (progn (forward-char (length fill-prefix)) ! 275: (looking-at paragraph-separate)))))) ! 276: ;; If this line has more or less indent ! 277: ;; than the fill prefix wants, end the paragraph. ! 278: (and (looking-at fill-prefix-regexp) ! 279: (save-excursion ! 280: (not (progn (forward-char (length fill-prefix)) ! 281: (or (looking-at paragraph-separate) ! 282: (looking-at paragraph-start)))))))))) ! 283: ;; Fill this paragraph, but don't add a newline at the end. ! 284: (let ((had-newline (bolp))) ! 285: (fill-region-as-paragraph start (point) justifyp) ! 286: (or had-newline (delete-char -1)))))))) ! 287:
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.