Skip to content

GitLab

Commit 3081c1aa authored by Chong Yidong's avatar Chong Yidong
Browse files
Options

File removed.

parent 6973aaa3
Expand all Hide whitespace changes
Inline Side-by-side
Showing with 0 additions and 7367 deletions
lisp/mail/pmail.el deleted 100644 → 0
View file @ 6973aaa3
This diff is collapsed.
lisp/mail/pmailedit.el deleted 100644 → 0
View file @ 6973aaa3
;;; pmailedit.el --- "PMAIL 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 'pmail)
(require 'pmailsum))
(defcustom pmail-edit-mode-hook nil
"List of functions to call when editing an PMAIL message."
:type 'hook
:version "21.1"
:group 'pmail-edit)
(defvar pmail-old-text)
(defvar pmail-edit-map nil)
(if pmail-edit-map
nil
;; Make a keymap that inherits text-mode-map.
(setq pmail-edit-map (make-sparse-keymap))
(set-keymap-parent pmail-edit-map text-mode-map)
(define-key pmail-edit-map "\C-c\C-c" 'pmail-cease-edit)
(define-key pmail-edit-map "\C-c\C-]" 'pmail-abort-edit))
;; Pmail Edit mode is suitable only for specially formatted data.
(put 'pmail-edit-mode 'mode-class 'special)
(declare-function pmail-summary-disable "" ())
(declare-function pmail-summary-enable "pmailsum" ())
(defun pmail-edit-mode ()
"Major mode for editing the contents of an PMAIL message.
The editing commands are the same as in Text mode, together with two commands
to return to regular PMAIL:
* \\[pmail-abort-edit] cancels the changes
you have made and returns to PMAIL
* \\[pmail-cease-edit] makes them permanent.
This functions runs the normal hook `pmail-edit-mode-hook'.
\\{pmail-edit-map}"
(if (pmail-summary-exists)
(save-excursion
(set-buffer pmail-summary-buffer)
(pmail-summary-disable)))
(let (pmail-buffer-swapped)
;; Prevent change-major-mode-hook from unswapping the buffers.
(delay-mode-hooks (text-mode))
(use-local-map pmail-edit-map)
(setq major-mode 'pmail-edit-mode)
(setq mode-name "PMAIL 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 'pmail-edit-mode-hook)))
(defvar pmail-old-pruned nil)
(put 'pmail-old-pruned 'permanent-local t)
;;;###autoload
(defun pmail-edit-current-message ()
"Edit the contents of this message."
(interactive)
(if (= pmail-total-messages 0)
(error "No messages in this buffer"))
(make-local-variable 'pmail-old-pruned)
(setq pmail-old-pruned (eq pmail-header-style 'normal))
(pmail-edit-mode)
(make-local-variable 'pmail-old-text)
(save-restriction
(widen)
(setq pmail-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") 'pmail-cease-edit)
(eq (key-binding "\C-c\C-]") 'pmail-abort-edit))
(message "Editing: Type C-c C-c to return to Pmail, C-c C-] to abort")
(message "%s" (substitute-command-keys
"Editing: Type \\[pmail-cease-edit] to return to Pmail, \\[pmail-abort-edit] to abort"))))
(defun pmail-cease-edit ()
"Finish editing message; switch back to Pmail proper."
(interactive)
(if (pmail-summary-exists)
(save-excursion
(set-buffer pmail-summary-buffer)
(pmail-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 pmail-old-text)
character-coding is-text-message coding-system
headers-end)
;; Go back to Pmail mode, but carefully.
(force-mode-line-update)
(let (pmail-buffer-swapped)
(kill-all-local-variables)
(pmail-mode-1)
(if (boundp 'tool-bar-map)
(set (make-local-variable 'tool-bar-map) pmail-tool-bar-map))
(setq buffer-undo-list t)
(pmail-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))
(pmail-swap-buffers-maybe)
(setq character-coding (mail-fetch-field "content-transfer-encoding")
is-text-message (pmail-is-text-p)
coding-system (pmail-get-coding-system))
(if character-coding
(setq character-coding (downcase character-coding)))
(narrow-to-region (pmail-msgbeg pmail-current-message)
(pmail-msgend pmail-current-message))
(goto-char (point-min))
(search-forward "\n\n")
(let ((inhibit-read-only t)
(headers-end-1 (point)))
(insert-buffer-substring pmail-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)))
))
(pmail-set-attribute pmail-edited-attr-index t)
;;??? BROKEN perhaps.
;; I think that the Summary-Line header may not be kept there any more.
;;; (if (boundp 'pmail-summary-vector)
;;; (progn
;;; (aset pmail-summary-vector (1- pmail-current-message) nil)
;;; (save-excursion
;;; (pmail-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
(pmail-show-message)
(pmail-toggle-header (if pmail-old-pruned 1 0)))
(run-hooks 'pmail-mode-hook))
(defun pmail-abort-edit ()
"Abort edit of current message; restore original contents."
(interactive)
(widen)
(delete-region (point-min) (point-max))
(insert pmail-old-text)
(pmail-cease-edit)
(pmail-highlight-headers))
(provide 'pmailedit)
;; Local Variables:
;; change-log-default-name: "ChangeLog.pmail"
;; End:
;; arch-tag: 9524f335-12cc-4e95-9e9b-3208dc30550b
;;; pmailedit.el ends here
lisp/mail/pmailkwd.el deleted 100644 → 0
View file @ 6973aaa3
;;; pmailkwd.el --- part of the "PMAIL" 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 'pmail)
;; Global to all PMAIL 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 pmail-label-obarray (make-vector 47 0))
(mapc (function (lambda (s) (intern s pmail-label-obarray)))
'("deleted" "answered" "filed" "forwarded" "unseen" "edited"
"resent"))
(defun pmail-make-label (s)
(intern (downcase s) pmail-label-obarray))
;;;###autoload
(defun pmail-add-label (string)
"Add LABEL to labels associated with current PMAIL message.
Performs completion over known labels when reading."
(interactive (list (pmail-read-label "Add label")))
(pmail-set-label string t))
;;;###autoload
(defun pmail-kill-label (string)
"Remove LABEL from labels associated with current PMAIL message.
Performs completion over known labels when reading."
(interactive (list (pmail-read-label "Remove label")))
(pmail-set-label string nil))
;;;###autoload
(defun pmail-read-label (prompt)
(let ((result
(completing-read (concat prompt
(if pmail-last-label
(concat " (default "
(symbol-name pmail-last-label)
"): ")
": "))
pmail-label-obarray
nil
nil)))
(if (string= result "")
pmail-last-label
(setq pmail-last-label (pmail-make-label result)))))
(defun pmail-set-label (label state &optional msg)
"Set LABEL as present or absent according to STATE in message MSG."
(with-current-buffer pmail-buffer
(pmail-maybe-set-message-counters)
(if (not msg) (setq msg pmail-current-message))
;; Force recalculation of summary for this message.
(aset pmail-summary-vector (1- msg) nil)
(let (attr-index)
;; Is this label an attribute?
(dotimes (i (length pmail-attr-array))
(if (string= (cadr (aref pmail-attr-array i)) label)
(setq attr-index i)))
(if attr-index
;; If so, set it as an attribute.
(pmail-set-attribute attr-index state msg)
;; Is this keyword already present in msg's keyword list?
(let* ((header (pmail-get-header pmail-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.
(pmail-set-header
pmail-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 pmail-current-message)
(pmail-display-labels)))))
;; Motion on messages with keywords.
;;;###autoload
(defun pmail-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: ")
(pmail-next-labeled-message (- n) labels))
(declare-function mail-comma-list-regexp "mail-utils" (labels))
;;;###autoload
(defun pmail-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 pmail-last-multi-labels))
(or labels
(error "No labels to find have been specified previously"))
(set-buffer pmail-buffer)
(setq pmail-last-multi-labels labels)
(pmail-maybe-set-message-counters)
(let ((lastwin pmail-current-message)
(current pmail-current-message)
(regexp (concat ", ?\\("
(mail-comma-list-regexp labels)
"\\),")))
(while (and (> n 0) (< current pmail-total-messages))
(setq current (1+ current))
(if (string-match regexp (pmail-get-labels current))
(setq lastwin current n (1- n))))
(while (and (< n 0) (> current 1))
(setq current (1- current))
(if (string-match regexp (pmail-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)
(pmail-show-message lastwin)))))
(provide 'pmailkwd)
;; Local Variables:
;; change-log-default-name: "ChangeLog.pmail"
;; End:
;; arch-tag: 1149979c-8e47-4333-9629-cf3dc887a6a7
;;; pmailkwd.el ends here
lisp/mail/pmailmm.el deleted 100644 → 0
View file @ 6973aaa3
;;; pmailmm.el --- MIME decoding and display stuff for PMAIL
;; 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 'pmail-mime "pmailmm"
;; "Show MIME message." t)
;; (add-hook 'pmail-mode-hook
;; (lambda ()
;; (define-key pmail-mode-map (kbd "v")
;; 'pmail-mime)))
;;; Code:
(require 'pmail)
(require 'mail-parse)
;;; Variables
(defcustom pmail-mime-media-type-handlers-alist
'(("multipart/.*" pmail-mime-multipart-handler)
("text/.*" pmail-mime-text-handler)
("text/\\(x-\\)?patch" pmail-mime-bulk-handler)
("application/pgp-signature" pmail-mime-application/pgp-signature-handler)
("\\(image\\|audio\\|video\\|application\\)/.*" pmail-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 pmail-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 pmail-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 'pmail-mime-total-number-of-bulk-attachments 'permanent-local t)
;;; Buttons
(defun pmail-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 'pmail-mime-save
'action 'pmail-mime-save)
;;; Handlers
(defun pmail-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-pmail-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)
(pmail-mime-show t)
(set-buffer-multibyte t)))
(defun pmail-mime-bulk-handler (content-type
content-disposition
content-transfer-encoding)
"Handle the current buffer as an attachment to download."
(setq pmail-mime-total-number-of-bulk-attachments
(1+ pmail-mime-total-number-of-bulk-attachments))
;; Find the default directory for this media type
(let* ((directory (catch 'directory
(dolist (entry pmail-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 'pmail-mime-save
'filename filename
'directory directory
'data data)))
(defun test-pmail-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)
(pmail-mime-show)))
(defun pmail-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 `pmail-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
(pmail-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 pmail-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 `pmail-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
(pmail-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)
(pmail-mime-show))))
(setq beg next)
(goto-char beg))))
(defun test-pmail-mime-multipart-handler ()
"Test of a mail used as an example in RFC 2046."
(let ((mail "From: Nathaniel Borenstein <nsb@bellcore.com>