;;; vm-advices.el --- misc patches to VM using defadvice

;; Copyright (C) 1994-1999 Noah S. Friedman

;; Author: Noah Friedman <friedman@splode.com>
;; Maintainer: friedman@splode.com

;; $Id: vm-advices.el,v 1.4 1999/10/22 07:54:12 friedman Exp $

;; This program 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.
;;
;; This program 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 this program; if not, you can either send email to this
;; program's maintainer or write to: The Free Software Foundation,
;; Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA.

;;; Commentary:

;; These patches cannot be autoloaded.
;; To use, require it in ~/.vm.

;;; Code:

(require 'advice)
(require 'vm-addons)


(defadvice vm-decode-mime-message (around fixup-final-boundary activate)
  "Handle missing final mime boundary from noncompliant MUAs."
  (interactive)
  (condition-case err
      ad-do-it
    (error
     (cond
      ((and (stringp (nth 1 err))
            (save-match-data
              (string-match "^Invalid MIME message: final.*boundary missing$"
                            (nth 1 err))))
       (vma-mime-add-final-boundary)
       ad-do-it)
      (t
       (signal (car err) (cdr err)))))))

;; I found that I first needed this in vm 6.68.  Prior to that, this error
;; was caught by the advice around vm-decode-mime-message.
(defadvice vm-mime-parse-entity (around fixup-final-boundary activate)
  "If missing final mime boundary is detected, add one and reparse."
  (condition-case err
      ad-do-it
    (vm-mime-error
     (cond
      ((save-match-data
         (string-match "^final .* boundary missing$" (nth 1 err)))
       (save-excursion
         (save-window-excursion
           (vma-mime-add-final-boundary)))
       ad-do-it)))))


(defadvice vm-forward-message (around prefix-select-type activate)
  "With prefix arg, select a digest type for the forwarded message."
  (let ((vm-forwarding-digest-type vm-forwarding-digest-type))
    (and current-prefix-arg
         (setq vm-forwarding-digest-type
               (vma-read-forward-type "Forwarding using digest type")))
    ad-do-it))

(defadvice vm-make-presentation-copy (around vma-presentation-ro activate)
  "Inhibit read-only text properties while this function is running."
  (let ((inhibit-read-only t))
    ad-do-it))

;; The original definition will signal an error in Emacs 20 because
;; (match-beginning n) for unmatched values of n will signal an error;
;; VM assumes it will return nil, as it did in Emacs 19.
;;
;; Is this alternate definition correct?
;;
;;      (mapcar (function (lambda (n) (if (markerp n) (marker-position n) n)))
;;              (match-data))
;;
;; Not sure if it does the right thing about strings vs. buffer offsets.
(defadvice vm-match-data (around safe-match-data activate)
  "Work safely in Emacs 20."
  (let ((n (/ (length (match-data)) 2))
        (list nil))
    (while (>= n 0)
      (setq list (cons (match-beginning n)
                       (cons (match-end n) list))
            n (1- n)))
    (setq ad-return-value list)))

(defadvice vm-mime-display-internal-text/html (around protect-env activate)
  "VM 6.58 and later inlines the formatting of html in the current buffer,
which upsets some buffer-local settings because of w3-3.0.86's
implementation of w3-region.  Later versions may behave this way too."
  (let ((inhibit-read-only t)
        (fill-column fill-column)
        (fill-prefix fill-prefix)
        (filladapt-mode filladapt-mode)
        ;; Don't let w3 disable undo in this buffer.
        (buffer-undo-list buffer-undo-list))
    ad-do-it))

;; MUAs which set "Content-Type: text" are wrong, I think.  But I've seen
;; enough of these to be irritated by them.
(defadvice vm-mime-get-header-contents (after fixup-text-content-type activate)
  "If Content-Type is mangled as just \"text\", return \"text/plain\" instead."
  (and (string= (ad-get-arg 0) "Content-Type:")
       (string= ad-return-value "text")
       (setq ad-return-value "text/plain")))

(defadvice vm-mime-insert-button (around read-only-props-can-blow-me activate)
  "Inhibit read-only text properties while this function is running."
  (let ((inhibit-read-only t))
    ad-do-it))

;; Undo substitution of leading zeros for whitespace in date.
;; Early versions of VM had a different date parsing mechanism.
;; I don't know exactly what version started using vm-su-do-date, but
;; this handles version 5.72 through 6.31, and possibly later.
(defadvice vm-su-monthday (around fixup-whitespace activate)
  (let ((s ad-do-it))
    (cond ((= ?\  (aref s 0))
           (aset s 0 ?0))
          ;; This can happen in vm 6.x
          ((= (length s) 1)
           (setq s (make-string 2 (aref s 0)))
           (aset s 0 ?0)))
    (setq ad-return-value s)))

(provide 'vm-advices)

;;; vm-advices.el ends here.