X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fflow-fill.el;h=c72ad40154e4bef4abcfdb2b0d535c7ec7374e96;hb=9b741e050b400987d68ff761c6cc3276c932839c;hp=bf9839d551eb2a19ba03436b7058d08c29f3b463;hpb=191eb7a2bfcd2b268e24faa9933bc190db941cc4;p=elisp%2Fgnus.git- diff --git a/lisp/flow-fill.el b/lisp/flow-fill.el index bf9839d..c72ad40 100644 --- a/lisp/flow-fill.el +++ b/lisp/flow-fill.el @@ -1,6 +1,6 @@ ;;; flow-fill.el --- interprete RFC2646 "flowed" text -;; Copyright (C) 2000, 2001 Free Software Foundation, Inc. +;; Copyright (C) 2000, 2001, 2002 Free Software Foundation, Inc. ;; Author: Simon Josefsson ;; Keywords: mail @@ -35,7 +35,7 @@ ;; paragraph and we let `fill-region' fill the long line into several ;; lines with the quote prefix as `fill-prefix'. -;; Todo: encoding, implement basic `fill-region' (Emacs and XEmacs +;; Todo: implement basic `fill-region' (Emacs and XEmacs ;; implementations differ..) ;;; History: @@ -46,11 +46,29 @@ ;; 2000-03-26 commited 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 ;;; 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." + :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." + :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) @@ -62,6 +80,27 @@ 'point-at-eol 'line-end-position))) +(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))) + (defun fill-flowed (&optional buffer) (save-excursion (set-buffer (or (current-buffer) buffer)) @@ -79,6 +118,7 @@ (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 "-- ")) @@ -94,10 +134,13 @@ (backward-delete-char -1) (end-of-line)) (unless sig - (let ((fill-prefix (when quote (concat quote " ")))) - (fill-region (fill-flowed-point-at-bol) - (min (1+ (fill-flowed-point-at-eol)) (point-max)) - 'left 'nosqueeze)))))))) + (condition-case nil + (let ((fill-prefix (when quote (concat quote " "))) + (fill-column (eval fill-flowed-display-column))) + (fill-region (fill-flowed-point-at-bol) + (min (1+ (fill-flowed-point-at-eol)) (point-max)) + 'left 'nosqueeze)) + (error nil)))))))) (provide 'flow-fill)