Mercurial > emacs
view lisp/gnus/flow-fill.el @ 68129:6f5da26b0df1
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-690
Merge from gnus--rel--5.10
Patches applied:
* gnus--rel--5.10 (patch 174-181)
- Update from CVS
- Update from CVS: texi/gnus.texi (RSS): Addition.
2006-01-10 Katsumi Yamaoka <yamaoka@jpl.org>
* lisp/gnus/nnrss.el (nnrss-wash-html-in-text-plain-parts): New variable.
(nnrss-request-article): Render text/plain parts as HTML.
* lisp/gnus/gnus-art.el (gnus-article-wash-html-with-w3m): No need to narrow
the buffer.
2006-01-08 Reiner Steib <Reiner.Steib@gmx.de>
* lisp/gnus/gnus-cus.el (gnus-group-parameters): Sync posting-style with
custom definition of `gnus-posting-styles'.
* lisp/gnus/gnus-start.el (gnus-gnus-to-quick-newsrc-format): Bind
print-circle. Suggested by Kalle Olavi Niemitalo <kon@iki.fi>.
2006-01-05 Reiner Steib <Reiner.Steib@gmx.de>
* lisp/gnus/gnus-group.el (gnus-useful-groups): Use Gmane for ding. Use
nntp for bug archive.
2006-01-05 Katsumi Yamaoka <yamaoka@jpl.org>
* lisp/gnus/nnrss.el (nnrss-request-article): Fix the way to fill text/plain
parts.
(nnrss-normalize-date): New function converts ISO 8601 date into
RFC822 style. Suggested by Mark Plaksin <happy@mcplaksin.org>.
(nnrss-check-group): Use it.
2006-01-03 Rodrigo Ventura <yoda@isr.ist.utl.pt> (tiny change)
* lisp/gnus/gnus-xmas.el (gnus-xmas-group-startup-message): Typo
gnus-splash-face -> gnus-splash. Fixes starting from a TTY in
XEmacs.
2006-01-01 Katsumi Yamaoka <yamaoka@jpl.org>
* lisp/gnus/gnus-sum.el (gnus-summary-work-articles): Remove useless `min'.
* lisp/gnus/nnrss.el (nnrss-fetch): Make it fail gracefully when it can't
fetch a feed. Suggested by Mark Plaksin <happy@mcplaksin.org>.
(nnrss-insert-w3): Ditto.
2005-12-21 Katsumi Yamaoka <yamaoka@jpl.org>
* lisp/gnus/nnrss.el (nnrss-request-article): Fix last change; fill
text/plain parts.
2005-12-20 Katsumi Yamaoka <yamaoka@jpl.org>
* lisp/gnus/nnrss.el (nnrss-request-article): Replace <br />s with newlines
in text/plain part.
(nnrss-check-group): Don't add excessive newline to dc:subject.
2005-12-19 Katsumi Yamaoka <yamaoka@jpl.org>
* lisp/gnus/gnus-art.el (gnus-article-delete-text-of-type): Enable it to
remove MIME buttons associated with multipart/alternative parts.
(gnus-mime-display-alternative): Tag buttons using `article-type'
text property.
* lisp/gnus/gnus-msg.el (gnus-copy-article-buffer): Remove MIME buttons
associated with multipart/alternative parts.
2005-12-19 Mark Plaksin <happy@mcplaksin.org> (tiny change)
* lisp/gnus/nnrss.el (nnrss-check-group): Put the RSS dc:subject in the
article.
2005-12-18 Lars Magne Ingebrigtsen <larsi@gnus.org>
* lisp/gnus/dns.el (query-dns): Make sure we check the buffer size before
removing tcp headers.
2006-01-10 Katsumi Yamaoka <yamaoka@jpl.org>
* man/gnus.texi (RSS): Document nnrss-wash-html-in-text-plain-parts.
2006-01-06 Katsumi Yamaoka <yamaoka@jpl.org>
* man/gnus.texi (RSS): Addition.
2005-12-22 Katsumi Yamaoka <yamaoka@jpl.org>
* man/gnus.texi (Summary Post Commands): Fix function bound to `S O p'.
2005-12-19 Katsumi Yamaoka <yamaoka@jpl.org>
* man/emacs-mime.texi (Display Customization): Add setting example to
mm-discouraged-alternatives.
author | Miles Bader <miles@gnu.org> |
---|---|
date | Wed, 11 Jan 2006 02:03:24 +0000 |
parents | e65b759c6906 |
children | 1077b8039c32 7beb78bc1f8e |
line wrap: on
line source
;;; flow-fill.el --- interpret RFC2646 "flowed" text ;; Copyright (C) 2000, 2001, 2002, 2003, 2004, ;; 2005 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 2, 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; see the file COPYING. If not, write to the ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; 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' (Emacs and XEmacs ;; implementations differ..) ;;; 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: (eval-when-compile (require 'cl)) (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))) (eval-and-compile (defalias 'fill-flowed-point-at-bol (if (fboundp 'point-at-bol) 'point-at-bol 'line-beginning-position)) (defalias 'fill-flowed-point-at-eol (if (fboundp 'point-at-eol) 'point-at-eol 'line-end-position))) ;;;###autoload (defun fill-flowed-encode (&optional buffer) (with-current-buffer (or buffer (current-buffer)) ;; No point in doing this unless hard newlines is used. (when use-hard-newlines (let ((start (point-min)) end) ;; Go through each paragraph, filling it and adding SPC ;; as the last character on each line. (while (setq end (text-property-any start (point-max) 'hard 't)) (let ((fill-column (eval fill-flowed-encode-column))) (fill-region start end t 'nosqueeze 'to-eop)) (goto-char start) ;; `fill-region' probably distorted end. (setq end (text-property-any start (point-max) 'hard 't)) (while (and (< (point) end) (re-search-forward "$" (1- end) t)) (insert " ") (setq end (1+ end)) (forward-char)) (goto-char (setq start (1+ end))))) t))) ;;;###autoload (defun fill-flowed (&optional buffer) (save-excursion (set-buffer (or (current-buffer) buffer)) (goto-char (point-min)) (while (re-search-forward " $" nil t) (when (save-excursion (beginning-of-line) (looking-at "^\\(>*\\)\\( ?\\)")) (let ((quote (match-string 1)) sig) (if (string= quote "") (setq quote nil)) (when (and quote (string= (match-string 2) "")) (save-excursion ;; insert SP after quote for pleasant reading of quoted lines (beginning-of-line) (when (> (skip-chars-forward ">") 0) (insert " ")))) ;; XXX slightly buggy handling of "-- " (while (and (save-excursion (ignore-errors (backward-char 3)) (setq sig (looking-at "-- ")) (looking-at "[^-][^-] ")) (save-excursion (unless (eobp) (forward-char 1) (looking-at (format "^\\(%s\\)\\([^>\n\r]\\)" (or quote " ?")))))) (save-excursion (replace-match (if (string= (match-string 2) " ") "" "\\2"))) (backward-delete-char -1) (end-of-line)) (unless sig (condition-case nil (let ((fill-prefix (when quote (concat quote " "))) (fill-column (eval fill-flowed-display-column)) filladapt-mode) (fill-region (fill-flowed-point-at-bol) (min (1+ (fill-flowed-point-at-eol)) (point-max)) 'left 'nosqueeze)) (error (forward-line 1) nil)))))))) ;; Test vectors. (eval-when-compile (defvar show-trailing-whitespace)) (defvar fill-flowed-encode-tests `( ;; The syntax of each list element is: ;; (INPUT . EXPECTED-OUTPUT) (,(concat "> Thou villainous ill-breeding spongy dizzy-eyed \n" "> reeky elf-skinned pigeon-egg! \n" ">> Thou artless swag-bellied milk-livered \n" ">> dismal-dreaming idle-headed scut!\n" ">>> Thou errant folly-fallen spleeny reeling-ripe \n" ">>> unmuzzled ratsbane!\n" ">>>> Henceforth, the coding style is to be strictly \n" ">>>> enforced, including the use of only upper case.\n" ">>>>> I've noticed a lack of adherence to the coding \n" ">>>>> styles, of late.\n" ">>>>>> Any complaints?") . ,(concat "> Thou villainous ill-breeding spongy dizzy-eyed reeky elf-skinned\n" "> pigeon-egg! \n" ">> Thou artless swag-bellied milk-livered dismal-dreaming idle-headed\n" ">> scut!\n" ">>> Thou errant folly-fallen spleeny reeling-ripe unmuzzled ratsbane!\n" ">>>> Henceforth, the coding style is to be strictly enforced,\n" ">>>> including the use of only upper case.\n" ">>>>> I've noticed a lack of adherence to the coding styles, of late.\n" ">>>>>> Any complaints?\n" )) ;; (,(concat ;; "\n" ;; "> foo\n" ;; "> \n" ;; "> \n" ;; "> bar\n") ;; . ;; ,(concat ;; "\n" ;; "> foo bar\n")) )) (defun fill-flowed-test () (interactive "") (switch-to-buffer (get-buffer-create "*Format=Flowed test output*")) (erase-buffer) (setq show-trailing-whitespace t) (dolist (test fill-flowed-encode-tests) (let (start output) (insert "***** BEGIN TEST INPUT *****\n") (insert (car test)) (insert "***** END TEST INPUT *****\n\n") (insert "***** BEGIN TEST OUTPUT *****\n") (setq start (point)) (insert (car test)) (save-restriction (narrow-to-region start (point)) (fill-flowed)) (setq output (buffer-substring start (point-max))) (insert "***** END TEST OUTPUT *****\n") (unless (string= output (cdr test)) (insert "\n***** BEGIN TEST EXPECTED OUTPUT *****\n") (insert (cdr test)) (insert "***** END TEST EXPECTED OUTPUT *****\n")) (insert "\n\n"))) (goto-char (point-max))) (provide 'flow-fill) ;;; arch-tag: addc0040-bc53-4f17-b4bc-1eb44eed6f0b ;;; flow-fill.el ends here