Commit 537ab246 authored by Bastien Guerry's avatar Bastien Guerry

Renamed all pmail* files to rmail*.

parent 13847f79
This diff is collapsed.
;;; rmailedit.el --- "RMAIL edit mode" Edit the current message
;; Copyright (C) 1985, 1994, 2001, 2002, 2003, 2004, 2005, 2006,
;; 2007, 2008, 2009 Free Software Foundation, Inc.
;; Maintainer: FSF
;; 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 3 of the License, 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. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;; Code:
(eval-when-compile
(require 'rmail)
(require 'rmailsum))
(defcustom rmail-edit-mode-hook nil
"List of functions to call when editing an RMAIL message."
:type 'hook
:version "21.1"
:group 'rmail-edit)
(defvar rmail-old-text)
(defvar rmail-edit-map nil)
(if rmail-edit-map
nil
;; Make a keymap that inherits text-mode-map.
(setq rmail-edit-map (make-sparse-keymap))
(set-keymap-parent rmail-edit-map text-mode-map)
(define-key rmail-edit-map "\C-c\C-c" 'rmail-cease-edit)
(define-key rmail-edit-map "\C-c\C-]" 'rmail-abort-edit))
;; Rmail Edit mode is suitable only for specially formatted data.
(put 'rmail-edit-mode 'mode-class 'special)
(declare-function rmail-summary-disable "" ())
(declare-function rmail-summary-enable "rmailsum" ())
(defun rmail-edit-mode ()
"Major mode for editing the contents of an RMAIL message.
The editing commands are the same as in Text mode, together with two commands
to return to regular RMAIL:
* \\[rmail-abort-edit] cancels the changes
you have made and returns to RMAIL
* \\[rmail-cease-edit] makes them permanent.
This functions runs the normal hook `rmail-edit-mode-hook'.
\\{rmail-edit-map}"
(if (rmail-summary-exists)
(save-excursion
(set-buffer rmail-summary-buffer)
(rmail-summary-disable)))
(let (rmail-buffer-swapped)
;; Prevent change-major-mode-hook from unswapping the buffers.
(delay-mode-hooks (text-mode))
(use-local-map rmail-edit-map)
(setq major-mode 'rmail-edit-mode)
(setq mode-name "RMAIL Edit")
(if (boundp 'mode-line-modified)
(setq mode-line-modified (default-value 'mode-line-modified))
(setq mode-line-format (default-value 'mode-line-format)))
(run-mode-hooks 'rmail-edit-mode-hook)))
(defvar rmail-old-pruned nil)
(put 'rmail-old-pruned 'permanent-local t)
;;;###autoload
(defun rmail-edit-current-message ()
"Edit the contents of this message."
(interactive)
(if (= rmail-total-messages 0)
(error "No messages in this buffer"))
(make-local-variable 'rmail-old-pruned)
(setq rmail-old-pruned (eq rmail-header-style 'normal))
(rmail-edit-mode)
(make-local-variable 'rmail-old-text)
(save-restriction
(widen)
(setq rmail-old-text (buffer-substring (point-min) (point-max))))
(setq buffer-read-only nil)
(setq buffer-undo-list nil)
(force-mode-line-update)
(if (and (eq (key-binding "\C-c\C-c") 'rmail-cease-edit)
(eq (key-binding "\C-c\C-]") 'rmail-abort-edit))
(message "Editing: Type C-c C-c to return to Rmail, C-c C-] to abort")
(message "%s" (substitute-command-keys
"Editing: Type \\[rmail-cease-edit] to return to Rmail, \\[rmail-abort-edit] to abort"))))
(defun rmail-cease-edit ()
"Finish editing message; switch back to Rmail proper."
(interactive)
(if (rmail-summary-exists)
(save-excursion
(set-buffer rmail-summary-buffer)
(rmail-summary-enable)))
(widen)
;; Disguise any "From " lines so they don't start a new message.
(save-excursion
(goto-char (point-min))
(while (search-forward "\nFrom " nil t)
(beginning-of-line)
(insert ">")))
;; Make sure buffer ends with a blank line
;; so as not to run this message together with the following one.
(save-excursion
(goto-char (point-max))
(if (/= (preceding-char) ?\n)
(insert "\n"))
(unless (looking-back "\n\n")
(insert "\n")))
(let ((old rmail-old-text)
character-coding is-text-message coding-system
headers-end)
;; Go back to Rmail mode, but carefully.
(force-mode-line-update)
(let (rmail-buffer-swapped)
(kill-all-local-variables)
(rmail-mode-1)
(if (boundp 'tool-bar-map)
(set (make-local-variable 'tool-bar-map) rmail-tool-bar-map))
(setq buffer-undo-list t)
(rmail-variables))
;; If text has really changed, mark message as edited.
(unless (and (= (length old) (- (point-max) (point-min)))
(string= old (buffer-substring (point-min) (point-max))))
(setq old nil)
(goto-char (point-min))
(search-forward "\n\n")
(setq headers-end (point))
(rmail-swap-buffers-maybe)
(setq character-coding (mail-fetch-field "content-transfer-encoding")
is-text-message (rmail-is-text-p)
coding-system (rmail-get-coding-system))
(if character-coding
(setq character-coding (downcase character-coding)))
(narrow-to-region (rmail-msgbeg rmail-current-message)
(rmail-msgend rmail-current-message))
(goto-char (point-min))
(search-forward "\n\n")
(let ((inhibit-read-only t)
(headers-end-1 (point)))
(insert-buffer-substring rmail-view-buffer headers-end)
(delete-region (point) (point-max))
;; Re-encode the message body in whatever
;; way it was decoded.
(cond
((string= character-coding "quoted-printable")
(mail-quote-printable-region headers-end-1 (point-max)))
((and (string= character-coding "base64") is-text-message)
(base64-encode-region headers-end-1 (point-max)))
((eq character-coding 'uuencode)
(error "Not supported yet."))
(t
(if (or (not coding-system) (not (coding-system-p coding-system)))
(setq coding-system 'undecided))
(encode-coding-region headers-end-1 (point-max) coding-system)))
))
(rmail-set-attribute rmail-edited-attr-index t)
;;??? BROKEN perhaps.
;; I think that the Summary-Line header may not be kept there any more.
;;; (if (boundp 'rmail-summary-vector)
;;; (progn
;;; (aset rmail-summary-vector (1- rmail-current-message) nil)
;;; (save-excursion
;;; (rmail-widen-to-current-msgbeg
;;; (function (lambda ()
;;; (forward-line 2)
;;; (if (looking-at "Summary-line: ")
;;; (let ((buffer-read-only nil))
;;; (delete-region (point)
;;; (progn (forward-line 1)
;;; (point)))))))))))
)
(save-excursion
(rmail-show-message)
(rmail-toggle-header (if rmail-old-pruned 1 0)))
(run-hooks 'rmail-mode-hook))
(defun rmail-abort-edit ()
"Abort edit of current message; restore original contents."
(interactive)
(widen)
(delete-region (point-min) (point-max))
(insert rmail-old-text)
(rmail-cease-edit)
(rmail-highlight-headers))
(provide 'rmailedit)
;; Local Variables:
;; change-log-default-name: "ChangeLog.rmail"
;; End:
;; arch-tag: 9524f335-12cc-4e95-9e9b-3208dc30550b
;;; rmailedit.el ends here
;;; rmailkwd.el --- part of the "RMAIL" mail reader for Emacs
;; Copyright (C) 1985, 1988, 1994, 2001, 2002, 2003, 2004, 2005, 2006,
;; 2007, 2008, 2009 Free Software Foundation, Inc.
;; Maintainer: FSF
;; 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 3 of the License, 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. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;; Code:
(require 'rmail)
;; Global to all RMAIL buffers. It exists primarily for the sake of
;; completion. It is better to use strings with the label functions
;; and let them worry about making the label.
(defvar rmail-label-obarray (make-vector 47 0))
(mapc (function (lambda (s) (intern s rmail-label-obarray)))
'("deleted" "answered" "filed" "forwarded" "unseen" "edited"
"resent"))
(defun rmail-make-label (s)
(intern (downcase s) rmail-label-obarray))
;;;###autoload
(defun rmail-add-label (string)
"Add LABEL to labels associated with current RMAIL message.
Performs completion over known labels when reading."
(interactive (list (rmail-read-label "Add label")))
(rmail-set-label string t))
;;;###autoload
(defun rmail-kill-label (string)
"Remove LABEL from labels associated with current RMAIL message.
Performs completion over known labels when reading."
(interactive (list (rmail-read-label "Remove label")))
(rmail-set-label string nil))
;;;###autoload
(defun rmail-read-label (prompt)
(let ((result
(completing-read (concat prompt
(if rmail-last-label
(concat " (default "
(symbol-name rmail-last-label)
"): ")
": "))
rmail-label-obarray
nil
nil)))
(if (string= result "")
rmail-last-label
(setq rmail-last-label (rmail-make-label result)))))
(defun rmail-set-label (label state &optional msg)
"Set LABEL as present or absent according to STATE in message MSG."
(with-current-buffer rmail-buffer
(rmail-maybe-set-message-counters)
(if (not msg) (setq msg rmail-current-message))
;; Force recalculation of summary for this message.
(aset rmail-summary-vector (1- msg) nil)
(let (attr-index)
;; Is this label an attribute?
(dotimes (i (length rmail-attr-array))
(if (string= (cadr (aref rmail-attr-array i)) label)
(setq attr-index i)))
(if attr-index
;; If so, set it as an attribute.
(rmail-set-attribute attr-index state msg)
;; Is this keyword already present in msg's keyword list?
(let* ((header (rmail-get-header rmail-keyword-header msg))
(regexp (concat ", " (regexp-quote (symbol-name label)) ","))
(present (string-match regexp (concat ", " header ","))))
;; If current state is not correct,
(unless (eq present state)
;; either add it or delete it.
(rmail-set-header
rmail-keyword-header msg
(if state
;; Add this keyword at the end.
(if (and header (not (string= header "")))
(concat header ", " (symbol-name label))
(symbol-name label))
;; Delete this keyword.
(let ((before (substring header 0
(max 0 (- (match-beginning 0) 2))))
(after (substring header
(min (length header)
(- (match-end 0) 1)))))
(cond ((string= before "")
after)
((string= after "")
before)
(t (concat before ", " after)))))))))
(if (= msg rmail-current-message)
(rmail-display-labels)))))
;; Motion on messages with keywords.
;;;###autoload
(defun rmail-previous-labeled-message (n labels)
"Show previous message with one of the labels LABELS.
LABELS should be a comma-separated list of label names.
If LABELS is empty, the last set of labels specified is used.
With prefix argument N moves backward N messages with these labels."
(interactive "p\nsMove to previous msg with labels: ")
(rmail-next-labeled-message (- n) labels))
(declare-function mail-comma-list-regexp "mail-utils" (labels))
;;;###autoload
(defun rmail-next-labeled-message (n labels)
"Show next message with one of the labels LABELS.
LABELS should be a comma-separated list of label names.
If LABELS is empty, the last set of labels specified is used.
With prefix argument N moves forward N messages with these labels."
(interactive "p\nsMove to next msg with labels: ")
(if (string= labels "")
(setq labels rmail-last-multi-labels))
(or labels
(error "No labels to find have been specified previously"))
(set-buffer rmail-buffer)
(setq rmail-last-multi-labels labels)
(rmail-maybe-set-message-counters)
(let ((lastwin rmail-current-message)
(current rmail-current-message)
(regexp (concat ", ?\\("
(mail-comma-list-regexp labels)
"\\),")))
(while (and (> n 0) (< current rmail-total-messages))
(setq current (1+ current))
(if (string-match regexp (rmail-get-labels current))
(setq lastwin current n (1- n))))
(while (and (< n 0) (> current 1))
(setq current (1- current))
(if (string-match regexp (rmail-get-labels current))
(setq lastwin current n (1+ n))))
(if (< n 0)
(error "No previous message with labels %s" labels)
(if (> n 0)
(error "No following message with labels %s" labels)
(rmail-show-message lastwin)))))
(provide 'rmailkwd)
;; Local Variables:
;; change-log-default-name: "ChangeLog.rmail"
;; End:
;; arch-tag: 1149979c-8e47-4333-9629-cf3dc887a6a7
;;; rmailkwd.el ends here
;;; rmailmm.el --- MIME decoding and display stuff for RMAIL
;; Copyright (C) 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
;; Maintainer: FSF
;; 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 3 of the License, 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. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Essentially based on the design of Alexander Pohoyda's MIME
;; extensions (mime-display.el and mime.el). To use, copy a complete
;; message into a new buffer and call (mime-show t).
;; To use:
;; (autoload 'rmail-mime "rmailmm"
;; "Show MIME message." t)
;; (add-hook 'rmail-mode-hook
;; (lambda ()
;; (define-key rmail-mode-map (kbd "v")
;; 'rmail-mime)))
;;; Code:
(require 'rmail)
(require 'mail-parse)
;;; Variables
(defcustom rmail-mime-media-type-handlers-alist
'(("multipart/.*" rmail-mime-multipart-handler)
("text/.*" rmail-mime-text-handler)
("text/\\(x-\\)?patch" rmail-mime-bulk-handler)
("application/pgp-signature" rmail-mime-application/pgp-signature-handler)
("\\(image\\|audio\\|video\\|application\\)/.*" rmail-mime-bulk-handler))
"Alist of media type handlers, also known as agents.
Every handler is a list of type (string symbol) where STRING is a
regular expression to match the media type with and SYMBOL is a
function to run. Handlers should return a non-nil value if the
job is done."
:type 'list
:group 'mime)
(defcustom rmail-mime-attachment-dirs-alist
'(("text/.*" "~/Documents")
("image/.*" "~/Pictures")
(".*" "~/Desktop" "~" "/tmp"))
"Default directories to save attachments into.
Each media type may have it's own list of directories in order of
preference. The first existing directory in the list will be
used."
:type 'list
:group 'mime)
(defvar rmail-mime-total-number-of-bulk-attachments 0
"A total number of attached bulk bodyparts in the message. If more than 3,
offer a way to save all attachments at once.")
(put 'rmail-mime-total-number-of-bulk-attachments 'permanent-local t)
;;; Buttons
(defun rmail-mime-save (button)
"Save the attachment using info in the BUTTON."
(let* ((filename (button-get button 'filename))
(directory (button-get button 'directory))
(data (button-get button 'data)))
(while (file-exists-p (expand-file-name filename directory))
(let* ((f (file-name-sans-extension filename))
(i 1))
(when (string-match "-\\([0-9]+\\)$" f)
(setq i (1+ (string-to-number (match-string 1 f)))
f (substring f 0 (match-beginning 0))))
(setq filename (concat f "-" (number-to-string i) "."
(file-name-extension filename)))))
(setq filename (expand-file-name
(read-file-name (format "Save as (default: %s): " filename)
directory
(expand-file-name filename directory))
directory))
(when (file-regular-p filename)
(error (message "File `%s' already exists" filename)))
(with-temp-file filename
(set-buffer-file-coding-system 'no-conversion)
(insert data))))
(define-button-type 'rmail-mime-save
'action 'rmail-mime-save)
;;; Handlers
(defun rmail-mime-text-handler (content-type
content-disposition
content-transfer-encoding)
"Handle the current buffer as a plain text MIME part."
(let* ((charset (cdr (assq 'charset (cdr content-type))))
(coding-system (when charset
(intern (downcase charset)))))
(when (coding-system-p coding-system)
(decode-coding-region (point-min) (point-max) coding-system))))
(defun test-rmail-mime-handler ()
"Test of a mail using no MIME parts at all."
(let ((mail "To: alex@gnu.org
Content-Type: text/plain; charset=koi8-r
Content-Transfer-Encoding: 8bit
MIME-Version: 1.0
\372\304\322\301\327\323\324\327\325\312\324\305\41"))
(switch-to-buffer (get-buffer-create "*test*"))
(erase-buffer)
(set-buffer-multibyte nil)
(insert mail)
(rmail-mime-show t)
(set-buffer-multibyte t)))
(defun rmail-mime-bulk-handler (content-type
content-disposition
content-transfer-encoding)
"Handle the current buffer as an attachment to download."
(setq rmail-mime-total-number-of-bulk-attachments
(1+ rmail-mime-total-number-of-bulk-attachments))
;; Find the default directory for this media type
(let* ((directory (catch 'directory
(dolist (entry rmail-mime-attachment-dirs-alist)
(when (string-match (car entry) (car content-type))
(dolist (dir (cdr entry))
(when (file-directory-p dir)
(throw 'directory dir)))))))
(filename (or (cdr (assq 'name (cdr content-type)))
(cdr (assq 'filename (cdr content-disposition)))
"noname"))
(label (format "\nAttached %s file: " (car content-type)))
(data (buffer-string)))
(delete-region (point-min) (point-max))
(insert label)
(insert-button filename
:type 'rmail-mime-save
'filename filename
'directory directory
'data data)))
(defun test-rmail-mime-bulk-handler ()
"Test of a mail used as an example in RFC 2183."
(let ((mail "Content-Type: image/jpeg
Content-Disposition: attachment; filename=genome.jpeg;
modification-date=\"Wed, 12 Feb 1997 16:29:51 -0500\";
Content-Description: a complete map of the human genome
Content-Transfer-Encoding: base64
iVBORw0KGgoAAAANSUhEUgAAADAAAAAwCAMAAABg3Am1AAAABGdBTUEAALGPC/xhBQAAAAZQ
TFRF////AAAAVcLTfgAAAPZJREFUeNq9ldsOwzAIQ+3//+l1WlvA5ZLsoUiTto4TB+ISoAjy
+ITfRBfcAmgRFFeAm+J6uhdKdFhFWUgDkFsK0oUp/9G2//Kj7Jx+5tSKOdBscgUYiKHRS/me
WATQdRUvAK0Bnmshmtn79PpaLBbbOZkjKvRnjRZoRswOkG1wFchKew2g9wXVJVZL/m4+B+vv
9AxQQR2Q33SgAYJzzVACdAWjAfRYzYFO9n6SLnydtQHSMxYDMAKqZ/8FS/lTK+zuq3CtK64L
UDwbgUEAUmk2Zyg101d6PhCDySgAvTvDgKiuOrc4dLxUb7UMnhGIexyI+d6U+ABuNAP4Simx
lgAAAABJRU5ErkJggg==
"))
(switch-to-buffer (get-buffer-create "*test*"))
(erase-buffer)
(insert mail)
(rmail-mime-show)))
(defun rmail-mime-multipart-handler (content-type
content-disposition
content-transfer-encoding)
"Handle the current buffer as a multipart MIME body.
The current buffer should be narrowed to the body. CONTENT-TYPE,
CONTENT-DISPOSITION, and CONTENT-TRANSFER-ENCODING are the values
of the respective parsed headers. See `rmail-mime-handle' for their
format."
;; Some MUAs start boundaries with "--", while it should start
;; with "CRLF--", as defined by RFC 2046:
;; The boundary delimiter MUST occur at the beginning of a line,
;; i.e., following a CRLF, and the initial CRLF is considered to
;; be attached to the boundary delimiter line rather than part
;; of the preceding part.
;; We currently don't handle that.
(let ((boundary (cdr (assq 'boundary content-type)))
beg end next)
(unless boundary
(rmail-mm-get-boundary-error-message
"No boundary defined" content-type content-disposition
content-transfer-encoding))
(setq boundary (concat "\n--" boundary))
;; Hide the body before the first bodypart
(goto-char (point-min))
(when (and (search-forward boundary nil t)
(looking-at "[ \t]*\n"))
(delete-region (point-min) (match-end 0)))
;; Reset the counter
(setq rmail-mime-total-number-of-bulk-attachments 0)
;; Loop over all body parts, where beg points at the beginning of
;; the part and end points at the end of the part. next points at
;; the beginning of the next part.
(setq beg (point-min))
(while (search-forward boundary nil t)
(setq end (match-beginning 0))
;; If this is the last boundary according to RFC 2046, hide the
;; epilogue, else hide the boundary only. Use a marker for
;; `next' because `rmail-mime-show' may change the buffer.
(cond ((looking-at "--[ \t]*\n")
(setq next (point-max-marker)))
((looking-at "[ \t]*\n")
(setq next (copy-marker (match-end 0))))
(t
(rmail-mm-get-boundary-error-message
"Malformed boundary" content-type content-disposition
content-transfer-encoding)))
(delete-region end next)
;; Handle the part.
(save-match-data
(save-excursion
(save-restriction
(narrow-to-region beg end)
(rmail-mime-show))))
(setq beg next)
(goto-char beg))))
(defun test-rmail-mime-multipart-handler ()
"Test of a mail used as an example in RFC 2046."
(let ((mail "From: Nathaniel Borenstein <nsb@bellcore.com>