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