1;;; flow-fill.el --- interpret RFC2646 "flowed" text -*- lexical-binding:t -*- 2 3;; Copyright (C) 2000-2021 Free Software Foundation, Inc. 4 5;; Author: Simon Josefsson <jas@pdc.kth.se> 6;; Keywords: mail 7 8;; This file is part of GNU Emacs. 9 10;; GNU Emacs is free software: you can redistribute it and/or modify 11;; it under the terms of the GNU General Public License as published by 12;; the Free Software Foundation, either version 3 of the License, or 13;; (at your option) any later version. 14 15;; GNU Emacs is distributed in the hope that it will be useful, 16;; but WITHOUT ANY WARRANTY; without even the implied warranty of 17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18;; GNU General Public License for more details. 19 20;; You should have received a copy of the GNU General Public License 21;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. 22 23;;; Commentary: 24 25;; This implement decoding of RFC2646 formatted text, including the 26;; quoted-depth wins rules. 27 28;; Theory of operation: search for lines ending with SPC, save quote 29;; length of line, remove SPC and concatenate line with the following 30;; line if quote length of following line matches current line. 31 32;; When no further concatenations are possible, we've found a 33;; paragraph and we let `fill-region' fill the long line into several 34;; lines with the quote prefix as `fill-prefix'. 35 36;; Todo: implement basic `fill-region' 37 38;;; History: 39 40;; 2000-02-17 posted on ding mailing list 41;; 2000-02-19 use `point-at-{b,e}ol' in XEmacs 42;; 2000-03-11 no compile warnings for point-at-bol stuff 43;; 2000-03-26 committed to gnus cvs 44;; 2000-10-23 don't flow "-- " lines, make "quote-depth wins" rule 45;; work when first line is at level 0. 46;; 2002-01-12 probably incomplete encoding support 47;; 2003-12-08 started working on test harness. 48 49;;; Code: 50 51 52(defcustom fill-flowed-display-column 'fill-column 53 "Column beyond which format=flowed lines are wrapped, when displayed. 54This can be a Lisp expression or an integer." 55 :version "22.1" 56 :group 'mime-display 57 :type '(choice (const :tag "Standard `fill-column'" fill-column) 58 (const :tag "Fit Window" (- (window-width) 5)) 59 (sexp) 60 (integer))) 61 62(defcustom fill-flowed-encode-column 66 63 "Column beyond which format=flowed lines are wrapped, in outgoing messages. 64This can be a Lisp expression or an integer. 65RFC 2646 suggests 66 characters for readability." 66 :version "22.1" 67 :group 'mime-display 68 :type '(choice (const :tag "Standard fill-column" fill-column) 69 (const :tag "RFC 2646 default (66)" 66) 70 (sexp) 71 (integer))) 72 73;;;###autoload 74(defun fill-flowed-encode (&optional buffer) 75 (with-current-buffer (or buffer (current-buffer)) 76 ;; No point in doing this unless hard newlines is used. 77 (when use-hard-newlines 78 (let ((start (point-min)) end) 79 ;; Go through each paragraph, filling it and adding SPC 80 ;; as the last character on each line. 81 (while (setq end (text-property-any start (point-max) 'hard 't)) 82 (save-restriction 83 (narrow-to-region start end) 84 (let ((fill-column (eval fill-flowed-encode-column))) 85 (fill-flowed-fill-buffer)) 86 (goto-char (point-min)) 87 (while (re-search-forward "\n" nil t) 88 (replace-match " \n" t t)) 89 (goto-char (setq start (1+ (point-max))))))) 90 t))) 91 92(defun fill-flowed-fill-buffer () 93 (let ((prefix nil) 94 (prev-prefix nil) 95 (start (point-min))) 96 (goto-char (point-min)) 97 (while (not (eobp)) 98 (setq prefix (and (looking-at "[> ]+") 99 (match-string 0))) 100 (if (equal prefix prev-prefix) 101 (forward-line 1) 102 (save-restriction 103 (narrow-to-region start (point)) 104 (let ((fill-prefix prev-prefix)) 105 (fill-region (point-min) (point-max) t 'nosqueeze 'to-eop)) 106 (goto-char (point-max))) 107 (setq prev-prefix prefix 108 start (point)))) 109 (save-restriction 110 (narrow-to-region start (point)) 111 (let ((fill-prefix prev-prefix)) 112 (fill-region (point-min) (point-max) t 'nosqueeze 'to-eop))))) 113 114;;;###autoload 115(defun fill-flowed (&optional buffer delete-space) 116 "Apply RFC2646 decoding to BUFFER. 117If BUFFER is nil, default to the current buffer. 118 119If DELETE-SPACE, delete RFC2646 spaces padding at the end of 120lines." 121 (with-current-buffer (or buffer (current-buffer)) 122 (let ((fill-column (eval fill-flowed-display-column))) 123 (goto-char (point-min)) 124 (while (not (eobp)) 125 (cond 126 ((and (looking-at "^>+") 127 (eq (char-before (line-end-position)) ?\s)) 128 (let ((prefix (match-string 0))) 129 ;; Insert a space character after the quote signs for more 130 ;; pleasant reading of quoted lines. 131 (goto-char (match-end 0)) 132 (unless (looking-at " ") 133 (insert " ")) 134 (end-of-line) 135 (when (and (not (eobp)) 136 (save-excursion 137 (forward-line 1) 138 (looking-at (format "\\(%s ?\\)[^>]" prefix)))) 139 ;; Delete the newline and the quote at the start of the 140 ;; next line. 141 (delete-region (point) (match-end 1)) 142 (ignore-errors 143 (let ((fill-prefix (concat prefix " ")) 144 adaptive-fill-mode) 145 (fill-region (line-beginning-position) 146 (line-end-position) 147 'left 'nosqueeze)))))) 148 (t 149 ;; Delete the newline. 150 (when (eq (following-char) ?\s) 151 (delete-char 1)) 152 ;; Hack: Don't do the flowing on the signature line. 153 (when (and (not (looking-at "-- $")) 154 (eq (char-before (line-end-position)) ?\s)) 155 (end-of-line) 156 (when delete-space 157 (delete-char -1)) 158 (delete-char 1) 159 (ignore-errors 160 (let ((fill-prefix "")) 161 (fill-region (line-beginning-position) 162 (line-end-position) 163 'left 'nosqueeze)))))) 164 (forward-line 1))))) 165 166(make-obsolete-variable 'fill-flowed-encode-tests nil "27.1") 167(defvar fill-flowed-encode-tests) 168 169(defun fill-flowed-test () 170 (interactive "") 171 (declare (obsolete nil "27.1")) 172 (user-error (concat "This function is obsolete. Please see " 173 "test/lisp/mail/flow-fill-tests.el " 174 "in the Emacs source tree"))) 175 176(provide 'flow-fill) 177 178;;; flow-fill.el ends here 179