![[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 [CSRG BSD Unix] / 43BSD / contrib / emacs / lisp|
Return to fill.el CVS log | Up to [CSRG BSD Unix] / 43BSD / contrib / emacs / lisp |
1.1 ! root 1: ;; Fill commands for Emacs ! 2: ;; Copyright (C) 1985 Richard M. Stallman. ! 3: ! 4: ;; This file is part of GNU Emacs. ! 5: ! 6: ;; GNU Emacs is distributed in the hope that it will be useful, ! 7: ;; but WITHOUT ANY WARRANTY. No author or distributor ! 8: ;; accepts responsibility to anyone for the consequences of using it ! 9: ;; or for whether it serves any particular purpose or works at all, ! 10: ;; unless he says so in writing. Refer to the GNU Emacs General Public ! 11: ;; License for full details. ! 12: ! 13: ;; Everyone is granted permission to copy, modify and redistribute ! 14: ;; GNU Emacs, but only under the conditions described in the ! 15: ;; GNU Emacs General Public License. A copy of this license is ! 16: ;; supposed to have been given to you along with GNU Emacs so you ! 17: ;; can know your rights and responsibilities. It should be in a ! 18: ;; file named COPYING. Among other things, the copyright notice ! 19: ;; and this notice must be preserved on all copies. ! 20: ! 21: ! 22: (defun set-fill-prefix () ! 23: "Set the fill-prefix to the current line up to point. ! 24: Filling expects lines to start with the fill prefix ! 25: and reinserts the fill prefix in each resulting line." ! 26: (interactive) ! 27: (setq fill-prefix (buffer-substring ! 28: (save-excursion (beginning-of-line) (point)) ! 29: (point))) ! 30: (if (equal fill-prefix "") ! 31: (setq fill-prefix nil)) ! 32: (if fill-prefix ! 33: (message "fill-prefix: \"%s\"" fill-prefix) ! 34: (message "fill-prefix cancelled"))) ! 35: ! 36: (defun fill-region-as-paragraph (from to &optional justify-flag) ! 37: "Fill region as one paragraph: break lines to fit fill-column. ! 38: Prefix arg means justify too. ! 39: From program, pass args FROM, TO and JUSTIFY-FLAG." ! 40: (interactive "r\nP") ! 41: (save-restriction ! 42: (narrow-to-region from to) ! 43: (goto-char (point-min)) ! 44: (skip-chars-forward "\n") ! 45: (narrow-to-region (point) (point-max)) ! 46: (let ((fpre (and fill-prefix (not (equal fill-prefix "")) ! 47: (regexp-quote fill-prefix)))) ! 48: ;; Delete the fill prefix from every line except the first. ! 49: ;; The first line may not even have a fill prefix. ! 50: (and fpre ! 51: (progn ! 52: (goto-char (point-min)) ! 53: (forward-line 1) ! 54: (while (not (eobp)) ! 55: (if (looking-at fpre) ! 56: (delete-region (point) (match-end 0))) ! 57: (forward-line 1)))) ! 58: (goto-char (point-min)) ! 59: (and fpre (looking-at fpre) (forward-char (length fill-prefix)))) ! 60: ;; Make sure sentences ending at end of line get an extra space. ! 61: (goto-char (point-min)) ! 62: (while (re-search-forward "[.?!][])""']*$" nil t) ! 63: (insert ? )) ! 64: ;; The change all newlines to spaces. ! 65: (subst-char-in-region (point-min) (point-max) ?\n ?\ ) ! 66: ;; Flush excess spaces, except in the paragraph indentation. ! 67: (goto-char (point-min)) ! 68: (skip-chars-forward " \t") ! 69: (while (re-search-forward " *" nil t) ! 70: (delete-region ! 71: (+ (match-beginning 0) ! 72: (if (save-excursion ! 73: (skip-chars-backward " ])\"'") ! 74: (memq (preceding-char) '(?. ?? ?!))) ! 75: 2 1)) ! 76: (match-end 0))) ! 77: (goto-char (point-max)) ! 78: (delete-horizontal-space) ! 79: (insert " ") ! 80: (goto-char (point-min)) ! 81: (let ((fplen (length (or fill-prefix "")))) ! 82: (while (not (eobp)) ! 83: (move-to-column (1+ fill-column)) ! 84: (if (eobp) ! 85: nil ! 86: (skip-chars-backward "^ \n") ! 87: (if (bolp) ! 88: (skip-chars-forward "^ \n") ! 89: (forward-char -1))) ! 90: (delete-horizontal-space) ! 91: (insert ?\n) ! 92: (and (not (eobp)) fill-prefix (not (equal fill-prefix "")) ! 93: (insert fill-prefix)) ! 94: (and justify-flag (not (eobp)) ! 95: (progn ! 96: (forward-line -1) ! 97: (justify-current-line) ! 98: (forward-line 1))))))) ! 99: ! 100: (defun fill-paragraph (arg) ! 101: "Fill paragraph at or after point. ! 102: Prefix arg means justify as well." ! 103: (interactive "P") ! 104: (save-excursion ! 105: (forward-paragraph) ! 106: (or (bolp) (newline 1)) ! 107: (let ((end (point))) ! 108: (backward-paragraph) ! 109: (fill-region-as-paragraph (point) end arg)))) ! 110: ! 111: (defun fill-region (from to &optional justify-flag) ! 112: "Fill each of the paragraphs in the region. ! 113: Prefix arg (non-nil third arg, if called from program) ! 114: means justify as well." ! 115: (interactive "r\nP") ! 116: (save-restriction ! 117: (narrow-to-region from to) ! 118: (goto-char (point-min)) ! 119: (while (not (eobp)) ! 120: (let ((initial (point)) ! 121: (end (progn ! 122: (forward-paragraph 1) (point)))) ! 123: (forward-paragraph -1) ! 124: (if (>= (point) initial) ! 125: (fill-region-as-paragraph (point) end justify-flag) ! 126: (goto-char end)))))) ! 127: ! 128: (defun justify-current-line () ! 129: "Add spaces to line point is in, so it ends at fill-column." ! 130: (interactive) ! 131: (save-excursion ! 132: (save-restriction ! 133: (let (ncols beg) ! 134: (beginning-of-line) ! 135: (skip-chars-forward " \t") ! 136: (setq beg (point)) ! 137: (end-of-line) ! 138: (narrow-to-region beg (point)) ! 139: (goto-char beg) ! 140: (while (re-search-forward " *" nil t) ! 141: (delete-region ! 142: (+ (match-beginning 0) ! 143: (if (save-excursion ! 144: (skip-chars-backward " ])\"'") ! 145: (memq (preceding-char) '(?. ?? ?!))) ! 146: 2 1)) ! 147: (match-end 0))) ! 148: (goto-char beg) ! 149: (while (re-search-forward "[.?!][])""']*\n" nil t) ! 150: (forward-char -1) ! 151: (insert ? )) ! 152: (goto-char (point-max)) ! 153: (setq ncols (- fill-column (current-column))) ! 154: (if (scan-buffer (point-min) 1 ? ) ! 155: (while (> ncols 0) ! 156: (let ((nmove (+ 3 (% (random) 3)))) ! 157: (while (> nmove 0) ! 158: (or (search-backward " " nil t) ! 159: (progn ! 160: (goto-char (point-max)) ! 161: (search-backward " "))) ! 162: (skip-chars-backward " ") ! 163: (setq nmove (1- nmove)))) ! 164: (insert " ") ! 165: (skip-chars-backward " ") ! 166: (setq ncols (1- ncols)))))))) ! 167: ! 168: (defun fill-individual-paragraphs (min max &optional justifyp mailp) ! 169: "Fill each paragraph in region according to its individual fill prefix. ! 170: Calling from a program, pass range to fill as first two arguments. ! 171: Optional third and fourth arguments JUSTIFY-FLAG and MAIL-FLAG: ! 172: JUSTIFY-FLAG to justify paragraphs (prefix arg), ! 173: MAIL-FLAG for a mail message, i. e. don't fill header lines." ! 174: (interactive "r\nP") ! 175: (let (fill-prefix) ! 176: (save-restriction ! 177: (save-excursion ! 178: (narrow-to-region min max) ! 179: (goto-char (point-min)) ! 180: (while (progn ! 181: (skip-chars-forward " \t\n") ! 182: (not (eobp))) ! 183: (setq fill-prefix (buffer-substring (point) (progn (beginning-of-line) (point)))) ! 184: (let ((fin (save-excursion (forward-paragraph) (point))) ! 185: (start (point))) ! 186: (if mailp ! 187: (while (re-search-forward "[ \t]*[^ \t\n]*:" fin t) ! 188: (forward-line 1))) ! 189: (cond ((= start (point)) ! 190: (fill-region-as-paragraph (point) fin justifyp) ! 191: (goto-char fin))))))))) ! 192:
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.