code.delx.au - gnu-emacs/blob - lisp/mail/pmailedit.el

   1 ;;; pmailedit.el --- "PMAIL edit mode"  Edit the current message
   2
   3 ;; Copyright (C) 1985, 1994, 2001, 2002, 2003, 2004, 2005, 2006,
   4 ;;   2007, 2008 Free Software Foundation, Inc.
   5
   6 ;; Maintainer: FSF
   7 ;; Keywords: mail
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs is free software: you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation, either version 3 of the License, or
  14 ;; (at your option) any later version.
  15
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  23
  24 ;;; Commentary:
  25
  26 ;;; Code:
  27
  28 (eval-when-compile
  29   (require 'pmail)
  30   (require 'pmailsum))
  31
  32 (defcustom pmail-edit-mode-hook nil
  33   "List of functions to call when editing an PMAIL message."
  34   :type 'hook
  35   :version "21.1"
  36   :group 'pmail-edit)
  37
  38 (defvar pmail-old-text)
  39
  40 (defvar pmail-edit-map nil)
  41 (if pmail-edit-map
  42     nil
  43   ;; Make a keymap that inherits text-mode-map.
  44   (setq pmail-edit-map (make-sparse-keymap))
  45   (set-keymap-parent pmail-edit-map text-mode-map)
  46   (define-key pmail-edit-map "\C-c\C-c" 'pmail-cease-edit)
  47   (define-key pmail-edit-map "\C-c\C-]" 'pmail-abort-edit))
  48
  49 ;; Pmail Edit mode is suitable only for specially formatted data.
  50 (put 'pmail-edit-mode 'mode-class 'special)
  51
  52 (declare-function pmail-summary-disable "" ())
  53 (declare-function pmail-summary-enable "pmailsum" ())
  54
  55 (defun pmail-edit-mode ()
  56   "Major mode for editing the contents of an PMAIL message.
  57 The editing commands are the same as in Text mode, together with two commands
  58 to return to regular PMAIL:
  59   *  \\[pmail-abort-edit] cancels the changes
  60      you have made and returns to PMAIL
  61   *  \\[pmail-cease-edit] makes them permanent.
  62 This functions runs the normal hook `pmail-edit-mode-hook'.
  63 \\{pmail-edit-map}"
  64   (if (pmail-summary-exists)
  65       (save-excursion
  66         (set-buffer pmail-summary-buffer)
  67         (pmail-summary-disable)))
  68   (let (buffer-swapped-with)
  69     ;; Prevent change-major-mode-hook from unswapping the buffers.
  70     (delay-mode-hooks (text-mode))
  71     (use-local-map pmail-edit-map)
  72     (setq major-mode 'pmail-edit-mode)
  73     (setq mode-name "PMAIL Edit")
  74     (if (boundp 'mode-line-modified)
  75         (setq mode-line-modified (default-value 'mode-line-modified))
  76       (setq mode-line-format (default-value 'mode-line-format)))
  77     (run-mode-hooks 'pmail-edit-mode-hook)))
  78
  79 (defvar pmail-old-pruned nil)
  80 (put 'pmail-old-pruned 'permanent-local t)
  81
  82 ;;;###autoload
  83 (defun pmail-edit-current-message ()
  84   "Edit the contents of this message."
  85   (interactive)
  86   (if (= pmail-total-messages 0)
  87       (error "No messages in this buffer"))
  88   (make-local-variable 'pmail-old-pruned)
  89   (setq pmail-old-pruned (eq pmail-header-style 'normal))
  90   (pmail-edit-mode)
  91   (make-local-variable 'pmail-old-text)
  92   (save-restriction
  93     (widen)
  94     (setq pmail-old-text (buffer-substring (point-min) (point-max))))
  95   (setq buffer-read-only nil)
  96   (setq buffer-undo-list nil)
  97   (force-mode-line-update)
  98   (if (and (eq (key-binding "\C-c\C-c") 'pmail-cease-edit)
  99            (eq (key-binding "\C-c\C-]") 'pmail-abort-edit))
 100       (message "Editing: Type C-c C-c to return to Pmail, C-c C-] to abort")
 101     (message "%s" (substitute-command-keys
 102                    "Editing: Type \\[pmail-cease-edit] to return to Pmail, \\[pmail-abort-edit] to abort"))))
 103
 104 (defun pmail-cease-edit ()
 105   "Finish editing message; switch back to Pmail proper."
 106   (interactive)
 107   (if (pmail-summary-exists)
 108       (save-excursion
 109         (set-buffer pmail-summary-buffer)
 110         (pmail-summary-enable)))
 111   (widen)
 112   ;; Disguise any "From " lines so they don't start a new message.
 113   (save-excursion
 114     (goto-char (point-min))
 115     (while (search-forward "\nFrom " nil t)
 116       (beginning-of-line)
 117       (insert ">")))
 118   ;; Make sure buffer ends with a blank line
 119   ;; so as not to run this message together with the following one.
 120   (save-excursion
 121     (goto-char (point-max))
 122     (if (/= (preceding-char) ?\n)
 123         (insert "\n"))
 124     (unless (looking-back "\n\n")
 125       (insert "\n")))
 126   (let ((old pmail-old-text)
 127         character-coding is-text-message coding-system
 128         headers-end)
 129     ;; Go back to Pmail mode, but carefully.
 130     (force-mode-line-update)
 131     (let (buffer-swapped-with)
 132       (kill-all-local-variables)
 133       (pmail-mode-1)
 134       (if (boundp 'tool-bar-map)
 135           (set (make-local-variable 'tool-bar-map) pmail-tool-bar-map))
 136       (setq buffer-undo-list t)
 137       (pmail-variables))
 138     ;; If text has really changed, mark message as edited.
 139     (unless (and (= (length old) (- (point-max) (point-min)))
 140                  (string= old (buffer-substring (point-min) (point-max))))
 141       (setq old nil)
 142       (goto-char (point-min))
 143       (search-forward "\n\n")
 144       (setq headers-end (point))
 145
 146       (pmail-swap-buffers-maybe)
 147
 148       (setq character-coding (mail-fetch-field "content-transfer-encoding")
 149             is-text-message (pmail-is-text-p)
 150             coding-system (pmail-get-coding-system))
 151       (if character-coding
 152           (setq character-coding (downcase character-coding)))
 153
 154       (narrow-to-region (pmail-msgbeg pmail-current-message)
 155                         (pmail-msgend pmail-current-message))
 156       (goto-char (point-min))
 157       (search-forward "\n\n")
 158       (let ((inhibit-read-only t)
 159             (headers-end-1 (point)))
 160         (insert-buffer-substring pmail-view-buffer headers-end)
 161         (delete-region (point) (point-max))
 162
 163         ;; Re-encode the message body in whatever
 164         ;; way it was decoded.
 165         (cond
 166          ((string= character-coding "quoted-printable")
 167           (mail-quote-printable-region headers-end-1 (point-max)))
 168          ((and (string= character-coding "base64") is-text-message)
 169           (base64-encode-region headers-end-1 (point-max)))
 170          ((eq character-coding 'uuencode)
 171           (error "Not supported yet."))
 172          (t
 173           (if (or (not coding-system) (not (coding-system-p coding-system)))
 174               (setq coding-system 'undecided))
 175           (encode-coding-region headers-end-1 (point-max) coding-system)))
 176         ))
 177
 178     (pmail-set-attribute pmail-edited-attr-index t)
 179
 180     ;;??? BROKEN perhaps.
 181     ;; I think that the Summary-Line header may not be kept there any more.
 182 ;;;       (if (boundp 'pmail-summary-vector)
 183 ;;;       (progn
 184 ;;;         (aset pmail-summary-vector (1- pmail-current-message) nil)
 185 ;;;         (save-excursion
 186 ;;;           (pmail-widen-to-current-msgbeg
 187 ;;;             (function (lambda ()
 188 ;;;                         (forward-line 2)
 189 ;;;                         (if (looking-at "Summary-line: ")
 190 ;;;                             (let ((buffer-read-only nil))
 191 ;;;                               (delete-region (point)
 192 ;;;                                              (progn (forward-line 1)
 193 ;;;                                                     (point)))))))))))
 194     )
 195
 196   (save-excursion
 197     (pmail-show-message)
 198     (pmail-toggle-header (if pmail-old-pruned 1 0)))
 199   (run-hooks 'pmail-mode-hook))
 200
 201 (defun pmail-abort-edit ()
 202   "Abort edit of current message; restore original contents."
 203   (interactive)
 204   (widen)
 205   (delete-region (point-min) (point-max))
 206   (insert pmail-old-text)
 207   (pmail-cease-edit)
 208   (pmail-highlight-headers))
 209
 210 (provide 'pmailedit)
 211
 212 ;; Local Variables:
 213 ;; change-log-default-name: "ChangeLog.pmail"
 214 ;; End:
 215
 216 ;; arch-tag: 9524f335-12cc-4e95-9e9b-3208dc30550b
 217 ;;; pmailedit.el ends here