annotate lisp/gnus/flow-fill.el @ 33123:18591e92c712

*** empty log message ***
author Stefan Monnier <monnier@iro.umontreal.ca>
date Wed, 01 Nov 2000 16:27:08 +0000
parents 6d074bbd2bbb
children 52d99cc2e9e3
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1 ;;; flow-fill.el --- interprete RFC2646 "flowed" text
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3 ;; Copyright (C) 2000 Free Software Foundation, Inc.
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5 ;; Author: Simon Josefsson <jas@pdc.kth.se>
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
6 ;; Keywords: mail
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
7
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
8 ;; This file is part of GNU Emacs.
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
9
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
11 ;; it under the terms of the GNU General Public License as published by
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
12 ;; the Free Software Foundation; either version 2, or (at your option)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
13 ;; any later version.
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
14
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
15 ;; GNU Emacs is distributed in the hope that it will be useful,
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
18 ;; GNU General Public License for more details.
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
19
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
20 ;; You should have received a copy of the GNU General Public License
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
23 ;; Boston, MA 02111-1307, USA.
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
24
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
25 ;;; Commentary:
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
26
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
27 ;; This implement decoding of RFC2646 formatted text, including the
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
28 ;; quoted-depth wins rules.
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
29
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
30 ;; Theory of operation: search for lines ending with SPC, save quote
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
31 ;; length of line, remove SPC and concatenate line with the following
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
32 ;; line if quote length of following line matches current line.
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
33
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
34 ;; When no further concatenations are possible, we've found a
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
35 ;; paragraph and we let `fill-region' fill the long line into several
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
36 ;; lines with the quote prefix as `fill-prefix'.
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
37
32923
6d074bbd2bbb 2000-10-26 Dave Love <fx@gnu.org>
Dave Love <fx@gnu.org>
parents: 31717
diff changeset
38 ;; Todo: encoding, implement basic `fill-region' (Emacs and XEmacs
6d074bbd2bbb 2000-10-26 Dave Love <fx@gnu.org>
Dave Love <fx@gnu.org>
parents: 31717
diff changeset
39 ;; implementations differ..)
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
40
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
41 ;; History:
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
42
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
43 ;; 2000-02-17 posted on ding mailing list
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
44 ;; 2000-02-19 use `point-at-{b,e}ol' in XEmacs
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
45 ;; 2000-03-11 no compile warnings for point-at-bol stuff
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
46 ;; 2000-03-26 commited to gnus cvs
32923
6d074bbd2bbb 2000-10-26 Dave Love <fx@gnu.org>
Dave Love <fx@gnu.org>
parents: 31717
diff changeset
47 ;; 2000-10-23 don't flow "-- " lines, make "quote-depth wins" rule
6d074bbd2bbb 2000-10-26 Dave Love <fx@gnu.org>
Dave Love <fx@gnu.org>
parents: 31717
diff changeset
48 ;; work when first line is at level 0.
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
49
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
50 ;;; Code:
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
51
32923
6d074bbd2bbb 2000-10-26 Dave Love <fx@gnu.org>
Dave Love <fx@gnu.org>
parents: 31717
diff changeset
52 (eval-when-compile (require 'cl))
6d074bbd2bbb 2000-10-26 Dave Love <fx@gnu.org>
Dave Love <fx@gnu.org>
parents: 31717
diff changeset
53
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
54 (eval-and-compile
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
55 (defalias 'fill-flowed-point-at-bol
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
56 (if (fboundp 'point-at-bol)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
57 'point-at-bol
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
58 'line-beginning-position))
32923
6d074bbd2bbb 2000-10-26 Dave Love <fx@gnu.org>
Dave Love <fx@gnu.org>
parents: 31717
diff changeset
59
6d074bbd2bbb 2000-10-26 Dave Love <fx@gnu.org>
Dave Love <fx@gnu.org>
parents: 31717
diff changeset
60 (defalias 'fill-flowed-point-at-eol
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
61 (if (fboundp 'point-at-eol)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
62 'point-at-eol
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
63 'line-end-position)))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
64
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
65 (defun fill-flowed (&optional buffer)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
66 (save-excursion
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
67 (set-buffer (or (current-buffer) buffer))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
68 (goto-char (point-min))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
69 (while (re-search-forward " $" nil t)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
70 (when (save-excursion
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
71 (beginning-of-line)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
72 (looking-at "^\\(>*\\)\\( ?\\)"))
32923
6d074bbd2bbb 2000-10-26 Dave Love <fx@gnu.org>
Dave Love <fx@gnu.org>
parents: 31717
diff changeset
73 (let ((quote (match-string 1)) sig)
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
74 (if (string= quote "")
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
75 (setq quote nil))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
76 (when (and quote (string= (match-string 2) ""))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
77 (save-excursion
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
78 ;; insert SP after quote for pleasant reading of quoted lines
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
79 (beginning-of-line)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
80 (when (> (skip-chars-forward ">") 0)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
81 (insert " "))))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
82 (while (and (save-excursion
32923
6d074bbd2bbb 2000-10-26 Dave Love <fx@gnu.org>
Dave Love <fx@gnu.org>
parents: 31717
diff changeset
83 (ignore-errors (backward-char 3))
6d074bbd2bbb 2000-10-26 Dave Love <fx@gnu.org>
Dave Love <fx@gnu.org>
parents: 31717
diff changeset
84 (setq sig (looking-at "-- "))
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
85 (looking-at "[^-][^-] "))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
86 (save-excursion
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
87 (unless (eobp)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
88 (forward-char 1)
32923
6d074bbd2bbb 2000-10-26 Dave Love <fx@gnu.org>
Dave Love <fx@gnu.org>
parents: 31717
diff changeset
89 (looking-at (format "^\\(%s\\)\\([^>]\\)" (or quote " ?"))))))
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
90 (save-excursion
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
91 (replace-match (if (string= (match-string 2) " ")
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
92 "" "\\2")))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
93 (backward-delete-char -1)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
94 (end-of-line))
32923
6d074bbd2bbb 2000-10-26 Dave Love <fx@gnu.org>
Dave Love <fx@gnu.org>
parents: 31717
diff changeset
95 (unless sig
6d074bbd2bbb 2000-10-26 Dave Love <fx@gnu.org>
Dave Love <fx@gnu.org>
parents: 31717
diff changeset
96 (let ((fill-prefix (when quote (concat quote " "))))
6d074bbd2bbb 2000-10-26 Dave Love <fx@gnu.org>
Dave Love <fx@gnu.org>
parents: 31717
diff changeset
97 (fill-region (fill-flowed-point-at-bol)
6d074bbd2bbb 2000-10-26 Dave Love <fx@gnu.org>
Dave Love <fx@gnu.org>
parents: 31717
diff changeset
98 (fill-flowed-point-at-eol)
6d074bbd2bbb 2000-10-26 Dave Love <fx@gnu.org>
Dave Love <fx@gnu.org>
parents: 31717
diff changeset
99 'left 'nosqueeze))))))))
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
100
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
101 (provide 'flow-fill)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
102
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
103 ;;; flow-fill.el ends here