;; 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:
;; 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:
'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 66))
+ (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))
(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 "-- "))
(backward-delete-char -1)
(end-of-line))
(unless sig
- (let ((fill-prefix (when quote (concat quote " "))))
+ (let ((fill-prefix (when quote (concat quote " ")))
+ (fill-column (1- (window-width))))
(fill-region (fill-flowed-point-at-bol)
(min (1+ (fill-flowed-point-at-eol)) (point-max))
'left 'nosqueeze))))))))
(autoload 'gnus-setup-posting-charset "gnus-msg")
(autoload 'gnus-add-minor-mode "gnus-ems")
(autoload 'message-fetch-field "message")
+ (autoload 'fill-flowed-encode "flow-fill")
(autoload 'message-posting-charset "message"))
(defcustom mml-content-type-parameters
(setq contents (append (list (cons 'tag-location orig-point)) contents))
(cons (intern name) (nreverse contents))))
+(defun mml-buffer-substring-no-properties-except-hard-newlines (start end)
+ (let ((str (buffer-substring-no-properties start end))
+ (bufstart start) tmp)
+ (while (setq tmp (text-property-any start end 'hard 't))
+ (set-text-properties (- tmp bufstart) (- tmp bufstart -1)
+ '(hard t) str)
+ (setq start (1+ tmp)))
+ str))
+
(defun mml-read-part (&optional mml)
"Return the buffer up till the next part, multipart or closing part or multipart.
If MML is non-nil, return the buffer up till the correspondent mml tag."
(if (re-search-forward "<#\\(/\\)?mml." nil t)
(setq count (+ count (if (match-beginning 1) -1 1)))
(goto-char (point-max))))
- (buffer-substring-no-properties beg (if (> count 0)
- (point)
- (match-beginning 0))))
+ (mml-buffer-substring-no-properties-except-hard-newlines
+ beg (if (> count 0)
+ (point)
+ (match-beginning 0))))
(if (re-search-forward
"<#\\(/\\)?\\(multipart\\|part\\|external\\|mml\\)." nil t)
(prog1
- (buffer-substring-no-properties beg (match-beginning 0))
+ (mml-buffer-substring-no-properties-except-hard-newlines
+ beg (match-beginning 0))
(if (or (not (match-beginning 1))
(equal (match-string 2) "multipart"))
(goto-char (match-beginning 0))
(when (looking-at "[ \t]*\n")
(forward-line 1))))
- (buffer-substring-no-properties beg (goto-char (point-max)))))))
+ (mml-buffer-substring-no-properties-except-hard-newlines
+ beg (goto-char (point-max)))))))
(defvar mml-boundary nil)
(defvar mml-base-boundary "-=-=")
(cond
((or (eq (car cont) 'part) (eq (car cont) 'mml))
(let ((raw (cdr (assq 'raw cont)))
- coded encoding charset filename type)
+ coded encoding charset filename type flowed)
(setq type (or (cdr (assq 'type cont)) "text/plain"))
(if (and (not raw)
(member (car (split-string type "/")) '("text" "message")))
(setq charset (mm-encode-body charset))
(setq encoding (mm-body-encoding
charset (cdr (assq 'encoding cont))))))
+ ;; Only perform format=flowed filling on text/plain
+ ;; parts where there either isn't a format parameter
+ ;; in the mml tag or it says "flowed" and there
+ ;; actually are hard newlines in the text.
+ (let (use-hard-newlines)
+ (when (and (string= type "text/plain")
+ (or (null (assq 'format cont))
+ (string= (assq 'format cont) "flowed"))
+ (setq use-hard-newlines
+ (text-property-any
+ (point-min) (point-max) 'hard 't)))
+ (fill-flowed-encode)
+ ;; Indicate that `mml-insert-mime-headers' should
+ ;; insert a "; format=flowed" string unless the
+ ;; user has already specified it.
+ (setq flowed (null (assq 'format cont)))))
(setq coded (buffer-string)))
- (mml-insert-mime-headers cont type charset encoding)
+ (mml-insert-mime-headers cont type charset encoding flowed)
(insert "\n")
(insert coded))
(mm-with-unibyte-buffer
(insert (cdr (assq 'contents cont)))))
(setq encoding (mm-encode-buffer type)
coded (mm-string-as-multibyte (buffer-string))))
- (mml-insert-mime-headers cont type charset encoding)
+ (mml-insert-mime-headers cont type charset encoding nil)
(insert "\n")
(mm-with-unibyte-current-buffer
(insert coded)))))
"")
mml-base-boundary))
-(defun mml-insert-mime-headers (cont type charset encoding)
+(defun mml-insert-mime-headers (cont type charset encoding flowed)
(let (parameters disposition description)
(setq parameters
(mml-parameter-string
cont mml-content-type-parameters))
(when (or charset
parameters
+ flowed
(not (equal type mml-generate-default-type)))
(when (consp charset)
(error
(when charset
(insert "; " (mail-header-encode-parameter
"charset" (symbol-name charset))))
+ (when flowed
+ (insert "; format=flowed"))
(when parameters
(mml-insert-parameter-string
cont mml-content-type-parameters))